summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog35
-rw-r--r--generic/tclExecute.c159
-rw-r--r--generic/tclInterp.c18
3 files changed, 126 insertions, 86 deletions
diff --git a/ChangeLog b/ChangeLog
index 7e6d0f7..7facb0a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2007-05-17 Donal K. Fellows <dkf@users.sf.net>
+
+ * generic/tclExecute.c (TclLimitReady): Created a macro version of
+ Tcl_LimitReady just for TEBC, to reduce the amount of times that the
+ bytecode engine calls out to external functions on the critical path.
+ * generic/tclInterp.c (Tcl_LimitReady): Added note to remind anyone
+ doing maintenance that there is a macro version to update.
+
2007-05-17 Daniel Steffen <das@users.sourceforge.net>
* generic/tcl.decls: workaround 'make checkstubs' failures from
@@ -5,12 +13,12 @@
2007-05-16 Joe English <jenglish@users.sourceforge.net>
- * generic/tclStubLib.c: Change Tcl_InitStubs(), tclStubsPtr,
- and the auxilliary stubs table pointers back to public visibility.
+ * generic/tclStubLib.c: Change Tcl_InitStubs(), tclStubsPtr, and the
+ auxilliary stubs table pointers back to public visibility.
- These symbols need to be exported so that stub-enabled extensions
- may be statically linked into an extended tclsh or Big Wish with
- a dynamically-linked libtcl. [Bug 1716117]
+ These symbols need to be exported so that stub-enabled extensions may
+ be statically linked into an extended tclsh or Big Wish with a
+ dynamically-linked libtcl. [Bug 1716117]
2007-05-15 Don Porter <dgp@users.sourceforge.net>
@@ -24,13 +32,13 @@
2007-05-11 Pat Thoyts <patthoyts@users.sourceforge.net>
- * generic/tclInt.h: Removed TclEvalObjEx and TclGetSrcInfoForPc
- from tclInt.h now they are in the internal stubs table.
+ * generic/tclInt.h: Removed TclEvalObjEx and TclGetSrcInfoForPc from
+ tclInt.h now they are in the internal stubs table.
2007-05-09 Don Porter <dgp@users.sourceforge.net>
- * generic/tclInt.h: TclFinalizeThreadAlloc() is always defined,
- so make sure it is also always declared (with MODULE_SCOPE).
+ * generic/tclInt.h: TclFinalizeThreadAlloc() is always defined, so
+ make sure it is also always declared (with MODULE_SCOPE).
2007-05-09 Daniel Steffen <das@users.sourceforge.net>
@@ -44,16 +52,15 @@
[Tcl Bug 1706140]
- * generic/tclLink.c (LinkTraceProc): Update Tcl_VarTraceProcs so that
+ * generic/tclLink.c (LinkTraceProc): Update Tcl_VarTraceProcs so
* generic/tclNamesp.c (Error*Read): they call Tcl_InterpDeleted()
* generic/tclTrace.c (Trace*Proc): for themselves, and do not rely
* generic/tclUtil.c (TclPrecTraceProc): on (frequently buggy) setting
of the TCL_INTERP_DESTROYED flag by the trace core.
- * generic/tclVar.c: Update callers of TclCallVarTraces to not
- pass in the TCL_INTERP_DESTROYED flag. Also apply filters so that
- public routines only pass documented flag values down to lower level
- routines.
+ * generic/tclVar.c: Update callers of TclCallVarTraces to not pass
+ in the TCL_INTERP_DESTROYED flag. Also apply filters so that public
+ routines only pass documented flag values down to lower level routines
* generic/tclTrace.c (TclCallVarTraces): The setting of the
TCL_INTERP_DESTROYED flag is now done entirely within the
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1d354e8..35bac19 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -12,7 +12,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclExecute.c,v 1.283 2007/05/11 09:41:57 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.284 2007/05/17 12:05:18 dkf Exp $
*/
#include "tclInt.h"
@@ -343,6 +343,31 @@ long tclObjsShared[TCL_MAX_SHARED_OBJ_STATS] = { 0, 0, 0, 0, 0 };
Tcl_GetWideIntFromObj((interp), (objPtr), (wideIntPtr)))
#endif
+/*
+ * Inline version of Tcl_LimitReady() to limit number of calls out of this
+ * file in the critical path. Note that this code isn't particularly readable;
+ * the non-inline version (in tclInterp.c) is much easier to understand. Note
+ * also that this macro takes different args (iPtr->limit) to the non-inline
+ * version.
+ */
+
+#define TclLimitReady(limit) \
+ (((limit).active == 0) ? 0 : \
+ (++(limit).granularityTicker, \
+ ((((limit).active & TCL_LIMIT_COMMANDS) && \
+ (((limit).cmdGranularity == 1) || \
+ ((limit).granularityTicker % (limit).cmdGranularity == 0))) \
+ ? 1 : \
+ (((limit).active & TCL_LIMIT_TIME) && \
+ (((limit).timeGranularity == 1) || \
+ ((limit).granularityTicker % (limit).timeGranularity == 0)))\
+ ? 1 : 0)))
+
+/*
+ * Custom object type only used in this file; values of its type should never
+ * be seen by user scripts.
+ */
+
static Tcl_ObjType dictIteratorType = {
"dictIterator",
NULL, NULL, NULL, NULL
@@ -990,7 +1015,7 @@ TclCompEvalObj(
* Increment the code's ref count while it is being executed. If
* afterwards no references to it remain, free the code.
*/
-
+
runCompiledObj:
codePtr->refCount++;
result = TclExecuteByteCode(interp, codePtr);
@@ -1001,19 +1026,19 @@ TclCompEvalObj(
iPtr->numLevels--;
return result;
}
-
+
recompileObj:
iPtr->errorLine = 1;
-
+
/*
* TIP #280. Remember the invoker for a moment in the interpreter
* structures so that the byte code compiler can pick it up when
- * initializing the compilation environment, i.e. the extended
- * location information.
+ * initializing the compilation environment, i.e. the extended location
+ * information.
*/
-
+
iPtr->invokeCmdFramePtr = invoker;
- iPtr->invokeWord = word;
+ iPtr->invokeWord = word;
result = tclByteCodeType.setFromAnyProc(interp, objPtr);
iPtr->invokeCmdFramePtr = NULL;
if (result == TCL_OK) {
@@ -1024,7 +1049,6 @@ TclCompEvalObj(
return result;
}
}
-
/*
*----------------------------------------------------------------------
@@ -1368,13 +1392,13 @@ TclExecuteByteCode(
if ((instructionCount++ & ASYNC_CHECK_COUNT_MASK) == 0) {
/*
- * Check for asynchronous handlers [Bug 746722]; we do the check every
+ * Check for asynchronous handlers [Bug 746722]; we do the check every
* ASYNC_CHECK_COUNT_MASK instruction, of the form (2**n-<1).
*/
if (Tcl_AsyncReady()) {
int localResult;
-
+
DECACHE_STACK_INFO();
localResult = Tcl_AsyncInvoke(interp, result);
CACHE_STACK_INFO();
@@ -1383,9 +1407,9 @@ TclExecuteByteCode(
goto checkForCatch;
}
}
- if (Tcl_LimitReady(interp)) {
+ if (TclLimitReady(iPtr->limit)) {
int localResult;
-
+
DECACHE_STACK_INFO();
localResult = Tcl_LimitCheck(interp);
CACHE_STACK_INFO();
@@ -1404,7 +1428,7 @@ TclExecuteByteCode(
/*
* OBJ_AT_TOS is returnOpts, OBJ_UNDER_TOS is resultObjPtr.
*/
-
+
TRACE(("%u %u => ", code, level));
result = TclProcessReturn(interp, code, level, OBJ_AT_TOS);
if (result == TCL_OK) {
@@ -1436,12 +1460,12 @@ TclExecuteByteCode(
case INST_DONE:
if (CURR_DEPTH > initStackDepth) {
/*
- * Set the interpreter's object result to point to the topmost object
- * from the stack, and check for a possible [catch]. The stackTop's
- * level and refCount will be handled by "processCatch" or
- * "abnormalReturn".
+ * Set the interpreter's object result to point to the topmost
+ * object from the stack, and check for a possible [catch]. The
+ * stackTop's level and refCount will be handled by "processCatch"
+ * or "abnormalReturn".
*/
-
+
Tcl_SetObjResult(interp, OBJ_AT_TOS);
#ifdef TCL_COMPILE_DEBUG
TRACE_WITH_OBJ(("=> return code=%d, result=", result),
@@ -1514,8 +1538,8 @@ TclExecuteByteCode(
*/
iPtr->cmdCount += TclGetUInt4AtPtr(pc+5);
- if (!checkInterp) {
- instStartCmdOK:
+ if (!checkInterp) {
+ instStartCmdOK:
#if 0 && !TCL_COMPILE_DEBUG
/*
* Peephole optimisations: check if there are several
@@ -1537,8 +1561,8 @@ TclExecuteByteCode(
NEXT_INST_F(9, 0, 0);
#endif
} else if (((codePtr->compileEpoch == iPtr->compileEpoch)
- && (codePtr->nsEpoch == namespacePtr->resolverEpoch))
- || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
+ && (codePtr->nsEpoch == namespacePtr->resolverEpoch))
+ || (codePtr->flags & TCL_BYTECODE_PRECOMPILED)) {
checkInterp = 0;
goto instStartCmdOK;
} else {
@@ -1587,7 +1611,7 @@ TclExecuteByteCode(
* Compute the length to be appended.
*/
- for (currPtr = &OBJ_AT_DEPTH(opnd-2); currPtr <= &OBJ_AT_TOS; currPtr++) {
+ for (currPtr=&OBJ_AT_DEPTH(opnd-2); currPtr<=&OBJ_AT_TOS; currPtr++) {
bytes = Tcl_GetStringFromObj(*currPtr, &length);
if (bytes != NULL) {
appendLen += length;
@@ -1706,14 +1730,14 @@ TclExecuteByteCode(
CACHE_STACK_INFO();
/*
- * Expand the list at stacktop onto the stack; free the list. Knowing
- * that it has a freeIntRepProc we use Tcl_DecrRefCount().
+ * Expand the list at stacktop onto the stack; free the list. Knowing
+ * that it has a freeIntRepProc we use Tcl_DecrRefCount().
*/
for (i = 0; i < objc; i++) {
PUSH_OBJECT(objv[i]);
}
-
+
Tcl_DecrRefCount(valuePtr);
NEXT_INST_F(5, 0, 0);
}
@@ -1823,34 +1847,36 @@ TclExecuteByteCode(
if (cmdPtr && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)
&& iPtr->tracePtr == NULL
- && (!checkInterp || (codePtr->compileEpoch == iPtr->compileEpoch))) {
+ && (!checkInterp
+ || (codePtr->compileEpoch == iPtr->compileEpoch))) {
/*
* No traces, the interp is ok: avoid the call out to TEOVi
*/
-
+
cmdPtr->refCount++;
iPtr->cmdCount++;
iPtr->ensembleRewrite.sourceObjs = NULL;
- result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp, objc, objv);
+ result = (*cmdPtr->objProc)(cmdPtr->objClientData, interp,
+ objc, objv);
TclCleanupCommand(cmdPtr);
if (Tcl_AsyncReady()) {
result = Tcl_AsyncInvoke(interp, result);
}
- if (result == TCL_OK && Tcl_LimitReady(interp)) {
+ if (result == TCL_OK && TclLimitReady(iPtr->limit)) {
result = Tcl_LimitCheck(interp);
}
} else {
-
/*
- * If trace procedures will be called, we need a command string to
- * pass to TclEvalObjvInternal; note that a copy of the string
- * will be made there to include the ending \0.
+ * If trace procedures will be called, we need a command
+ * string to pass to TclEvalObjvInternal; note that a copy of
+ * the string will be made there to include the ending \0.
*/
-
+
bytes = GetSrcInfoForPc(pc, codePtr, &length);
- result = TclEvalObjvInternal(interp, objc, objv, bytes, length, 0);
+ result = TclEvalObjvInternal(interp, objc, objv, bytes,
+ length, 0);
}
-
+
CACHE_STACK_INFO();
iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
@@ -2033,7 +2059,7 @@ TclExecuteByteCode(
case INST_LOAD_ARRAY_STK:
cleanup = 2;
part2 = Tcl_GetString(OBJ_AT_TOS); /* element name */
- objPtr = OBJ_UNDER_TOS; /* array name */
+ objPtr = OBJ_UNDER_TOS; /* array name */
TRACE(("\"%.30s(%.30s)\" => ", O2S(objPtr), part2));
goto doLoadStk;
@@ -2086,14 +2112,15 @@ TclExecuteByteCode(
if (!TclIsVarUndefined(arrayPtr)
&& TclIsVarArray(arrayPtr)
&& TclIsVarUntraced(arrayPtr)) {
- Tcl_HashEntry *hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, part2);
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr,
+ part2);
if (hPtr) {
varPtr = (Var *) Tcl_GetHashValue(hPtr);
} else {
goto doLoadArrayNextBranch;
}
} else {
- doLoadArrayNextBranch:
+ doLoadArrayNextBranch:
varPtr = TclLookupArrayElement(interp, part1, part2,
TCL_LEAVE_ERR_MSG, "read", 0, 1, arrayPtr);
if (varPtr == NULL) {
@@ -2266,7 +2293,8 @@ TclExecuteByteCode(
if (!TclIsVarUndefined(arrayPtr)
&& TclIsVarArray(arrayPtr)
&& TclIsVarUntraced(arrayPtr)) {
- Tcl_HashEntry *hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr, part2);
+ Tcl_HashEntry *hPtr = Tcl_FindHashEntry(arrayPtr->value.tablePtr,
+ part2);
if (hPtr) {
varPtr = (Var *) Tcl_GetHashValue(hPtr);
goto doCallPtrSetVar;
@@ -2677,7 +2705,7 @@ TclExecuteByteCode(
case INST_UPVAR: {
int opnd;
Var *varPtr, *otherPtr;
-
+
TRACE_WITH_OBJ(("upvar "), OBJ_UNDER_TOS);
{
@@ -2688,7 +2716,7 @@ TclExecuteByteCode(
/*
* Locate the other variable
*/
-
+
savedFramePtr = iPtr->varFramePtr;
iPtr->varFramePtr = framePtr;
otherPtr = TclObjLookupVar(interp, OBJ_AT_TOS, NULL,
@@ -2696,27 +2724,27 @@ TclExecuteByteCode(
/*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
iPtr->varFramePtr = savedFramePtr;
if (otherPtr) {
- result = TCL_OK;
+ result = TCL_OK;
goto doLinkVars;
}
}
result = TCL_ERROR;
goto checkForCatch;
}
-
+
case INST_VARIABLE:
- case INST_NSUPVAR:
+ case INST_NSUPVAR:
TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS);
{
Tcl_Namespace *nsPtr, *savedNsPtr;
-
+
result = TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr);
if ((result == TCL_OK) && nsPtr) {
/*
* Locate the other variable
*/
-
+
savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
otherPtr = TclObjLookupVar(interp, OBJ_AT_TOS, NULL,
@@ -2727,31 +2755,32 @@ TclExecuteByteCode(
/*
* Do the [variable] magic if necessary
*/
-
- if ((*pc == INST_VARIABLE) && !TclIsVarNamespaceVar(otherPtr)) {
+
+ if ((*pc == INST_VARIABLE)
+ && !TclIsVarNamespaceVar(otherPtr)) {
TclSetVarNamespaceVar(otherPtr);
otherPtr->refCount++;
}
} else {
result = TCL_ERROR;
goto checkForCatch;
- }
+ }
} else {
if (nsPtr == NULL) {
/*
* The namespace does not exist, leave an error message.
*/
+
Tcl_SetObjResult(interp, Tcl_Format(NULL,
- "namespace \"%s\" does not exist", 1,
- &OBJ_UNDER_TOS));
+ "namespace \"%s\" does not exist", 1,
+ &OBJ_UNDER_TOS));
result = TCL_ERROR;
}
goto checkForCatch;
}
-
}
-
- doLinkVars:
+
+ doLinkVars:
/*
* If we are here, the local variable has already been created: do the
@@ -2762,7 +2791,7 @@ TclExecuteByteCode(
opnd = TclGetInt4AtPtr(pc+1);;
varPtr = &(compiledLocals[opnd]);
if ((varPtr != otherPtr) && (varPtr->tracePtr == NULL)
- && (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {
+ && (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {
if (!TclIsVarUndefined(varPtr)) {
/* Then it is a defined link */
Var *linkPtr = varPtr->value.linkPtr;
@@ -2790,7 +2819,7 @@ TclExecuteByteCode(
* variables.
*/
- doLinkVarsDone:
+ doLinkVarsDone:
NEXT_INST_F(5, 1, 0);
}
@@ -3034,7 +3063,7 @@ TclExecuteByteCode(
* Select the list item based on the index. Negative operand means
* end-based indexing.
*/
-
+
if (opnd < -1) {
idx = opnd+1 + listc;
} else {
@@ -3045,7 +3074,7 @@ TclExecuteByteCode(
} else {
TclNewObj(objResultPtr);
}
-
+
TRACE_WITH_OBJ(("\"%.30s\" %d => ", O2S(valuePtr), opnd),
objResultPtr);
NEXT_INST_F(5, 1, 1);
@@ -3107,7 +3136,7 @@ TclExecuteByteCode(
* Get the old value of variable, and remove the stack ref. This is
* safe because the variable still references the object; the ref
* count will never go zero here - we can use the smaller macro
- * Tcl_DecrRefCount.
+ * Tcl_DecrRefCount.
*/
value2Ptr = POP_OBJECT();
@@ -3134,7 +3163,7 @@ TclExecuteByteCode(
/*
* Set result
*/
-
+
TRACE(("%d => %s\n", opnd, O2S(objResultPtr)));
NEXT_INST_V(5, (numIdx+1), -1);
} else {
@@ -3155,7 +3184,7 @@ TclExecuteByteCode(
* Get the old value of variable, and remove the stack ref. This is
* safe because the variable still references the object; the ref
* count will never go zero here - we can use the smaller macro
- * Tcl_DecrRefCount.
+ * Tcl_DecrRefCount.
*/
objPtr = POP_OBJECT();
@@ -3182,7 +3211,7 @@ TclExecuteByteCode(
/*
* Set result
*/
-
+
TRACE(("=> %s\n", O2S(objResultPtr)));
NEXT_INST_F(1, 2, -1);
} else {
diff --git a/generic/tclInterp.c b/generic/tclInterp.c
index 7fcb341..8c32150 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -10,7 +10,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInterp.c,v 1.73 2007/04/20 05:51:10 kennykb Exp $
+ * RCS: @(#) $Id: tclInterp.c,v 1.74 2007/05/17 12:05:22 dkf Exp $
*/
#include "tclInt.h"
@@ -1409,7 +1409,7 @@ AliasCreate(
Slave *slavePtr;
Master *masterPtr;
Tcl_Obj **prefv;
- int new, i;
+ int isNew, i;
aliasPtr = (Alias *) ckalloc((unsigned) (sizeof(Alias)
+ objc * sizeof(Tcl_Obj *)));
@@ -1478,8 +1478,8 @@ AliasCreate(
char *string;
string = Tcl_GetString(aliasPtr->token);
- hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &new);
- if (new != 0) {
+ hPtr = Tcl_CreateHashEntry(&slavePtr->aliasTable, string, &isNew);
+ if (isNew != 0) {
break;
}
@@ -2111,7 +2111,7 @@ SlaveCreate(
InterpInfo *masterInfoPtr;
Tcl_HashEntry *hPtr;
char *path;
- int new, objc;
+ int isNew, objc;
Tcl_Obj **objv;
if (Tcl_ListObjGetElements(interp, pathPtr, &objc, &objv) != TCL_OK) {
@@ -2136,8 +2136,8 @@ SlaveCreate(
}
masterInfoPtr = (InterpInfo *) ((Interp *) masterInterp)->interpInfo;
- hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path, &new);
- if (new == 0) {
+ hPtr = Tcl_CreateHashEntry(&masterInfoPtr->master.slaveTable, path, &isNew);
+ if (isNew == 0) {
Tcl_AppendResult(interp, "interpreter named \"", path,
"\" already exists, cannot create", (char *) NULL);
return NULL;
@@ -2931,6 +2931,10 @@ Tcl_LimitExceeded(
* Side effects:
* Increments the limit granularity counter.
*
+ * Notes:
+ * If you change this function, you MUST also update TclLimitReady() in
+ * tclExecute.c.
+ *
*----------------------------------------------------------------------
*/
generated by cgit v0.12 at 2024-11-06 11:25:24 (GMT)