summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--ChangeLog7
-rw-r--r--generic/tclCompile.c140
-rw-r--r--generic/tclProc.c265
3 files changed, 242 insertions, 170 deletions
diff --git a/ChangeLog b/ChangeLog
index 8ffd2ae..a0f65ac 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2004-12-20 Miguel Sofer <msofer@users.sf.net>
+
+ * 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 procload time (instead of
+ two, asdone previously)
+
2004-12-16 Donal K. Fellows <donal.k.fellows@man.ac.uk>
* generic/tclInterp.c (Tcl_LimitSetTime, TimeLimitCallback):
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index a79d1ef..243cc14 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.79 2004/12/10 13:09:13 msofer Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.80 2004/12/20 18:27:18 msofer Exp $
*/
#include "tclInt.h"
@@ -1843,146 +1843,8 @@ TclFindCompiledLocal(name, nameBytes, create, flags, procPtr)
procPtr->numCompiledLocals++;
}
return localVar;
-}
-/*
- *----------------------------------------------------------------------
- *
- * TclInitCompiledLocals --
- *
- * 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.
- *
- *----------------------------------------------------------------------
- */
-
-void
-TclInitCompiledLocals(interp, framePtr, nsPtr)
- Tcl_Interp *interp; /* Current interpreter. */
- CallFrame *framePtr; /* Call frame to initialize. */
- Namespace *nsPtr; /* Pointer to current namespace. */
-{
- register CompiledLocal *localPtr;
- Interp *iPtr = (Interp*) interp;
- Tcl_ResolvedVarInfo *resVarInfo;
- Var *varPtr = framePtr->compiledLocals;
- int haveResolvers = (nsPtr->compiledVarResProc || iPtr->resolverPtr);
- ByteCode *codePtr = (ByteCode *)
- framePtr->procPtr->bodyPtr->internalRep.otherValuePtr;
-
- 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.
- */
-
- codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
-
- for (localPtr = framePtr->procPtr->firstLocalPtr; 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;
- }
- }
- }
- }
-
- /*
- * 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) {
- 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 = 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;
- varPtr->hPtr = NULL;
- varPtr->refCount = 0;
- varPtr->tracePtr = NULL;
- varPtr->searchPtr = NULL;
- varPtr->flags = localPtr->flags;
- varPtr++;
- }
- }
}
-
/*
*----------------------------------------------------------------------
*
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
}
generated by cgit v0.12 at 2024-11-09 05:53:24 (GMT)