8 files changed, 287 insertions, 134 deletions

diff --git a/ChangeLog b/ChangeLog
index cb4114c..0df1673 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2008-06-08  Miguel Sofer  <msofer@users.sf.net>
+	* generic/tclBasic.c:      Compilation of uplevel scripts, allow
+	* generic/tclCompCmds.c:   non-body compiled scripts to access the
+	* generic/tclCompile.c:    LVT (but not to extend it) and enable the
+	* generic/tclCompile.h:    canonical list opt to sidestep the
+	* generic/tclExecute.c:    compiler. This is [Patch 1973096]
+	* generic/tclProc.c:
+	* tests/uplevel.test:
+	
+
 2008-06-06  Andreas Kupries  <andreask@activestate.com>
 
 	TIP #230 IMPLEMENTATION
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 57fefe2..9210fd7 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.300 2008/05/31 19:56:06 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.301 2008/06/08 03:21:31 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -4578,85 +4578,85 @@ TclEvalObjEx(
 
     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
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 87cb891..ac0b2c2 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompCmds.c,v 1.144 2008/05/07 09:07:11 dkf Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.145 2008/06/08 03:21:32 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -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 @@ static void		CompileReturnInternal(CompileEnv *envPtr,
  * 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 @@ TclCompileAppendCmd(
 
     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 @@ TclCompileCatchCmd(
      * (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 @@ TclCompileCatchCmd(
 	    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 @@ TclCompileCatchCmd(
 		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 @@ TclCompileDictSetCmd(
 {
     Tcl_Token *tokenPtr;
     int numWords, i;
-    Proc *procPtr = envPtr->procPtr;
     DefineLineInformation;	/* TIP #280 */
     Tcl_Token *varTokenPtr;
     int dictVarIndex, nameChars;
@@ -643,7 +655,7 @@ TclCompileDictSetCmd(
      * 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 @@ TclCompileDictSetCmd(
     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 @@ TclCompileDictIncrCmd(
 				 * 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 @@ TclCompileDictIncrCmd(
      * 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 @@ TclCompileDictIncrCmd(
     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 @@ TclCompileDictForCmd(
 				 * 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 @@ TclCompileDictForCmd(
      * 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 @@ TclCompileDictForCmd(
 	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 @@ TclCompileDictForCmd(
      * (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 @@ TclCompileDictUpdateCmd(
 				 * 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 @@ TclCompileDictUpdateCmd(
      * 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 @@ TclCompileDictUpdateCmd(
     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 @@ TclCompileDictUpdateCmd(
 	 */
 
 	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 @@ TclCompileDictAppendCmd(
 				 * compiled. */
     CompileEnv *envPtr)		/* Holds resulting instructions. */
 {
-    Proc *procPtr = envPtr->procPtr;
     DefineLineInformation;	/* TIP #280 */
     Tcl_Token *tokenPtr;
     int i, dictVarIndex;
@@ -1184,7 +1213,7 @@ TclCompileDictAppendCmd(
      * 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 @@ TclCompileDictAppendCmd(
 	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 @@ TclCompileDictLappendCmd(
 				 * 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 @@ TclCompileDictLappendCmd(
      * 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 @@ TclCompileDictLappendCmd(
     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 @@ TclCompileForeachCmd(
     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 @@ TclCompileForeachCmd(
 	    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 @@ TclCompileIncrCmd(
 
     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 @@ TclCompileLappendCmd(
 
     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 @@ TclCompileLassignCmd(
 	 * 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 @@ TclCompileLsetCmd(
      */
 
     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 @@ TclCompileSetCmd(
      */
 
     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 @@ PushVarName(
     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 @@ PushVarName(
 	 * 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 @@ CompileComparisonOpCmd(
 
 	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 @@ IndexTailVarIfKnown(
      * only one.
      */
 
-    if (envPtr->procPtr == NULL) {
+    if (!EnvHasLVT(envPtr)) {
 	return -1;
     }
 
@@ -5752,8 +5785,7 @@ IndexTailVarIfKnown(
     }
 
     localIndex = TclFindCompiledLocal(tailName, len,
-	    /*create*/ TCL_CREATE_VAR,
-	    envPtr->procPtr);
+	    1, envPtr);
     Tcl_DecrRefCount(tailPtr);
     return localIndex;
 }
@@ -5849,7 +5881,7 @@ TclCompileUpvarCmd(
 	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 @@ TclCompileNamespaceCmd(
 	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 @@ TclCompileInfoExistsCmd(
      */
 
     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]);
 
     /*
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index fd6f25e..187d81e 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.148 2008/05/30 22:54:28 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.149 2008/06/08 03:21:33 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1657,7 +1657,7 @@ TclCompileTokens(
 	    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 @@ TclFindCompiledLocal(
     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;
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index 06447df..7e6ff50 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -9,7 +9,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.h,v 1.91 2008/05/02 10:27:05 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.92 2008/06/08 03:21:33 msofer Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -888,7 +888,7 @@ MODULE_SCOPE int	TclExecuteByteCode(Tcl_Interp *interp,
 			    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,
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 89c2066..5bbc366 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.371 2008/04/27 22:21:30 dkf Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.372 2008/06/08 03:21:33 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -1463,7 +1463,18 @@ TclCompEvalObj(
 	    }
 	}
 
-	/*
+	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 @@ TclCompEvalObj(
     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--;
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 8aa8779..85f49f9 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.c
@@ -12,7 +12,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.140 2008/04/27 22:21:32 dkf Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.141 2008/06/08 03:21:33 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -908,7 +908,7 @@ Tcl_UplevelObjCmd(
      */
 
     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
diff --git a/tests/uplevel.test b/tests/uplevel.test
index b8bbbb7..f676290 100644
--- a/tests/uplevel.test
+++ b/tests/uplevel.test
@@ -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: uplevel.test,v 1.8 2004/05/19 10:47:28 dkf Exp $
+# RCS: @(#) $Id: uplevel.test,v 1.9 2008/06/08 03:21:33 msofer Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -126,6 +126,73 @@ test uplevel-6.1 {uplevel and shadowed cmds} {
     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