* generic/tclCompile.c: moved TclInitCompiledLocals to tclProc.c

	* generic/tclProc.c: new static InitCompiledLocals to allow for a
	single pass over the proc's arguments at proc load time (instead of
	two as previously). TclObjInterpProc() now allocates the
	compiledLocals on the tcl execution stack, using the new
	TclStackAlloc/Free functions.

1 files changed, 234 insertions, 31 deletions

diff --git a/generic/tclProc.c b/generic/tclProc.c
index feda831..c5a8dc7 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.69 2004/12/15 20:44:41 msofer Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.70 2004/12/20 18:27:19 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -27,6 +27,10 @@ static int	ProcessProcResultCode _ANSI_ARGS_((Tcl_Interp *interp,
 static int	TclCompileNoOp _ANSI_ARGS_((Tcl_Interp *interp,
 		    Tcl_Parse *parsePtr, struct CompileEnv *envPtr));
 
+static void     InitCompiledLocals _ANSI_ARGS_((Tcl_Interp *interp,
+		    ByteCode *codePtr, CompiledLocal *localPtr,
+		    Var *varPtr, Namespace *nsPtr)); 
+
 /*
  * The ProcBodyObjType type
  */
@@ -892,6 +896,171 @@ TclIsProc(cmdPtr)
 /*
  *----------------------------------------------------------------------
  *
+ * InitCompiledLocals --
+ *
+ *	This routine is invoked in order to initialize the compiled
+ *	locals table for a new call frame.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May invoke various name resolvers in order to determine which
+ *	variables are being referenced at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static void
+InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr)
+    Tcl_Interp *interp;		/* Current interpreter. */
+    ByteCode *codePtr;
+    CompiledLocal *localPtr;
+    Var *varPtr;
+    Namespace *nsPtr;		/* Pointer to current namespace. */
+{
+    Interp *iPtr = (Interp*) interp;
+    int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
+    CompiledLocal *firstLocalPtr;
+    
+    if (codePtr->flags & TCL_BYTECODE_RESOLVE_VARS) {
+	/*
+	 * This is the first run after a recompile, or else the resolver epoch
+	 * has changed: update the resolver cache.
+	 */
+
+	firstLocalPtr = localPtr;
+	for (; localPtr != NULL; localPtr = localPtr->nextPtr) {
+	    
+	    if (localPtr->resolveInfo) {
+		if (localPtr->resolveInfo->deleteProc) {
+		    localPtr->resolveInfo->deleteProc(localPtr->resolveInfo);
+		} else {
+		    ckfree((char*)localPtr->resolveInfo);
+		}
+		localPtr->resolveInfo = NULL;
+	    }
+	    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;
+		}
+		
+		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;
+		}		    
+	    }	    
+	}
+	localPtr = firstLocalPtr;
+	codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
+    }
+
+    /*
+     * 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 (haveResolvers) {
+	Tcl_ResolvedVarInfo *resVarInfo;
+	for (; localPtr != NULL; varPtr++, 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 = 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;
+		}
+	    }
+	}
+    } else {
+	for (; localPtr != NULL; varPtr++, 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 = localPtr->flags;
+	}
+    }
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclInitCompiledLocals --
+ *
+ *	This routine is invoked in order to initialize the compiled
+ *	locals table for a new call frame.
+ *
+ * DEPRECATED: functionality has been inlined elsewhere; this function remains
+ * to insure binary compatibility with Itcl.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	May invoke various name resolvers in order to determine which
+ *	variables are being referenced at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+TclInitCompiledLocals(interp, framePtr, nsPtr)
+    Tcl_Interp *interp;		/* Current interpreter. */
+    CallFrame *framePtr;	/* Call frame to initialize. */
+    Namespace *nsPtr;		/* Pointer to current namespace. */
+{
+    Var *varPtr = framePtr->compiledLocals;
+    ByteCode *codePtr = (ByteCode *)
+	    framePtr->procPtr->bodyPtr->internalRep.otherValuePtr;
+    CompiledLocal *localPtr = framePtr->procPtr->firstLocalPtr;
+
+    InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr);
+}
+
+/*
+ *----------------------------------------------------------------------
+ *
  * TclObjInterpProc --
  *
  *	When a Tcl procedure gets invoked during bytecode evaluation, this 
@@ -923,16 +1092,7 @@ TclObjInterpProc(clientData, interp, objc, objv)
     register CompiledLocal *localPtr;
     char *procName;
     int nameLen, localCt, numArgs, argCt, i, imax, result;
-
-    /*
-     * This procedure generates an array "compiledLocals" that holds the
-     * storage for local variables. It starts out with stack-allocated space
-     * but uses dynamically-allocated storage if needed.
-     */
-
-#define NUM_LOCALS 20
-    Var localStorage[NUM_LOCALS];
-    Var *compiledLocals = localStorage;
+    Var *compiledLocals;
 
     /*
      * Get the procedure's name.
@@ -955,16 +1115,6 @@ TclObjInterpProc(clientData, interp, objc, objv)
 	return result;
     }
 
-    /*
-     * Create the "compiledLocals" array. Make sure it is large enough to
-     * hold all the procedure's compiled local variables, including its
-     * formal parameters.
-     */
-
-    localCt = procPtr->numCompiledLocals;
-    if (localCt > NUM_LOCALS) {
-	compiledLocals = (Var *) ckalloc((unsigned) localCt * sizeof(Var));
-    }
 
     /*
      * Set up and push a new call frame for the new procedure invocation.
@@ -982,19 +1132,22 @@ TclObjInterpProc(clientData, interp, objc, objv)
 	return result;
     }
 
+
     framePtr->objc = objc;
     framePtr->objv = objv;  /* ref counts for args are incremented below */
+    framePtr->procPtr = procPtr;
 
     /*
-     * Initialize and resolve compiled variable references.
+     * Create the "compiledLocals" array. Make sure it is large enough to
+     * hold all the procedure's compiled local variables, including its
+     * formal parameters.
      */
 
-    framePtr->procPtr = procPtr;
+    localCt = procPtr->numCompiledLocals;
+    compiledLocals = (Var *) TclStackAlloc(interp, localCt*sizeof(Var));
     framePtr->numCompiledLocals = localCt;
     framePtr->compiledLocals = compiledLocals;
 
-    TclInitCompiledLocals(interp, framePtr, nsPtr);
-
     /*
      * Match and assign the call's actual parameters to the procedure's
      * formal arguments. The formal arguments are described by the first
@@ -1003,9 +1156,9 @@ TclObjInterpProc(clientData, interp, objc, objv)
      */
 
     numArgs = procPtr->numArgs;
+    argCt = objc-1; /* set it to the number of args to the proc */
     varPtr = framePtr->compiledLocals;
     localPtr = procPtr->firstLocalPtr;
-    argCt = objc-1; /* set it to the number of args to the proc */
     if (numArgs == 0) {
 	if (argCt) {
 	    goto incorrectArgs;
@@ -1022,6 +1175,13 @@ TclObjInterpProc(clientData, interp, objc, objv)
 	Tcl_Obj *objPtr = objv[i];
 	varPtr->value.objPtr = objPtr;
 	Tcl_IncrRefCount(objPtr);  /* local var is a reference */
+	varPtr->name = localPtr->name;
+	varPtr->nsPtr = NULL;
+	varPtr->hPtr = NULL;
+	varPtr->refCount = 0;
+	varPtr->tracePtr = NULL;
+	varPtr->searchPtr = NULL;
+	varPtr->flags = localPtr->flags;
 	varPtr++;
 	localPtr = localPtr->nextPtr;
     }
@@ -1034,6 +1194,13 @@ TclObjInterpProc(clientData, interp, objc, objv)
 	    Tcl_Obj *objPtr = localPtr->defValuePtr;
 	    varPtr->value.objPtr = objPtr;
 	    Tcl_IncrRefCount(objPtr);  /* local var is a reference */
+	    varPtr->name = localPtr->name;
+	    varPtr->nsPtr = NULL;
+	    varPtr->hPtr = NULL;
+	    varPtr->refCount = 0;
+	    varPtr->tracePtr = NULL;
+	    varPtr->searchPtr = NULL;
+	    varPtr->flags = localPtr->flags;
 	    varPtr++;
 	    localPtr = localPtr->nextPtr;
 	} else {
@@ -1061,8 +1228,16 @@ TclObjInterpProc(clientData, interp, objc, objv)
 	Tcl_IncrRefCount(objPtr);  /* local var is a reference */
     } else {
 	Tcl_Obj **desiredObjs, *argObj;	
+	ByteCode *codePtr = (ByteCode *) procPtr->bodyPtr->internalRep.otherValuePtr;		
     incorrectArgs:
 	/*
+	 * Do initialise all compiled locals, to avoid problems at
+	 * DeleteLocalVars. 
+	 */
+	
+	InitCompiledLocals(interp, codePtr, localPtr, varPtr, nsPtr);
+
+        /*
 	 * Build up desired argument list for Tcl_WrongNumArgs
 	 */
 
@@ -1105,11 +1280,32 @@ TclObjInterpProc(clientData, interp, objc, objv)
 	goto procDone;
     }
 
+    varPtr->name = localPtr->name;
+    varPtr->nsPtr = NULL;
+    varPtr->hPtr = NULL;
+    varPtr->refCount = 0;
+    varPtr->tracePtr = NULL;
+    varPtr->searchPtr = NULL;
+    varPtr->flags = localPtr->flags;
+
+    localPtr = localPtr->nextPtr;
+    varPtr++;
+
+  runProc:
+    /*
+     * Initialise and resolve the remaining compiledLocals.
+     */
+
+    if (localPtr) {
+	ByteCode *codePtr = (ByteCode *) procPtr->bodyPtr->internalRep.otherValuePtr;		
+	InitCompiledLocals(interp, codePtr,
+		localPtr, varPtr, nsPtr);
+    }
+
     /*
      * Invoke the commands in the procedure's body.
      */
 
-  runProc:
 #ifdef TCL_COMPILE_DEBUG
     if (tclTraceExec >= 1) {
 	fprintf(stdout, "Calling proc ");
@@ -1139,10 +1335,17 @@ TclObjInterpProc(clientData, interp, objc, objv)
      */
 
     procDone:
-    TclPopStackFrame(interp);
-    if (compiledLocals != localStorage) {
-	ckfree((char *) compiledLocals);
-    }
+    /*
+     * Free the stack-allocated compiled locals and CallFrame. It is important
+     * to pop the call frame without freeing it first: the compiledLocals
+     * cannot be freed before the frame is popped, as the local variables must
+     * be deleted. But the compiledLocals must be freed first, as they were
+     * allocated later on the stack.
+     */
+    
+    Tcl_PopCallFrame(interp); /* pop but do not free */
+    TclStackFree(interp);     /* free compiledLocals */
+    TclStackFree(interp);     /* free CallFrame      */
     return result;
 #undef NUM_LOCALS
 }