* generic/tclBasic.c: Added bytecode compilers for the

	* generic/tclCompCmds.c:  variable linking commands: 'global',
	* generic/tclCompile.h:   'variable', 'upvar', 'namespace upvar'
	* generic/tclExecute.c:   [Patch 1688593]
	* generic/tclInt.h:
	* generic/tclVar.c:

7 files changed, 630 insertions, 85 deletions

diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index d35dd6c..56282b7 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.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: tclBasic.c,v 1.240 2007/04/02 18:48:03 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.241 2007/04/03 01:34:35 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -141,7 +141,7 @@ static const CmdInfo builtInCmds[] = {
     {"for",		Tcl_ForObjCmd,		TclCompileForCmd,	1},
     {"foreach",		Tcl_ForeachObjCmd,	TclCompileForeachCmd,	1},
     {"format",		Tcl_FormatObjCmd,	NULL,			1},
-    {"global",		Tcl_GlobalObjCmd,	NULL,			1},
+    {"global",		Tcl_GlobalObjCmd,	TclCompileGlobalCmd,	1},
     {"if",		Tcl_IfObjCmd,		TclCompileIfCmd,	1},
     {"incr",		Tcl_IncrObjCmd,		TclCompileIncrCmd,	1},
     {"info",		Tcl_InfoObjCmd,		NULL,			1},
@@ -160,7 +160,7 @@ static const CmdInfo builtInCmds[] = {
     {"lsearch",		Tcl_LsearchObjCmd,	NULL,			1},
     {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	1},
     {"lsort",		Tcl_LsortObjCmd,	NULL,			1},
-    {"namespace",	Tcl_NamespaceObjCmd,	NULL,			1},
+    {"namespace",	Tcl_NamespaceObjCmd,	TclCompileNamespaceCmd,	1},
     {"package",		Tcl_PackageObjCmd,	NULL,			1},
     {"proc",		Tcl_ProcObjCmd,		NULL,			1},
     {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	1},
@@ -177,8 +177,8 @@ static const CmdInfo builtInCmds[] = {
     {"unload",		Tcl_UnloadObjCmd,	NULL,			1},
     {"unset",		Tcl_UnsetObjCmd,	NULL,			1},
     {"uplevel",		Tcl_UplevelObjCmd,	NULL,			1},
-    {"upvar",		Tcl_UpvarObjCmd,	NULL,			1},
-    {"variable",	Tcl_VariableObjCmd,	NULL,			1},
+    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	1},
+    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	1},
     {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	1},
 
     /*
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 86736ac..91344a5 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.104 2007/03/30 16:38:06 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.105 2007/04/03 01:34:36 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -4295,74 +4295,6 @@ PrintJumptableInfo(
 /*
  *----------------------------------------------------------------------
  *
- * TclCompileVariableCmd --
- *
- *	Procedure called to reserve the local variables for the "variable"
- *	command. The command itself is *not* compiled.
- *
- * Results:
- *	Always returns TCL_ERROR.
- *
- * Side effects:
- *	Indexed local variables are added to the environment.
- *
- *----------------------------------------------------------------------
- */
-
-int
-TclCompileVariableCmd(
-    Tcl_Interp *interp,		/* Used for error reporting. */
-    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
-				 * created by Tcl_ParseCommand. */
-    CompileEnv *envPtr)		/* Holds resulting instructions. */
-{
-    Tcl_Token *varTokenPtr;
-    int i, numWords;
-    const char *varName, *tail;
-
-    if (envPtr->procPtr == NULL) {
-	return TCL_ERROR;
-    }
-
-    numWords = parsePtr->numWords;
-
-    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
-    for (i = 1; i < numWords; i += 2) {
-	/*
-	 * Skip non-literals.
-	 */
-
-	if (varTokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    continue;
-	}
-
-	varName = varTokenPtr[1].start;
-	tail = varName + varTokenPtr[1].size - 1;
-
-	/*
-	 * Skip if it looks like it might be an array or an empty string.
-	 */
-
-	if ((*tail == ')') || (tail < varName)) {
-	    continue;
-	}
-
-	while ((tail > varName) && ((*tail != ':') || (*(tail-1) != ':'))) {
-	    tail--;
-	}
-	if ((*tail == ':') && (tail > varName)) {
-	    tail++;
-	}
-	(void) TclFindCompiledLocal(tail, tail-varName+1,
-		/*create*/ 1, /*flags*/ 0, envPtr->procPtr);
-	varTokenPtr = TokenAfter(varTokenPtr);
-    }
-    return TCL_ERROR;
-}
-
-/*
- *----------------------------------------------------------------------
- *
  * TclCompileWhileCmd --
  *
  *	Procedure called to compile the "while" command.
@@ -5301,6 +5233,469 @@ TclCompileDivOpCmd(
     }
     return TCL_OK;
 }
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * IndexTailVarIfKnown --
+ *
+ *	Procedure used in compiling [global] and [variable] commands. It
+ *	inspects the variable name described by varTokenPtr and, if the tail
+ *	is known at compile time, defines a corresponding local variable.
+ *
+ * Results:
+ * 	Returns the variable's index in the table of compiled locals if the
+ *      tail is known at compile time, or -1 otherwise. 
+ *
+ * Side effects:
+ *	None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static int
+IndexTailVarIfKnown(
+    Tcl_Interp *interp,
+    Tcl_Token *varTokenPtr,    /* Token representing the variable name */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */    
+{
+    Tcl_Obj *tailPtr;
+    const char *tailName, *p;
+    int len, n = varTokenPtr->numComponents;
+    Tcl_Token *lastTokenPtr;
+    int full, localIndex;
+    
+    /*
+     * Determine if the tail is (a) known at compile time, and (b) not an
+     * array element. Should any of these fail, return an error so that
+     * the non-compiled command will be called at runtime.
+     * In order for the tail to be known at compile time, the last token
+     * in the word has to be constant and contain "::" if it is not the
+     * only one.
+     */
+
+    if (envPtr->procPtr == NULL) {
+	return -1;
+    }
+
+    TclNewObj(tailPtr);
+    if (TclWordKnownAtCompileTime(varTokenPtr, tailPtr)) {
+	full = 1;
+	lastTokenPtr = varTokenPtr;
+    } else {
+	full = 0;
+	lastTokenPtr = varTokenPtr + n;	
+	if (!TclWordKnownAtCompileTime(lastTokenPtr, tailPtr)) {
+	    Tcl_DecrRefCount(tailPtr);
+	    return -1;
+	}
+    }
+	    
+    tailName = Tcl_GetStringFromObj(tailPtr, &len);
+
+    if (len) {
+	if (*(tailName+len-1) == ')') {
+	    /*
+	     * Possible array: bail out
+	     */
+	    
+	    Tcl_DecrRefCount(tailPtr);
+	    return -1;
+	}
+
+	/*
+	 * Get the tail: immediately after the last '::'
+	 */
+	
+	for(p = tailName + len -1; p > tailName; p--) {
+	    if ((*p == ':') && (*(p-1) == ':')) {
+		p++;
+		break;
+	    }
+	}
+	if (!full && (p == tailName)) {
+	    /*
+	     * No :: in the last component
+	     */
+	    Tcl_DecrRefCount(tailPtr);
+	    return -1;
+	}
+	len -= p - tailName;
+	tailName = p;
+    }
+
+    localIndex = TclFindCompiledLocal(tailName, len,
+	    /*create*/ TCL_CREATE_VAR,
+	    /*flags*/  0,
+	    envPtr->procPtr);
+    Tcl_DecrRefCount(tailPtr);
+    return localIndex;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileUpvarCmd --
+ *
+ *	Procedure called to compile the "upvar" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "upvar" command at
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileUpvarCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
+    int simpleVarName, isScalar, localIndex, numWords, i;    
+    DefineLineInformation;	/* TIP #280 */
+    Tcl_Obj *objPtr = Tcl_NewObj();
+    
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+    
+    numWords = parsePtr->numWords;
+    if (numWords < 3) {
+	return TCL_ERROR;
+    }
+
+
+    /*
+     * Push the frame index if it is known at compile time
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if(TclWordKnownAtCompileTime(tokenPtr, objPtr)) {
+	CallFrame *framePtr;
+	Tcl_ObjType *newTypePtr, *typePtr = objPtr->typePtr;
+
+	/*
+	 * Attempt to convert to a level reference. Note that TclObjGetFrame
+	 * only changes the obj type when a conversion was successful.
+	 */
+	
+	TclObjGetFrame(interp, objPtr, &framePtr);
+	newTypePtr = objPtr->typePtr;
+	Tcl_DecrRefCount(objPtr);
+	
+	if (newTypePtr != typePtr) {
+	    if(numWords%2) {
+		return TCL_ERROR;
+	    }
+	    CompileWord(envPtr, tokenPtr, interp, 1);
+	    otherTokenPtr = TokenAfter(tokenPtr);
+	    i = 4;
+	} else {
+	    if(!(numWords%2)) {
+		return TCL_ERROR;
+	    }
+	    PushLiteral(envPtr, "1", 1);
+	    otherTokenPtr = tokenPtr;
+	    i = 3;
+	}
+    } else {
+	return TCL_ERROR;
+    }
+    
+    /*
+     * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a
+     * local variable, return an error so that the non-compiled command will
+     * be called at runtime.
+     */
+
+    for(; i<=numWords; i+=2, otherTokenPtr = TokenAfter(localTokenPtr)) {
+	localTokenPtr = TokenAfter(otherTokenPtr);
+
+	CompileWord(envPtr, otherTokenPtr, interp, 1);
+	PushVarName(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
+		&localIndex, &simpleVarName, &isScalar,
+		mapPtr->loc[eclIndex].line[1]);
+
+	if((localIndex < 0) || !isScalar) {
+	    return TCL_ERROR;
+	}
+	TclEmitInstInt4(INST_UPVAR, localIndex, envPtr);
+    }
+    
+    /*
+     * Pop the frame index, and set the result to empty
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+    PushLiteral(envPtr, "", 0);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileNamespaceCmd --
+ *
+ *	Procedure called to compile the "namespace" command; currently, only
+ *	the subcommand "namespace upvar" is compiled to bytecodes.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "namespace upvar"
+ *      command at runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileNamespaceCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *tokenPtr, *otherTokenPtr, *localTokenPtr;
+    int simpleVarName, isScalar, localIndex, numWords, i;    
+    DefineLineInformation;	/* TIP #280 */
+    
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+    
+    /*
+     * Only compile [namespace upvar ...]: needs an odd number of args, >=5
+     */
+
+    numWords = parsePtr->numWords;
+    if (!(numWords%2) || (numWords < 5)) {
+	return TCL_ERROR;
+    }
+
+
+    /*
+     * Check if the second argument is "upvar"
+     */
+
+    tokenPtr = TokenAfter(parsePtr->tokenPtr);
+    if ((tokenPtr->size != 5)  /* 5 == strlen("upvar") */
+	    || strncmp(tokenPtr->start, "upvar", 5)) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Push the namespace
+     */
+
+    tokenPtr = TokenAfter(tokenPtr);
+    CompileWord(envPtr, tokenPtr, interp, 1);
+
+    /*
+     * Loop over the (otherVar, thisVar) pairs. If any of the thisVar is not a
+     * local variable, return an error so that the non-compiled command will
+     * be called at runtime.
+     */
+
+    localTokenPtr = tokenPtr;
+    for(i=4; i<=numWords; i+=2) {
+	otherTokenPtr = TokenAfter(localTokenPtr);
+	localTokenPtr = TokenAfter(otherTokenPtr);
+
+	CompileWord(envPtr, otherTokenPtr, interp, 1);
+	PushVarName(interp, localTokenPtr, envPtr, TCL_CREATE_VAR,
+		&localIndex, &simpleVarName, &isScalar,
+		mapPtr->loc[eclIndex].line[1]);
+
+	if((localIndex < 0) || !isScalar) {
+	    return TCL_ERROR;
+	}
+	TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
+    }
+    
+    /*
+     * Pop the namespace, and set the result to empty
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+    PushLiteral(envPtr, "", 0);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileGlobalCmd --
+ *
+ *	Procedure called to compile the "global" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "global" command at 
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileGlobalCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Tcl_Token *varTokenPtr;
+    int localIndex, numWords, i;    
+    DefineLineInformation;	/* TIP #280 */
+    
+    numWords = parsePtr->numWords;
+    if (numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * 'global' has no effect outside of proc bodies; handle that at runtime
+     */
+
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+    
+    /*
+     * Push the namespace
+     */
+
+    PushLiteral(envPtr, "::", 2);
+
+    /*
+     * Loop over the variables.
+     */
+
+    varTokenPtr = TokenAfter(parsePtr->tokenPtr);
+    for(i=2; i<=numWords; varTokenPtr = TokenAfter(varTokenPtr),i++) {
+	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
+
+	if(localIndex < 0) {
+	    return TCL_ERROR;
+	}
+
+	CompileWord(envPtr, varTokenPtr, interp, 1);
+	TclEmitInstInt4(INST_NSUPVAR, localIndex, envPtr);
+    }
+    
+    /*
+     * Pop the namespace, and set the result to empty
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+    PushLiteral(envPtr, "", 0);
+    return TCL_OK;
+}
+
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * TclCompileVariableCmd --
+ *
+ *	Procedure called to compile the "variable" command.
+ *
+ * Results:
+ * 	Returns TCL_OK for a successful compile. Returns TCL_ERROR to defer
+ * 	evaluation to runtime.
+ *
+ * Side effects:
+ *	Instructions are added to envPtr to execute the "variable" command at 
+ *	runtime.
+ *
+ *----------------------------------------------------------------------
+ */
+
+int
+TclCompileVariableCmd(
+    Tcl_Interp *interp,		/* Used for error reporting. */
+    Tcl_Parse *parsePtr,	/* Points to a parse structure for the command
+				 * created by Tcl_ParseCommand. */
+    CompileEnv *envPtr)		/* Holds resulting instructions. */
+{
+    Interp *iPtr = (Interp *) interp;
+    Tcl_Token *varTokenPtr, *valueTokenPtr;
+    int localIndex, numWords, i;    
+    DefineLineInformation;	/* TIP #280 */
+    
+    numWords = parsePtr->numWords;
+    if (numWords < 2) {
+	return TCL_ERROR;
+    }
+
+    /*
+     * Bail out if not compiling a proc body
+     */
+    
+    if (envPtr->procPtr == NULL) {
+	return TCL_ERROR;
+    }
+    
+    /*
+     * Push the namespace: it is the namespace corresponding to the current
+     * compilation. 
+     */
+
+    PushLiteral(envPtr, iPtr->varFramePtr->nsPtr->fullName,-1);
+
+    /*
+     * Loop over the (var, value) pairs. 
+     */
+
+    valueTokenPtr = parsePtr->tokenPtr;
+    for(i=2; i<=numWords; i+=2) {
+	varTokenPtr = TokenAfter(valueTokenPtr);
+	valueTokenPtr = TokenAfter(varTokenPtr);
+
+	localIndex = IndexTailVarIfKnown(interp, varTokenPtr, envPtr);
+
+	if(localIndex < 0) {
+	    return TCL_ERROR;
+	}
+	
+	CompileWord(envPtr, varTokenPtr, interp, 1);
+	TclEmitInstInt4(INST_VARIABLE, localIndex, envPtr);
+	
+	if (i != numWords) {
+	    /*
+	     * A value has been given: set the variable, pop the value
+	     */
+
+	    CompileWord(envPtr, valueTokenPtr, interp, 1);
+	    TclEmitInstInt4(INST_STORE_SCALAR4, localIndex, envPtr);
+	    TclEmitOpcode(INST_POP, envPtr);
+	}
+    }
+    
+    /*
+     * Pop the namespace, and set the result to empty
+     */
+
+    TclEmitOpcode(INST_POP, envPtr);
+    PushLiteral(envPtr, "", 0);
+    return TCL_OK;
+}
+
 
 /*
  * Local Variables:
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index dbd8db2..419e177 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.111 2007/04/01 00:32:26 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.c,v 1.112 2007/04/03 01:34:36 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -372,6 +372,15 @@ InstructionDesc tclInstructionTable[] = {
 	 * Stack:  ... value => ...
 	 * Note that the jump table contains offsets relative to the PC when
 	 * it points to this instruction; the code is relocatable. */
+    {"upvar",            5,     0,        1,   {OPERAND_LVT4}},
+         /* finds level and otherName in stack, links to local variable at
+	  * index op1. Leaves the level on stack. */
+    {"nsupvar",          5,     0,        1,   {OPERAND_LVT4}},
+         /* finds namespace and otherName in stack, links to local variable at 
+	  * index op1. Leaves the namespace on stack. */
+    {"variable",         5,     0,        1,   {OPERAND_LVT4}},
+         /* finds namespace and otherName in stack, links to local variable at 
+	  * index op1. Leaves the namespace on stack. */
     {0}
 };
 
diff --git a/generic/tclCompile.h b/generic/tclCompile.h
index b5ad0ba..f0a3117 100644
--- a/generic/tclCompile.h
+++ b/generic/tclCompile.h
@@ -8,7 +8,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.69 2007/03/02 10:32:12 dkf Exp $
+ * RCS: @(#) $Id: tclCompile.h,v 1.70 2007/04/03 01:34:37 msofer Exp $
  */
 
 #ifndef _TCLCOMPILATION
@@ -614,8 +614,17 @@ typedef struct ByteCode {
 
 #define INST_JUMP_TABLE			121
 
+/*
+ * Instructions to support compilation of global, variable, upvar and
+ * [namespace upvar].
+ */
+
+#define INST_UPVAR                      122
+#define INST_NSUPVAR                    123
+#define INST_VARIABLE                   124
+
 /* The last opcode */
-#define LAST_INST_OPCODE		121
+#define LAST_INST_OPCODE		124
 
 /*
  * Table describing the Tcl bytecode instructions: their name (for displaying
@@ -904,8 +913,6 @@ MODULE_SCOPE int	TclNoIdentOpCmd(ClientData clientData,
 MODULE_SCOPE void	TclVerifyGlobalLiteralTable(Interp *iPtr);
 MODULE_SCOPE void	TclVerifyLocalLiteralTable(CompileEnv *envPtr);
 #endif
-MODULE_SCOPE int	TclCompileVariableCmd(Tcl_Interp *interp,
-			    Tcl_Parse *parsePtr, CompileEnv *envPtr);
 MODULE_SCOPE int	TclWordKnownAtCompileTime(Tcl_Token *tokenPtr,
 			    Tcl_Obj *valuePtr);
 MODULE_SCOPE int	TclWordSimpleExpansion(Tcl_Token *tokenPtr);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 7e4148e..4a31669 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.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: tclExecute.c,v 1.267 2007/04/02 18:48:03 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.268 2007/04/03 01:34:37 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -2650,6 +2650,131 @@ TclExecuteByteCode(
      * ---------------------------------------------------------
      */
 
+    case INST_UPVAR: {
+	int opnd;
+	Var *varPtr, *otherPtr;
+	
+	TRACE_WITH_OBJ(("upvar "), *(tosPtr-1));
+
+	{
+	    CallFrame *framePtr, *savedFramePtr;
+
+	    result = TclObjGetFrame(interp, *(tosPtr-1), &framePtr);
+	    if (result == -1) {
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    } else {
+		result = TCL_OK;
+	    }
+	    
+	    /*
+	     * Locate the other variable
+	     */
+
+	    savedFramePtr = iPtr->varFramePtr;
+	    iPtr->varFramePtr = framePtr;
+	    otherPtr = TclObjLookupVar(interp, *tosPtr, NULL,
+		    (TCL_LEAVE_ERR_MSG), "access",
+		    /*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+	    iPtr->varFramePtr = savedFramePtr;
+	    if (otherPtr == NULL) {
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	}
+	goto doLinkVars;
+
+    case INST_VARIABLE:
+    case INST_NSUPVAR: 
+	TRACE_WITH_OBJ(("nsupvar "), *(tosPtr-1));
+
+	{
+	    Tcl_Namespace *nsPtr, *savedNsPtr;
+	    
+	    result = TclGetNamespaceFromObj(interp, *(tosPtr-1), &nsPtr);
+	    if (result != TCL_OK) {
+		goto checkForCatch;
+	    }
+	    if (nsPtr == NULL) {
+		/*
+		 * The namespace does not exist, leave an error message.
+		 */
+		Tcl_SetObjResult(interp, Tcl_Format(NULL,
+					 "namespace \"%s\" does not exist", 1,
+					 (tosPtr-1)));
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+	    
+	    /*
+	     * Locate the other variable
+	     */
+	    
+	    savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+	    iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
+	    otherPtr = TclObjLookupVar(interp, *tosPtr, NULL,
+		    (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
+		    /*createPart1*/ 1, /*createPart2*/ 1, &varPtr);
+	    iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
+	    if (otherPtr == NULL) {
+		result = TCL_ERROR;
+		goto checkForCatch;
+	    }
+
+	    /*
+	     * Do the [variable] magic if necessary
+	     */
+	    
+	    if ((*pc == INST_VARIABLE) && !TclIsVarNamespaceVar(otherPtr)) {
+		TclSetVarNamespaceVar(otherPtr);
+		otherPtr->refCount++;
+	    }
+	}
+	
+	doLinkVars:
+
+        /*
+	 * If we are here, the local variable has already been created: do the
+	 * little work of TclPtrMakeUpvar that remains to be done right here
+	 * if there are no errors; otherwise, let it handle the case.
+	 */
+
+	opnd = TclGetInt4AtPtr(pc+1);;
+	varPtr =  &(compiledLocals[opnd]);
+	if ((varPtr != otherPtr) && (varPtr->tracePtr == NULL)
+		&& (TclIsVarUndefined(varPtr) || TclIsVarLink(varPtr))) {	    
+	    if (!TclIsVarUndefined(varPtr)) {
+		/* Then it is a defined link */
+		Var *linkPtr = varPtr->value.linkPtr;
+		if (linkPtr == otherPtr) {
+		    goto doLinkVarsDone;
+		}
+		linkPtr->refCount--;
+		if (TclIsVarUndefined(linkPtr)) {
+		    TclCleanupVar(linkPtr, NULL);
+		}
+	    }
+	    TclSetVarLink(varPtr);
+	    TclClearVarUndefined(varPtr);
+	    varPtr->value.linkPtr = otherPtr;
+	    otherPtr->refCount++;
+	} else {
+	    result = TclPtrMakeUpvar(interp, otherPtr, NULL, 0, opnd);
+	    if (result != TCL_OK) {
+		goto checkForCatch;
+	    }
+	}
+
+	/*
+	 * Do not pop the namespace or frame index, it may be needed for other
+	 * variables.
+	 */
+
+	doLinkVarsDone:
+	NEXT_INST_F(5, 1, 0);
+    }
+
+
     case INST_JUMP1: {
 	int opnd;
 
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 564c19e..8450621 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -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: tclInt.h,v 1.302 2007/03/28 19:03:42 dgp Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.303 2007/04/03 01:34:37 msofer Exp $
  */
 
 #ifndef _TCLINT
@@ -2725,6 +2725,8 @@ MODULE_SCOPE int	TclCompileForCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileForeachCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileGlobalCmd(Tcl_Interp *interp, Tcl_Parse *parsePtr,
+			    struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileIfCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileIncrCmd(Tcl_Interp *interp,
@@ -2741,8 +2743,10 @@ MODULE_SCOPE int	TclCompileLlengthCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileLsetCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
-MODULE_SCOPE int	TclCompileNoOp(Tcl_Interp *interp, Tcl_Parse *parsePtr,
-			    struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileNamespaceCmd(Tcl_Interp *interp,
+	                    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileNoOp(Tcl_Interp *interp,
+	                    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileRegexpCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileReturnCmd(Tcl_Interp *interp,
@@ -2753,6 +2757,10 @@ MODULE_SCOPE int	TclCompileStringCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileSwitchCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileUpvarCmd(Tcl_Interp *interp,
+	                    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
+MODULE_SCOPE int	TclCompileVariableCmd(Tcl_Interp *interp,
+	                    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
 MODULE_SCOPE int	TclCompileWhileCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, struct CompileEnv *envPtr);
 
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 17b859c..c723e84 100644
--- a/generic/tclVar.c
+++ b/generic/tclVar.c
@@ -15,7 +15,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclVar.c,v 1.128 2007/03/12 18:06:14 dgp Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.129 2007/04/03 01:34:39 msofer Exp $
  */
 
 #include "tclInt.h"
@@ -3243,7 +3243,7 @@ ObjMakeUpvar(
      */
 
     if (index < 0) {
-	if (((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL)
+	if (((arrayPtr ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL)
 		&& ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
 			|| (varFramePtr == NULL)
 			|| !HasLocalVars(varFramePtr)
@@ -3301,6 +3301,7 @@ TclPtrMakeUpvar(
 	    Tcl_Panic("ObjMakeUpvar called with an index outside from a proc");
 	}
 	varPtr = &(varFramePtr->compiledLocals[index]);
+	myName = varPtr->name;
     } else {
 	/*
 	 * Do not permit the new variable to look like an array reference, as