Attachment "initlocals" to
ticket [1081779fff]
added by
msofer
2004-12-10 20:11:29.
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.78
diff -u -r1.78 tclCompile.c
--- generic/tclCompile.c 8 Oct 2004 15:39:52 -0000 1.78
+++ generic/tclCompile.c 10 Dec 2004 13:03:41 -0000
@@ -1666,7 +1666,11 @@
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 @@
{
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;
-
- if (nsPtr->compiledVarResProc) {
- result = (*nsPtr->compiledVarResProc)(nsPtr->interp,
- localPtr->name, localPtr->nameLength,
- (Tcl_Namespace *) nsPtr, &vinfo);
- } else {
- result = TCL_CONTINUE;
- }
+ codePtr->flags &= ~TCL_BYTECODE_RESOLVE_VARS;
+
+ for (localPtr = framePtr->procPtr->firstLocalPtr; localPtr != NULL;
+ localPtr = localPtr->nextPtr) {
- while ((result == TCL_CONTINUE) && resPtr) {
- if (resPtr->compiledVarResProc) {
- result = (*resPtr->compiledVarResProc)(nsPtr->interp,
+ 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;
}
- 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 @@
varPtr->tracePtr = NULL;
varPtr->searchPtr = NULL;
varPtr->flags = localPtr->flags;
- }
- varPtr++;
+ varPtr++;
+ }
}
}
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.51
diff -u -r1.51 tclCompile.h
--- generic/tclCompile.h 3 Nov 2004 21:20:30 -0000 1.51
+++ generic/tclCompile.h 10 Dec 2004 13:03:42 -0000
@@ -273,6 +273,14 @@
*/
#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
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.204
diff -u -r1.204 tclInt.h
--- generic/tclInt.h 10 Dec 2004 00:16:55 -0000 1.204
+++ generic/tclInt.h 10 Dec 2004 13:03:44 -0000
@@ -510,6 +510,7 @@
#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.
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.66
diff -u -r1.66 tclProc.c
--- generic/tclProc.c 25 Nov 2004 16:37:15 -0000 1.66
+++ generic/tclProc.c 10 Dec 2004 13:03:45 -0000
@@ -341,6 +341,7 @@
procPtr->numArgs = numArgs;
procPtr->numCompiledLocals = numArgs;
}
+
for (i = 0; i < numArgs; i++) {
int fieldCount, nameLength, valueLength;
CONST char **fieldValues;
@@ -445,6 +446,12 @@
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 @@
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 @@
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 @@
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 @@
* Invoke the commands in the procedure's body.
*/
+ runProc:
#ifdef TCL_COMPILE_DEBUG
if (tclTraceExec >= 1) {
fprintf(stdout, "Calling proc ");
@@ -1252,25 +1275,12 @@
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;
}
