diff options
Diffstat (limited to 'generic')
| -rw-r--r-- | generic/tclCompile.c | 140 | ||||
| -rw-r--r-- | generic/tclProc.c | 265 |
2 files changed, 235 insertions, 170 deletions
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 } |