optimised loops that initialise a proc's arguments and compiled local

variables, removing tests from inner loops.

5 files changed, 170 insertions, 114 deletions

diff --git a/ChangeLog b/ChangeLog
index fd6bdf6..d92ea0a 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,11 @@
+2004-12-10  Miguel Sofer <msofer@users.sf.net>
+	* generic/tclCompile.c (TclInitCompiledLocals):
+	* generic/tclCompile.h:
+	* generic/tclInt.h:
+	* generic/tclProc.c (TclObjInterpProc, TclCreateProc): optimised
+	loops that initialise a proc's arguments and compiled local
+	variables, removing tests from inner loops.
+
 2004-12-10  Donal K. Fellows  <dkf@users.sf.net>
 
 	* generic/tclInt.h: Move ensemble API decls here from tclNamesp.c
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index 11383b7..a79d1ef 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.c,v 1.78 2004/10/08 15:39:52 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.79 2004/12/10 13:09:13 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1666,7 +1666,11 @@ TclInitByteCodeObj(objPtr, envPtr)
     codePtr->nsPtr = namespacePtr;
     codePtr->nsEpoch = namespacePtr->resolverEpoch;
     codePtr->refCount = 1;
-    codePtr->flags = 0;
+    if (namespacePtr->compiledVarResProc || iPtr->resolverPtr) {
+	codePtr->flags = TCL_BYTECODE_RESOLVE_VARS;
+    } else {
+	codePtr->flags = 0;
+    }
     codePtr->source = envPtr->source;
     codePtr->procPtr = envPtr->procPtr;
 
@@ -1867,80 +1871,105 @@ TclInitCompiledLocals(interp, framePtr, nsPtr)
 {
     register CompiledLocal *localPtr;
     Interp *iPtr = (Interp*) interp;
-    Tcl_ResolvedVarInfo *vinfo, *resVarInfo;
+    Tcl_ResolvedVarInfo *resVarInfo;
     Var *varPtr = framePtr->compiledLocals;
-    Var *resolvedVarPtr;
-    ResolverScheme *resPtr;
-    int result;
-
-    /*
-     * Initialize the array of local variables stored in the call frame.
-     * Some variables may have special resolution rules.  In that case,
-     * we call their "resolver" procs to get our hands on the variable,
-     * and we make the compiled local a link to the real variable.
-     */
-
-    for (localPtr = framePtr->procPtr->firstLocalPtr;
-	 localPtr != NULL;
-	 localPtr = localPtr->nextPtr) {
+    int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
+    ByteCode *codePtr = (ByteCode *)
+	    framePtr->procPtr->bodyPtr->internalRep.otherValuePtr;
 
+    if (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS) {
+	    
 	/*
-	 * Check to see if this local is affected by namespace or
-	 * interp resolvers.  The resolver to use is cached for the
-	 * next invocation of the procedure.
+	 * This is the first run after a recompile, or else the resolver epoch
+	 * has changed: update the resolver cache.
 	 */
 
-	if (!(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY|VAR_RESOLVED))
-		&& (nsPtr->compiledVarResProc || iPtr->resolverPtr)) {
-	    resPtr = iPtr->resolverPtr;
+	codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
+	
+	for (localPtr = framePtr->procPtr->firstLocalPtr; localPtr != NULL;
+		localPtr = localPtr->nextPtr) {
 
-	    if (nsPtr->compiledVarResProc) {
-		result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
-			localPtr->name, localPtr->nameLength,
-			(Tcl_Namespace *) nsPtr, &vinfo);
-	    } else {
-		result = TCL_CONTINUE;
+	    if (localPtr->resolveInfo) {
+		if (localPtr->resolveInfo->deleteProc) {
+		    localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
+		} else {
+		    ckfree((char*)localPtr->resolveInfo);
+		}
+		localPtr->resolveInfo = NULL;
 	    }
-
-	    while ((result == TCL_CONTINUE) && resPtr) {
-		if (resPtr->compiledVarResProc) {
-		    result = (*resPtr->compiledVarResProc)(nsPtr->interp,
+	    localPtr->flags &= ~VAR_RESOLVED;
+	    
+	    if (haveResolvers &&
+		    !(localPtr->flags & (VAR_ARGUMENT|VAR_TEMPORARY))) {
+		ResolverScheme *resPtr = iPtr->resolverPtr;
+		Tcl_ResolvedVarInfo *vinfo;
+		int result;
+		
+		if (nsPtr->compiledVarResProc) {
+		    result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
 			    localPtr->name, localPtr->nameLength,
 			    (Tcl_Namespace *) nsPtr, &vinfo);
+		} else {
+		    result = TCL_CONTINUE;
 		}
-		resPtr = resPtr->nextPtr;
-	    }
-	    if (result == TCL_OK) {
-		localPtr->resolveInfo = vinfo;
-		localPtr->flags |= VAR_RESOLVED;
-	    }
+		
+		while ((result == TCL_CONTINUE) && resPtr) {
+		    if (resPtr->compiledVarResProc) {
+			result = (*resPtr->compiledVarResProc)(nsPtr->interp,
+				localPtr->name, localPtr->nameLength,
+				(Tcl_Namespace *) nsPtr, &vinfo);
+		    }
+		    resPtr = resPtr->nextPtr;
+		}
+		if (result == TCL_OK) {
+		    localPtr->resolveInfo = vinfo;
+		    localPtr->flags |= VAR_RESOLVED;
+		}		    
+	    }	    
 	}
+    }
 
-	/*
-	 * Now invoke the resolvers to determine the exact variables that
-	 * should be used.
-	 */
-
-        resVarInfo = localPtr->resolveInfo;
-        resolvedVarPtr = NULL;
-
-        if (resVarInfo && resVarInfo->fetchProc) {
-            resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
-		    resVarInfo);
-        }
+    /*
+     * Initialize the array of local variables stored in the call frame.
+     * Some variables may have special resolution rules.  In that case,
+     * we call their "resolver" procs to get our hands on the variable,
+     * and we make the compiled local a link to the real variable.
+     */
 
-        if (resolvedVarPtr) {
+    if (haveResolvers) {
+	for (localPtr = framePtr->procPtr->firstLocalPtr;
+	        localPtr != NULL;
+	        localPtr = localPtr->nextPtr) {
+	    varPtr->value.objPtr = NULL;
 	    varPtr->name = localPtr->name; /* will be just '\0' if temp var */
 	    varPtr->nsPtr = NULL;
 	    varPtr->hPtr = NULL;
 	    varPtr->refCount = 0;
 	    varPtr->tracePtr = NULL;
 	    varPtr->searchPtr = NULL;
-	    varPtr->flags = 0;
-            TclSetVarLink(varPtr);
-            varPtr->value.linkPtr = resolvedVarPtr;
-            resolvedVarPtr->refCount++;
-        } else {
+	    varPtr->flags = localPtr->flags;
+    
+	    /*
+	     * Now invoke the resolvers to determine the exact variables that
+	     * should be used.
+	     */
+	    
+	    resVarInfo = localPtr->resolveInfo;
+	    if (resVarInfo && resVarInfo->fetchProc) {
+		Var *resolvedVarPtr = (Var*) (*resVarInfo->fetchProc)(interp,
+			resVarInfo);
+		if (resolvedVarPtr) {
+		    resolvedVarPtr->refCount++;
+		    varPtr->value.linkPtr = resolvedVarPtr;
+		    varPtr->flags = VAR_LINK;
+		}
+	    }
+	    varPtr++;
+	}
+    } else {
+	for (localPtr = framePtr->procPtr->firstLocalPtr;
+	        localPtr != NULL;
+	        localPtr = localPtr->nextPtr) {
 	    varPtr->value.objPtr = NULL;
 	    varPtr->name = localPtr->name; /* will be just '\0' if temp var */
 	    varPtr->nsPtr = NULL;
@@ -1949,8 +1978,8 @@ TclInitCompiledLocals(interp, framePtr, nsPtr)
 	    varPtr->tracePtr = NULL;
 	    varPtr->searchPtr = NULL;
 	    varPtr->flags = localPtr->flags;
-        }
-	varPtr++;
+	    varPtr++;
+	}
     }
 }
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index c950096..a50409b 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,7 +8,7 @@
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompile.h,v 1.51 2004/11/03 21:20:30 davygrvy Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.52 2004/12/10 13:09:14 msofer Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -273,6 +273,14 @@ typedef struct CompileEnv {
  */
 #define TCL_BYTECODE_PRECOMPILED		0x0001
 
+
+/*
+ * When a bytecode is compiled, interp or namespace resolvers have not been
+ * applied yet: this is indicated by the TCL_BYTECODE_RESOLVE_VARS flag.
+ */
+
+#define TCL_BYTECODE_RESOLVE_VARS               0x0002
+
 typedef struct ByteCode {
     TclHandle interpHandle;	/* Handle for interpreter containing the
 				 * compiled code.  Commands and their compile
diff --git a/generic/tclInt.h b/generic/tclInt.h
index c163c2b..11ddcf3 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.204 2004/12/10 00:16:55 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.205 2004/12/10 13:09:14 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -510,6 +510,7 @@ typedef struct Var {
 #define VAR_ARGUMENT		0x100
 #define VAR_TEMPORARY		0x200
 #define VAR_RESOLVED		0x400	
+#define VAR_IS_ARGS             0x800
 
 /*
  * Macros to ensure that various flag bits are set properly for variables.
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 6d46f81..5ae99c1 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.66 2004/11/25 16:37:15 dkf Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.67 2004/12/10 13:09:15 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -341,6 +341,7 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
 	procPtr->numArgs = numArgs;
 	procPtr->numCompiledLocals = numArgs;
     }
+
     for (i = 0; i < numArgs; i++) {
 	int fieldCount, nameLength, valueLength;
 	CONST char **fieldValues;
@@ -445,6 +446,12 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
 		    ckfree((char *) fieldValues);
 		    goto procError;
 		}
+		if ((i == numArgs - 1)
+			&& (localPtr->nameLength == 4)
+			&& (localPtr->name[0] == 'a')
+			&& (strcmp(localPtr->name, "args") == 0)) {
+		    localPtr->flags |= VAR_IS_ARGS;
+		}
 	    }
 
 	    localPtr = localPtr->nextPtr;
@@ -477,6 +484,12 @@ TclCreateProc(interp, nsPtr, procName, argsPtr, bodyPtr, procPtrPtr)
 		localPtr->defValuePtr = NULL;
 	    }
 	    strcpy(localPtr->name, fieldValues[0]);
+	    if ((i == numArgs - 1)
+		    && (localPtr->nameLength == 4)
+		    && (localPtr->name[0] == 'a')
+		    && (strcmp(localPtr->name, "args") == 0)) {
+		localPtr->flags |= VAR_IS_ARGS;
+	    }
 	}
 
 	ckfree((char *) fieldValues);
@@ -910,7 +923,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
     register Var *varPtr;
     register CompiledLocal *localPtr;
     char *procName;
-    int nameLen, localCt, numArgs, argCt, i, result;
+    int nameLen, localCt, numArgs, argCt, i, imax, result;
 
     /*
      * This procedure generates an array "compiledLocals" that holds the
@@ -992,53 +1005,62 @@ TclObjInterpProc(clientData, interp, objc, objv)
     numArgs = procPtr->numArgs;
     varPtr = framePtr->compiledLocals;
     localPtr = procPtr->firstLocalPtr;
-    argCt = objc;
-    for (i = 1, argCt -= 1; i <= numArgs; i++, argCt--) {
-	if (!TclIsVarArgument(localPtr)) {
-	    Tcl_Panic("TclObjInterpProc: local variable %s is not argument but should be",
-		  localPtr->name);
-	    return TCL_ERROR;
-	}
-	if (TclIsVarTemporary(localPtr)) {
-	    Tcl_Panic("TclObjInterpProc: local variable %d is temporary but should be an argument", i);
-	    return TCL_ERROR;
+    argCt = objc-1; /* set it to the number of args to the proc */
+    if (numArgs == 0) {
+	if (argCt) {
+	    goto incorrectArgs;
+	} else {
+	    goto runProc;
 	}
-
+    }    
+    imax = ((argCt < numArgs - 1)? argCt : (numArgs - 1)); 
+    for (i = 1; i <= imax; i++) {
 	/*
-	 * Handle the special case of the last formal being "args".  When
-	 * it occurs, assign it a list consisting of all the remaining
-	 * actual arguments.
+	 * "Normal" arguments; last formal is special, depends on
+	 * it being 'args'.
+	 */	
+	Tcl_Obj *objPtr = objv[i];
+	varPtr->value.objPtr = objPtr;
+	Tcl_IncrRefCount(objPtr);  /* local var is a reference */
+	varPtr++;
+	localPtr = localPtr->nextPtr;
+    }
+    for (; i < numArgs; i++) {
+	/*
+	 * This loop is entered if argCt < (numArgs-1).
+	 * Set default values; last formal is special.
 	 */
-
-	if ((i == numArgs) && ((localPtr->name[0] == 'a')
-		&& (strcmp(localPtr->name, "args") == 0))) {
-	    Tcl_Obj *listPtr = Tcl_NewListObj(argCt, &(objv[i]));
-	    varPtr->value.objPtr = listPtr;
-	    Tcl_IncrRefCount(listPtr); /* local var is a reference */
-	    TclClearVarUndefined(varPtr);
-	    argCt = 0;
-	    break;		/* done processing args */
-	} else if (argCt > 0) {
-	    Tcl_Obj *objPtr = objv[i];
-	    varPtr->value.objPtr = objPtr;
-	    TclClearVarUndefined(varPtr);
-	    Tcl_IncrRefCount(objPtr);  /* since the local variable now has
-					* another reference to object. */
-	} else if (localPtr->defValuePtr != NULL) {
+	if (localPtr->defValuePtr != NULL) {
 	    Tcl_Obj *objPtr = localPtr->defValuePtr;
 	    varPtr->value.objPtr = objPtr;
-	    TclClearVarUndefined(varPtr);
-	    Tcl_IncrRefCount(objPtr);  /* since the local variable now has
-					* another reference to object. */
+	    Tcl_IncrRefCount(objPtr);  /* local var is a reference */
+	    varPtr++;
+	    localPtr = localPtr->nextPtr;
 	} else {
 	    goto incorrectArgs;
 	}
-	varPtr++;
-	localPtr = localPtr->nextPtr;
     }
-    if (argCt > 0) {
-	Tcl_Obj **desiredObjs, *argObj;
 
+    /*
+     * When we get here, the last formal argument remains
+     * to be defined: localPtr and varPtr point to the last
+     * argument to be initialized.
+     */
+
+    if (localPtr->flags & VAR_IS_ARGS) {
+	Tcl_Obj *listPtr = Tcl_NewListObj(objc-numArgs, &(objv[numArgs]));
+	varPtr->value.objPtr = listPtr;
+	Tcl_IncrRefCount(listPtr); /* local var is a reference */
+    } else if (argCt == numArgs) {
+	Tcl_Obj *objPtr = objv[numArgs];
+	varPtr->value.objPtr = objPtr;
+	Tcl_IncrRefCount(objPtr);  /* local var is a reference */
+    } else if ((argCt < numArgs) && (localPtr->defValuePtr != NULL)) {
+	Tcl_Obj *objPtr = localPtr->defValuePtr;
+	varPtr->value.objPtr = objPtr;
+	Tcl_IncrRefCount(objPtr);  /* local var is a reference */
+    } else {
+	Tcl_Obj **desiredObjs, *argObj;	
     incorrectArgs:
 	/*
 	 * Build up desired argument list for Tcl_WrongNumArgs
@@ -1087,6 +1109,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
      * Invoke the commands in the procedure's body.
      */
 
+  runProc:
 #ifdef TCL_COMPILE_DEBUG
     if (tclTraceExec >= 1) {
 	fprintf(stdout, "Calling proc ");
@@ -1252,25 +1275,12 @@ TclProcCompileProc(interp, procPtr, bodyPtr, nsPtr, description, procName)
  	    return result;
  	}
     } else if (codePtr->nsEpoch != nsPtr->resolverEpoch) {
-	register CompiledLocal *localPtr;
-
 	/*
 	 * The resolver epoch has changed, but we only need to invalidate
 	 * the resolver cache.
 	 */
 
-	for (localPtr = procPtr->firstLocalPtr; localPtr != NULL;
-		localPtr = localPtr->nextPtr) {
-	    localPtr->flags &= ~(VAR_RESOLVED);
-	    if (localPtr->resolveInfo) {
-		if (localPtr->resolveInfo->deleteProc) {
-		    localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
-		} else {
-		    ckfree((char*)localPtr->resolveInfo);
-		}
-		localPtr->resolveInfo = NULL;
-	    }
-	}
+	codePtr->flags |= TCL_BYTECODE_RESOLVE_VARS;
     }
     return TCL_OK;
 }