Added macro version of Tcl_LimitReady.

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.
+ *
  *----------------------------------------------------------------------
  */