diff options
| -rw-r--r-- | ChangeLog | 4 | ||||
| -rw-r--r-- | generic/tclCompCmds.c | 13 | ||||
| -rw-r--r-- | generic/tclExecute.c | 75 |
3 files changed, 45 insertions, 47 deletions
@@ -1,5 +1,9 @@ 2007-06-15 Miguel Sofer <msofer@users.sf.net> + * generic/tclCompCmds.c: Simplified [variable] compiler and + * generic/tclExecute.c: executor. Missed updates to "there is + always a valid frame". + * generic/tclCompile.c: reverted TclEvalObjvInternal and * generic/tclExecute.c: INST_INVOKE to essentially what they were * generic/tclBasic.c: previous to the commit of 2007-04-03 diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 8651432..952f4bd 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.109 2007/04/23 19:04:42 kennykb Exp $ + * RCS: @(#) $Id: tclCompCmds.c,v 1.110 2007/06/15 22:58:48 msofer Exp $ */ #include "tclInt.h" @@ -5637,7 +5637,6 @@ TclCompileVariableCmd( * created by Tcl_ParseCommand. */ CompileEnv *envPtr) /* Holds resulting instructions. */ { - Interp *iPtr = (Interp *) interp; Tcl_Token *varTokenPtr, *valueTokenPtr; int localIndex, numWords, i; DefineLineInformation; /* TIP #280 */ @@ -5656,13 +5655,6 @@ TclCompileVariableCmd( } /* - * 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. */ @@ -5692,10 +5684,9 @@ TclCompileVariableCmd( } /* - * Pop the namespace, and set the result to empty + * Set the result to empty */ - TclEmitOpcode(INST_POP, envPtr); PushLiteral(envPtr, "", 0); return TCL_OK; } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 80ec09b..0d6a061 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.294 2007/06/15 19:58:13 msofer Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.295 2007/06/15 22:58:49 msofer Exp $ */ #include "tclInt.h" @@ -1139,8 +1139,7 @@ TclCompEvalObj( if (((Interp *) *codePtr->interpHandle != iPtr) || (codePtr->compileEpoch != iPtr->compileEpoch) #ifdef CHECK_PROC_ORIGINATION /* [Bug: 3412 Pedantic] */ - || (codePtr->procPtr != NULL && !(iPtr->varFramePtr && - iPtr->varFramePtr->procPtr == codePtr->procPtr)) + || codePtr->procPtr != iPtr->varFramePtr->procPtr #endif || (codePtr->nsPtr != namespacePtr) || (codePtr->nsEpoch != namespacePtr->resolverEpoch)) { @@ -1430,13 +1429,8 @@ TclExecuteByteCode( iPtr->stats.numExecutions++; #endif - if (iPtr->varFramePtr != NULL) { - namespacePtr = iPtr->varFramePtr->nsPtr; - compiledLocals = iPtr->varFramePtr->compiledLocals; - } else { - namespacePtr = iPtr->globalNsPtr; - compiledLocals = NULL; - } + namespacePtr = iPtr->varFramePtr->nsPtr; + compiledLocals = iPtr->varFramePtr->compiledLocals; /* * Loop executing instructions until a "done" instruction, a TCL_RETURN, @@ -2900,12 +2894,32 @@ TclExecuteByteCode( } case INST_VARIABLE: + TRACE("variable "); + otherPtr = TclObjLookupVar(interp, OBJ_AT_TOS, NULL, + (TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access", + /*createPart1*/ 1, /*createPart2*/ 1, &varPtr); + if (otherPtr) { + /* + * Do the [variable] magic + */ + + if (!TclIsVarNamespaceVar(otherPtr)) { + TclSetVarNamespaceVar(otherPtr); + otherPtr->refCount++; + } + result = TCL_OK; + goto doLinkVars; + } + result = TCL_ERROR; + goto checkForCatch; + + case INST_NSUPVAR: TRACE_WITH_OBJ(("nsupvar "), OBJ_UNDER_TOS); { Tcl_Namespace *nsPtr, *savedNsPtr; - + result = TclGetNamespaceFromObj(interp, OBJ_UNDER_TOS, &nsPtr); if ((result == TCL_OK) && nsPtr) { /* @@ -2919,32 +2933,21 @@ TclExecuteByteCode( /*createPart1*/ 1, /*createPart2*/ 1, &varPtr); iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr; if (otherPtr) { - /* - * Do the [variable] magic if necessary - */ - - if ((*pc == INST_VARIABLE) - && !TclIsVarNamespaceVar(otherPtr)) { - TclSetVarNamespaceVar(otherPtr); - otherPtr->refCount++; - } - } else { - result = TCL_ERROR; - goto checkForCatch; - } - } else { - if (nsPtr == NULL) { - /* - * The namespace does not exist, leave an error message. - */ - - Tcl_SetObjResult(interp, Tcl_Format(NULL, - "namespace \"%s\" does not exist", 1, - &OBJ_UNDER_TOS)); - result = TCL_ERROR; + result = TCL_OK; + goto doLinkVars; } - goto checkForCatch; } + if (!nsPtr) { + /* + * The namespace does not exist, leave an error message. + */ + + Tcl_SetObjResult(interp, Tcl_Format(NULL, + "namespace \"%s\" does not exist", 1, + &OBJ_UNDER_TOS)); + } + result = TCL_ERROR; + goto checkForCatch; } doLinkVars: @@ -2983,7 +2986,7 @@ TclExecuteByteCode( /* * Do not pop the namespace or frame index, it may be needed for other - * variables. + * variables - and [variable] did not push it at all. */ doLinkVarsDone: |