From bf92473c733080bf950ba0655e97593f87cca16e Mon Sep 17 00:00:00 2001 From: dkf Date: Thu, 17 May 2007 12:05:17 +0000 Subject: Added macro version of Tcl_LimitReady. --- ChangeLog | 35 +++++++----- generic/tclExecute.c | 159 ++++++++++++++++++++++++++++++--------------------- generic/tclInterp.c | 18 +++--- 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 + + * 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 * generic/tcl.decls: workaround 'make checkstubs' failures from @@ -5,12 +13,12 @@ 2007-05-16 Joe English - * 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 @@ -24,13 +32,13 @@ 2007-05-11 Pat Thoyts - * 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 - * 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 @@ -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. + * *---------------------------------------------------------------------- */ -- cgit v0.12