Attachment "uplevel+lvt-2.patch" to
ticket [1973096fff]
added by
msofer
2008-06-02 05:38:41.
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.144
diff -u -r1.144 tclCompCmds.c
--- generic/tclCompCmds.c 7 May 2008 09:07:11 -0000 1.144
+++ generic/tclCompCmds.c 1 Jun 2008 22:05:42 -0000
@@ -131,6 +131,14 @@
((envPtr)->exceptArrayPtr[(index)].targetType = CurrentOffset(envPtr))
/*
+ * Check if there is an LVT for compiled locals
+ */
+
+#define EnvHasLVT(envPtr) \
+ (envPtr->procPtr || envPtr->iPtr->varFramePtr->localCachePtr)
+
+
+/*
* Prototypes for procedures defined later in this file:
*/
@@ -173,8 +181,7 @@
* Flags bits used by PushVarName.
*/
-#define TCL_CREATE_VAR 1 /* Create a compiled local if none is found */
-#define TCL_NO_LARGE_INDEX 2 /* Do not return localIndex value > 255 */
+#define TCL_NO_LARGE_INDEX 1 /* Do not return localIndex value > 255 */
/*
* The structures below define the AuxData types defined in this file.
@@ -259,7 +266,7 @@
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ PushVarName(interp, varTokenPtr, envPtr, 0,
&localIndex, &simpleVarName, &isScalar,
mapPtr->loc[eclIndex].line[1]);
@@ -390,7 +397,7 @@
* (not in a procedure), don't compile it inline: the payoff is too small.
*/
- if ((parsePtr->numWords >= 3) && (envPtr->procPtr == NULL)) {
+ if ((parsePtr->numWords >= 3) && !EnvHasLVT(envPtr)) {
return TCL_ERROR;
}
@@ -414,8 +421,11 @@
return TCL_ERROR;
}
resultIndex = TclFindCompiledLocal(resultNameTokenPtr[1].start,
- resultNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr);
-
+ resultNameTokenPtr[1].size, /*create*/ 1, envPtr);
+ if (resultIndex < 0) {
+ return TCL_ERROR;
+ }
+
/* DKF */
if (parsePtr->numWords == 4) {
optsNameTokenPtr = TokenAfter(resultNameTokenPtr);
@@ -428,7 +438,10 @@
return TCL_ERROR;
}
optsIndex = TclFindCompiledLocal(optsNameTokenPtr[1].start,
- optsNameTokenPtr[1].size, /*create*/ 1, envPtr->procPtr);
+ optsNameTokenPtr[1].size, /*create*/ 1, envPtr);
+ if (optsIndex < 0) {
+ return TCL_ERROR;
+ }
}
}
@@ -633,7 +646,6 @@
{
Tcl_Token *tokenPtr;
int numWords, i;
- Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr;
int dictVarIndex, nameChars;
@@ -643,7 +655,7 @@
* There must be at least one argument after the command.
*/
- if (parsePtr->numWords < 4 || procPtr == NULL) {
+ if (parsePtr->numWords < 4) {
return TCL_ERROR;
}
@@ -662,7 +674,10 @@
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
- dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
+ dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
+ if (dictVarIndex < 0) {
+ return TCL_ERROR;
+ }
/*
* Remaining words (key path and value to set) can be handled normally.
@@ -693,7 +708,6 @@
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *keyTokenPtr;
int dictVarIndex, nameChars, incrAmount;
@@ -703,7 +717,7 @@
* There must be at least two arguments after the command.
*/
- if (parsePtr->numWords < 3 || parsePtr->numWords > 4 || procPtr == NULL) {
+ if (parsePtr->numWords < 3 || parsePtr->numWords > 4) {
return TCL_ERROR;
}
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -751,7 +765,10 @@
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
- dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
+ dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
+ if (dictVarIndex < 0) {
+ return TCL_ERROR;
+ }
/*
* Emit the key and the code to actually do the increment.
@@ -808,7 +825,6 @@
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Token *varsTokenPtr, *dictTokenPtr, *bodyTokenPtr;
int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
@@ -824,7 +840,7 @@
* There must be at least three argument after the command.
*/
- if (parsePtr->numWords != 4 || procPtr == NULL) {
+ if (parsePtr->numWords != 4) {
return TCL_ERROR;
}
@@ -859,16 +875,20 @@
ckfree((char *) argv);
return TCL_ERROR;
}
- keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, procPtr);
+ keyVarIndex = TclFindCompiledLocal(argv[0], nameChars, 1, envPtr);
nameChars = strlen(argv[1]);
if (!TclIsLocalScalar(argv[1], nameChars)) {
ckfree((char *) argv);
return TCL_ERROR;
}
- valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, procPtr);
+ valueVarIndex = TclFindCompiledLocal(argv[1], nameChars, 1, envPtr);
ckfree((char *) argv);
+ if ((keyVarIndex < 0) || (valueVarIndex < 0)) {
+ return TCL_ERROR;
+ }
+
/*
* Allocate a temporary variable to store the iterator reference. The
* variable will contain a Tcl_DictSearch reference which will be
@@ -876,7 +896,10 @@
* (at which point it should also have been finished with).
*/
- infoIndex = TclFindCompiledLocal(NULL, 0, 1, procPtr);
+ infoIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr);
+ if (infoIndex < 0) {
+ return TCL_ERROR;
+ }
/*
* Preparation complete; issue instructions. Note that this code issues
@@ -1007,7 +1030,6 @@
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
const char *name;
int i, nameChars, dictIndex, numVars, range, infoIndex;
@@ -1019,7 +1041,7 @@
* There must be at least one argument after the command.
*/
- if (parsePtr->numWords < 5 || procPtr == NULL) {
+ if (parsePtr->numWords < 5) {
return TCL_ERROR;
}
@@ -1048,7 +1070,10 @@
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
- dictIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
+ dictIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
+ if (dictIndex < 0) {
+ return TCL_ERROR;
+ }
/*
* Assemble the instruction metadata. This is complex enough that it is
@@ -1093,7 +1118,12 @@
*/
duiPtr->varIndices[i] =
- TclFindCompiledLocal(name, nameChars, 1, procPtr);
+ TclFindCompiledLocal(name, nameChars, 1, envPtr);
+ if (duiPtr->varIndices[i] < 0) {
+ ckfree((char *) duiPtr);
+ TclStackFree(interp, keyTokenPtrs);
+ return TCL_ERROR;
+ }
tokenPtr = TokenAfter(tokenPtr);
}
if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
@@ -1173,7 +1203,6 @@
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Token *tokenPtr;
int i, dictVarIndex;
@@ -1184,7 +1213,7 @@
* speed quite so much. ;-)
*/
- if (parsePtr->numWords<4 || parsePtr->numWords>100 || procPtr==NULL) {
+ if (parsePtr->numWords<4 || parsePtr->numWords>100) {
return TCL_ERROR;
}
@@ -1202,7 +1231,10 @@
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
- dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
+ dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
+ if (dictVarIndex < 0) {
+ return TCL_ERROR;
+ }
}
/*
@@ -1235,7 +1267,6 @@
* compiled. */
CompileEnv *envPtr) /* Holds resulting instructions. */
{
- Proc *procPtr = envPtr->procPtr;
DefineLineInformation; /* TIP #280 */
Tcl_Token *varTokenPtr, *keyTokenPtr, *valueTokenPtr;
int dictVarIndex, nameChars;
@@ -1245,7 +1276,7 @@
* There must be three arguments after the command.
*/
- if (parsePtr->numWords != 4 || procPtr == NULL) {
+ if (parsePtr->numWords != 4) {
return TCL_ERROR;
}
@@ -1260,7 +1291,10 @@
if (!TclIsLocalScalar(name, nameChars)) {
return TCL_ERROR;
}
- dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, procPtr);
+ dictVarIndex = TclFindCompiledLocal(name, nameChars, 1, envPtr);
+ if (dictVarIndex < 0) {
+ return TCL_ERROR;
+ }
CompileWord(envPtr, keyTokenPtr, interp, 3);
CompileWord(envPtr, valueTokenPtr, interp, 4);
TclEmitInstInt4( INST_DICT_LAPPEND, dictVarIndex, envPtr);
@@ -1702,13 +1736,13 @@
firstValueTemp = -1;
for (loopIndex = 0; loopIndex < numLists; loopIndex++) {
tempVar = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
- /*create*/ 1, procPtr);
+ /*create*/ 1, envPtr);
if (loopIndex == 0) {
firstValueTemp = tempVar;
}
}
loopCtTemp = TclFindCompiledLocal(NULL, /*nameChars*/ 0,
- /*create*/ 1, procPtr);
+ /*create*/ 1, envPtr);
/*
* Create and initialize the ForeachInfo and ForeachVarList data
@@ -1732,7 +1766,7 @@
int nameChars = strlen(varName);
varListPtr->varIndexes[j] = TclFindCompiledLocal(varName,
- nameChars, /*create*/ 1, procPtr);
+ nameChars, /*create*/ 1, envPtr);
}
infoPtr->varLists[loopIndex] = varListPtr;
}
@@ -2356,7 +2390,7 @@
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX|TCL_CREATE_VAR,
+ PushVarName(interp, varTokenPtr, envPtr, TCL_NO_LARGE_INDEX,
&localIndex, &simpleVarName, &isScalar,
mapPtr->loc[eclIndex].line[1]);
@@ -2499,7 +2533,7 @@
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ PushVarName(interp, varTokenPtr, envPtr, 0,
&localIndex, &simpleVarName, &isScalar,
mapPtr->loc[eclIndex].line[1]);
@@ -2606,7 +2640,7 @@
* Generate the next variable name.
*/
- PushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
+ PushVarName(interp, tokenPtr, envPtr, 0, &localIndex,
&simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[idx+2]);
/*
@@ -2943,7 +2977,7 @@
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ PushVarName(interp, varTokenPtr, envPtr, 0,
&localIndex, &simpleVarName, &isScalar,
mapPtr->loc[eclIndex].line[1]);
@@ -3445,7 +3479,7 @@
*/
varTokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, varTokenPtr, envPtr, TCL_CREATE_VAR,
+ PushVarName(interp, varTokenPtr, envPtr, 0,
&localIndex, &simpleVarName, &isScalar,
mapPtr->loc[eclIndex].line[1]);
@@ -4873,7 +4907,7 @@
Tcl_Interp *interp, /* Used for error reporting. */
Tcl_Token *varTokenPtr, /* Points to a variable token. */
CompileEnv *envPtr, /* Holds resulting instructions. */
- int flags, /* TCL_CREATE_VAR or TCL_NO_LARGE_INDEX. */
+ int flags, /* TCL_NO_LARGE_INDEX. */
int *localIndexPtr, /* Must not be NULL. */
int *simpleVarNamePtr, /* Must not be NULL. */
int *isScalarPtr, /* Must not be NULL. */
@@ -5038,10 +5072,9 @@
* push its name and look it up at runtime.
*/
- if ((envPtr->procPtr != NULL) && !hasNsQualifiers) {
+ if (!hasNsQualifiers) {
localIndex = TclFindCompiledLocal(name, nameChars,
- /*create*/ flags & TCL_CREATE_VAR,
- envPtr->procPtr);
+ 1, envPtr);
if ((flags & TCL_NO_LARGE_INDEX) && (localIndex > 255)) {
/*
* We'll push the name.
@@ -5255,7 +5288,7 @@
return TCL_ERROR;
} else {
- int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr->procPtr);
+ int tmpIndex = TclFindCompiledLocal(NULL, 0, 1, envPtr);
int words;
tokenPtr = TokenAfter(parsePtr->tokenPtr);
@@ -5701,7 +5734,7 @@
* only one.
*/
- if (envPtr->procPtr == NULL) {
+ if (!EnvHasLVT(envPtr)) {
return -1;
}
@@ -5752,8 +5785,7 @@
}
localIndex = TclFindCompiledLocal(tailName, len,
- /*create*/ TCL_CREATE_VAR,
- envPtr->procPtr);
+ 1, envPtr);
Tcl_DecrRefCount(tailPtr);
return localIndex;
}
@@ -5849,7 +5881,7 @@
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, 1);
- PushVarName(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
+ PushVarName(interp, localTokenPtr, envPtr, 0,
&localIndex, &simpleVarName, &isScalar,
mapPtr->loc[eclIndex].line[1]);
@@ -5942,7 +5974,7 @@
localTokenPtr = TokenAfter(otherTokenPtr);
CompileWord(envPtr, otherTokenPtr, interp, 1);
- PushVarName(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
+ PushVarName(interp, localTokenPtr, envPtr, 0,
&localIndex, &simpleVarName, &isScalar,
mapPtr->loc[eclIndex].line[1]);
@@ -6444,7 +6476,7 @@
*/
tokenPtr = TokenAfter(parsePtr->tokenPtr);
- PushVarName(interp, tokenPtr, envPtr, TCL_CREATE_VAR, &localIndex,
+ PushVarName(interp, tokenPtr, envPtr, 0, &localIndex,
&simpleVarName, &isScalar, mapPtr->loc[eclIndex].line[1]);
/*
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.148
diff -u -r1.148 tclCompile.c
--- generic/tclCompile.c 30 May 2008 22:54:28 -0000 1.148
+++ generic/tclCompile.c 1 Jun 2008 22:05:44 -0000
@@ -1657,7 +1657,7 @@
localVar = -1;
if (localVarName != -1) {
localVar = TclFindCompiledLocal(name, nameBytes, localVarName,
- envPtr->procPtr);
+ envPtr);
}
if (localVar < 0) {
TclEmitPush(TclRegisterNewLiteral(envPtr, name, nameBytes),
@@ -2096,18 +2096,47 @@
int nameBytes, /* Number of bytes in the name. */
int create, /* If 1, allocate a local frame entry for the
* variable if it is new. */
- register Proc *procPtr) /* Points to structure describing procedure
- * containing the variable reference. */
+ CompileEnv *envPtr) /* Points to the current compile environment*/
{
register CompiledLocal *localPtr;
int localVar = -1;
register int i;
+ Proc *procPtr;
/*
* If not creating a temporary, does a local variable of the specified
* name already exist?
*/
+ procPtr = envPtr->procPtr;
+
+ if (procPtr == NULL) {
+ /*
+ * Compiling a non-body script: give it read access to the LVT in the
+ * current localCache
+ */
+
+ LocalCache *cachePtr = envPtr->iPtr->varFramePtr->localCachePtr;
+ char *localName;
+ Tcl_Obj **varNamePtr;
+ int len;
+
+ if (!cachePtr || !name) {
+ return -1;
+ }
+
+ varNamePtr = &cachePtr->varName0;
+ for (i=0; i < cachePtr->numVars; varNamePtr++, i++) {
+ if (*varNamePtr) {
+ localName = Tcl_GetStringFromObj(*varNamePtr, &len);
+ if ((len == nameBytes) && !strncmp(name, localName, len)) {
+ return i;
+ }
+ }
+ }
+ return -1;
+ }
+
if (name != NULL) {
int localCt = procPtr->numCompiledLocals;
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.91
diff -u -r1.91 tclCompile.h
--- generic/tclCompile.h 2 May 2008 10:27:05 -0000 1.91
+++ generic/tclCompile.h 1 Jun 2008 22:05:44 -0000
@@ -888,7 +888,7 @@
ByteCode *codePtr);
MODULE_SCOPE void TclFinalizeAuxDataTypeTable(void);
MODULE_SCOPE int TclFindCompiledLocal(const char *name, int nameChars,
- int create, Proc *procPtr);
+ int create, CompileEnv *envPtr);
MODULE_SCOPE LiteralEntry * TclLookupLiteralEntry(Tcl_Interp *interp,
Tcl_Obj *objPtr);
MODULE_SCOPE int TclFixupForwardJump(CompileEnv *envPtr,
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.371
diff -u -r1.371 tclExecute.c
--- generic/tclExecute.c 27 Apr 2008 22:21:30 -0000 1.371
+++ generic/tclExecute.c 1 Jun 2008 22:05:50 -0000
@@ -1463,7 +1463,18 @@
}
}
- /*
+ if (codePtr->procPtr == NULL) {
+ /*
+ * Check that any compiled locals do refer to the current proc
+ * environment! If not, recompile.
+ */
+
+ if (codePtr->localCachePtr != iPtr->varFramePtr->localCachePtr) {
+ goto recompileObj;
+ }
+ }
+
+ /*
* Increment the code's ref count while it is being executed. If
* afterwards no references to it remain, free the code.
*/
@@ -1493,7 +1504,11 @@
tclByteCodeType.setFromAnyProc(interp, objPtr);
iPtr->invokeCmdFramePtr = NULL;
codePtr = (ByteCode *) objPtr->internalRep.otherValuePtr;
- goto runCompiledObj;
+ if (iPtr->varFramePtr->localCachePtr) {
+ codePtr->localCachePtr = iPtr->varFramePtr->localCachePtr;
+ codePtr->localCachePtr->refCount++;
+ }
+ goto runCompiledObj;
done:
iPtr->numLevels--;
Index: generic/tclProc.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclProc.c,v
retrieving revision 1.140
diff -u -r1.140 tclProc.c
--- generic/tclProc.c 27 Apr 2008 22:21:32 -0000 1.140
+++ generic/tclProc.c 1 Jun 2008 22:06:11 -0000
@@ -908,7 +908,7 @@
*/
if (objc == 1) {
- result = Tcl_EvalObjEx(interp, objv[0], TCL_EVAL_DIRECT);
+ result = Tcl_EvalObjEx(interp, objv[0], 0);
} else {
/*
* More than one argument: concatenate them together with spaces
