Attachment "varCompiler1.patch" to
ticket [1688593fff]
added by
msofer
2007-03-28 22:11:56.
Index: generic/tclBasic.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclBasic.c,v
retrieving revision 1.239
diff -u -r1.239 tclBasic.c
--- generic/tclBasic.c 23 Mar 2007 19:59:34 -0000 1.239
+++ generic/tclBasic.c 28 Mar 2007 15:08:32 -0000
@@ -141,7 +141,7 @@
{"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 @@
{"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 @@
{"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},
/*
Index: generic/tclCompCmds.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompCmds.c,v
retrieving revision 1.103
diff -u -r1.103 tclCompCmds.c
--- generic/tclCompCmds.c 16 Mar 2007 02:05:31 -0000 1.103
+++ generic/tclCompCmds.c 28 Mar 2007 15:08:33 -0000
@@ -4309,74 +4309,6 @@
/*
*----------------------------------------------------------------------
*
- * 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.
@@ -5313,6 +5245,378 @@
}
return TCL_OK;
}
+
+
+/*
+ * Compilers for [namespace upvar], upvar, global and variable
+ */
+
+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;
+}
+
+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;
+}
+
+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;
+}
+
+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;
+}
+
+
+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:
Index: generic/tclCompile.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.c,v
retrieving revision 1.109
diff -u -r1.109 tclCompile.c
--- generic/tclCompile.c 20 Mar 2007 03:16:10 -0000 1.109
+++ generic/tclCompile.c 28 Mar 2007 15:08:34 -0000
@@ -371,6 +371,15 @@
* 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}
};
Index: generic/tclCompile.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclCompile.h,v
retrieving revision 1.69
diff -u -r1.69 tclCompile.h
--- generic/tclCompile.h 2 Mar 2007 10:32:12 -0000 1.69
+++ generic/tclCompile.h 28 Mar 2007 15:08:35 -0000
@@ -614,8 +614,17 @@
#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 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);
Index: generic/tclExecute.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclExecute.c,v
retrieving revision 1.264
diff -u -r1.264 tclExecute.c
--- generic/tclExecute.c 22 Mar 2007 18:19:47 -0000 1.264
+++ generic/tclExecute.c 28 Mar 2007 15:08:36 -0000
@@ -2589,6 +2589,131 @@
* ---------------------------------------------------------
*/
+ 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;
Index: generic/tclInt.h
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclInt.h,v
retrieving revision 1.301
diff -u -r1.301 tclInt.h
--- generic/tclInt.h 24 Feb 2007 18:55:43 -0000 1.301
+++ generic/tclInt.h 28 Mar 2007 15:08:37 -0000
@@ -2724,6 +2724,8 @@
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,
@@ -2740,8 +2742,10 @@
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,
@@ -2752,6 +2756,10 @@
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);
Index: generic/tclVar.c
===================================================================
RCS file: /cvsroot/tcl/tcl/generic/tclVar.c,v
retrieving revision 1.128
diff -u -r1.128 tclVar.c
--- generic/tclVar.c 12 Mar 2007 18:06:14 -0000 1.128
+++ generic/tclVar.c 28 Mar 2007 15:08:38 -0000
@@ -3243,7 +3243,7 @@
*/
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 @@
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
