Attachment "uplevel+lvt-3.patch" to
ticket [1973096fff]
added by
msofer
2008-06-08 10:23:20.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.300
diff -u -r1.300 tclBasic.c
--- generic/tclBasic.c 31 May 2008 19:56:06 -0000 1.300
+++ generic/tclBasic.c 8 Jun 2008 02:48:12 -0000
@@ -4578,85 +4578,85 @@
Tcl_IncrRefCount(objPtr);
+ /*
+ * Pure List Optimization (no string representation). In this case, we
+ * can safely use Tcl_EvalObjv instead and get an appreciable
+ * improvement in execution speed. This is because it allows us to
+ * avoid a setFromAny step that would just pack everything into a
+ * string and back out again.
+ *
+ * This restriction has been relaxed a bit by storing in lists whether
+ * they are "canonical" or not (a canonical list being one that is
+ * either pure or that has its string rep derived by
+ * UpdateStringOfList from the internal rep).
+ */
+
+ if (objPtr->typePtr == &tclListType) { /* is a list... */
+ List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
+
+ if (objPtr->bytes == NULL || /* ...without a string rep */
+ listRepPtr->canonicalFlag) {/* ...or that is canonical */
+ /*
+ * TIP #280 Structures for tracking lines. As we know that
+ * this is dynamic execution we ignore the invoker, even if
+ * known.
+ */
+
+ int line, i;
+ char *w;
+ Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr);
+ CmdFrame *eoFramePtr = (CmdFrame *)
+ TclStackAlloc(interp, sizeof(CmdFrame));
+
+ eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
+ eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
+ 1 : iPtr->cmdFramePtr->level + 1);
+ eoFramePtr->framePtr = iPtr->framePtr;
+ eoFramePtr->nextPtr = iPtr->cmdFramePtr;
+
+ Tcl_ListObjGetElements(NULL, copyPtr,
+ &(eoFramePtr->nline), &elements);
+ eoFramePtr->line = (int *)
+ ckalloc(eoFramePtr->nline * sizeof(int));
+
+ eoFramePtr->cmd.listPtr = objPtr;
+ Tcl_IncrRefCount(eoFramePtr->cmd.listPtr);
+ eoFramePtr->data.eval.path = NULL;
+
+ /*
+ * TIP #280 Computes all the line numbers for the words in the
+ * command.
+ */
+
+ line = 1;
+ for (i=0; i < eoFramePtr->nline; i++) {
+ eoFramePtr->line[i] = line;
+ w = TclGetString(elements[i]);
+ TclAdvanceLines(&line, w, w + strlen(w));
+ }
+
+ iPtr->cmdFramePtr = eoFramePtr;
+ result = Tcl_EvalObjv(interp, eoFramePtr->nline, elements,
+ flags);
+
+ Tcl_DecrRefCount(copyPtr);
+ iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
+ Tcl_DecrRefCount(eoFramePtr->cmd.listPtr);
+ ckfree((char *) eoFramePtr->line);
+ eoFramePtr->line = NULL;
+ eoFramePtr->nline = 0;
+ TclStackFree(interp, eoFramePtr);
+
+ goto done;
+ }
+ }
+
if (flags & TCL_EVAL_DIRECT) {
/*
* We're not supposed to use the compiler or byte-code interpreter.
* Let Tcl_EvalEx evaluate the command directly (and probably more
* slowly).
*
- * Pure List Optimization (no string representation). In this case, we
- * can safely use Tcl_EvalObjv instead and get an appreciable
- * improvement in execution speed. This is because it allows us to
- * avoid a setFromAny step that would just pack everything into a
- * string and back out again.
- *
- * This restriction has been relaxed a bit by storing in lists whether
- * they are "canonical" or not (a canonical list being one that is
- * either pure or that has its string rep derived by
- * UpdateStringOfList from the internal rep).
- */
-
- if (objPtr->typePtr == &tclListType) { /* is a list... */
- List *listRepPtr = objPtr->internalRep.twoPtrValue.ptr1;
-
- if (objPtr->bytes == NULL || /* ...without a string rep */
- listRepPtr->canonicalFlag) {/* ...or that is canonical */
- /*
- * TIP #280 Structures for tracking lines. As we know that
- * this is dynamic execution we ignore the invoker, even if
- * known.
- */
-
- int line, i;
- char *w;
- Tcl_Obj **elements, *copyPtr = TclListObjCopy(NULL, objPtr);
- CmdFrame *eoFramePtr = (CmdFrame *)
- TclStackAlloc(interp, sizeof(CmdFrame));
-
- eoFramePtr->type = TCL_LOCATION_EVAL_LIST;
- eoFramePtr->level = (iPtr->cmdFramePtr == NULL?
- 1 : iPtr->cmdFramePtr->level + 1);
- eoFramePtr->framePtr = iPtr->framePtr;
- eoFramePtr->nextPtr = iPtr->cmdFramePtr;
-
- Tcl_ListObjGetElements(NULL, copyPtr,
- &(eoFramePtr->nline), &elements);
- eoFramePtr->line = (int *)
- ckalloc(eoFramePtr->nline * sizeof(int));
-
- eoFramePtr->cmd.listPtr = objPtr;
- Tcl_IncrRefCount(eoFramePtr->cmd.listPtr);
- eoFramePtr->data.eval.path = NULL;
-
- /*
- * TIP #280 Computes all the line numbers for the words in the
- * command.
- */
-
- line = 1;
- for (i=0; i < eoFramePtr->nline; i++) {
- eoFramePtr->line[i] = line;
- w = TclGetString(elements[i]);
- TclAdvanceLines(&line, w, w + strlen(w));
- }
-
- iPtr->cmdFramePtr = eoFramePtr;
- result = Tcl_EvalObjv(interp, eoFramePtr->nline, elements,
- flags);
-
- Tcl_DecrRefCount(copyPtr);
- iPtr->cmdFramePtr = iPtr->cmdFramePtr->nextPtr;
- Tcl_DecrRefCount(eoFramePtr->cmd.listPtr);
- ckfree((char *) eoFramePtr->line);
- eoFramePtr->line = NULL;
- eoFramePtr->nline = 0;
- TclStackFree(interp, eoFramePtr);
-
- goto done;
- }
- }
-
- /*
* TIP #280. Propagate context as much as we can. Especially if the
* script to evaluate is a single literal it makes sense to look if
* our context is one with absolute line numbers we can then track
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 8 Jun 2008 02:48:18 -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 8 Jun 2008 02:48:20 -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 8 Jun 2008 02:48:20 -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 8 Jun 2008 02:48:27 -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 8 Jun 2008 02:48:53 -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
Index: tests/uplevel.test
===================================================================
RCS file: /cvsroot/tcl/tcl/tests/uplevel.test,v
retrieving revision 1.8
diff -u -r1.8 uplevel.test
--- tests/uplevel.test 19 May 2004 10:47:28 -0000 1.8
+++ tests/uplevel.test 8 Jun 2008 02:51:52 -0000
@@ -126,6 +126,73 @@
lappend res [namespace eval ns1 a2]
} {::ns1 :: ::ns1 ::}
+#
+# These tests verify that upleveled scripts run in the correct level and access
+# the proper variables.
+#
+
+test uplevel-7.1 {var access, no LVT in either level} -setup {
+ set x 1
+ unset -nocomplain y z
+} -body {
+ namespace eval foo {
+ set x 2
+ set y 2
+ uplevel 1 {
+ set x 3
+ set y 3
+ set z 3
+ }
+ }
+ list $x $y $z
+} -cleanup {
+ namespace delete foo
+ unset -nocomplain x y z
+} -result {3 3 3}
+
+test uplevel-7.2 {var access, no LVT in upper level} -setup {
+ set x 1
+ unset -nocomplain y z
+} -body {
+ proc foo {} {
+ set x 2
+ set y 2
+ uplevel 1 {
+ set x 3
+ set y 3
+ set z 3
+ }
+ }
+ foo
+ list $x $y $z
+} -cleanup {
+ rename foo {}
+ unset -nocomplain x y z
+} -result {3 3 3}
+
+test uplevel-7.3 {var access, LVT in upper level} -setup {
+ proc moo {} {
+ set x 1; #var in LVT
+ unset -nocomplain y z
+ foo
+ list $x $y $z
+ }
+} -body {
+ proc foo {} {
+ set x 2
+ set y 2
+ uplevel 1 {
+ set x 3
+ set y 3
+ set z 3
+ }
+ }
+ foo
+ moo
+} -cleanup {
+ rename foo {}
+ rename moo {}
+} -result {3 3 3}
# cleanup
::tcltest::cleanupTests
