summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h4
-rw-r--r--generic/tclBasic.c90
-rw-r--r--generic/tclCmdIL.c22
-rw-r--r--generic/tclInt.h15
-rw-r--r--generic/tclNamesp.c38
-rw-r--r--generic/tclObj.c24
-rw-r--r--generic/tclProc.c43
-rw-r--r--generic/tclTrace.c4
-rw-r--r--generic/tclVar.c28
9 files changed, 138 insertions, 130 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index af6784c..2522fa2 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -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: tcl.h,v 1.222 2006/10/23 20:26:11 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.223 2006/10/23 21:36:54 msofer Exp $
*/
#ifndef _TCL
@@ -1062,7 +1062,7 @@ typedef struct Tcl_DString {
* TCL_EVAL_GLOBAL: Execute script in global namespace
* TCL_EVAL_DIRECT: Do not compile this script
* TCL_EVAL_INVOKE: Magical Tcl_EvalObjv mode for aliases/ensembles
- * o Run in global namespace
+ * o Run in iPtr->lookupNsPtr or global namespace
* o Cut out of error traces
* o Don't reset the flags controlling ensemble
* error message rewriting.
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index a7a31a6..5bccd2e 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.200 2006/10/20 15:16:47 dkf Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.201 2006/10/23 21:36:54 msofer Exp $
*/
#include "tclInt.h"
@@ -272,7 +272,9 @@ Tcl_CreateInterp(void)
ByteCodeStats *statsPtr;
#endif /* TCL_COMPILE_STATS */
char mathFuncName[32];
-
+ CallFrame *framePtr;
+ int result;
+
TclInitSubsystems();
/*
@@ -306,8 +308,8 @@ Tcl_CreateInterp(void)
iPtr->numLevels = 0;
iPtr->maxNestingDepth = MAX_NESTING_DEPTH;
- iPtr->framePtr = NULL;
- iPtr->varFramePtr = NULL;
+ iPtr->framePtr = NULL; /* initialise as soon as :: is available */
+ iPtr->varFramePtr = NULL; /* initialise as soon as :: is available */
iPtr->activeVarTracePtr = NULL;
iPtr->returnOpts = NULL;
@@ -320,6 +322,9 @@ Tcl_CreateInterp(void)
iPtr->returnLevel = 1;
iPtr->returnCode = TCL_OK;
+ iPtr->rootFramePtr = NULL; /* initialise as soon as :: is available */
+ iPtr->lookupNsPtr = NULL;
+
iPtr->appendResult = NULL;
iPtr->appendAvl = 0;
iPtr->appendUsed = 0;
@@ -359,6 +364,24 @@ Tcl_CreateInterp(void)
}
/*
+ * Initialise the rootCallframe. It cannot be allocated on the stack, as
+ * it has to be in place before TclCreateExecEnv tries to use a variable.
+ */
+
+ /* This is needed to satisfy GCC 3.3's strict aliasing rules */
+ framePtr = (CallFrame *) ckalloc(sizeof(CallFrame));
+ result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr,
+ (Tcl_Namespace *) iPtr->globalNsPtr, /*isProcCallFrame*/ 0);
+ if (result != TCL_OK) {
+ Tcl_Panic("Tcl_CreateInterp: faile to push the root stack frame");
+ }
+ framePtr->objc = 0;
+
+ iPtr->framePtr = framePtr;
+ iPtr->varFramePtr = framePtr;
+ iPtr->rootFramePtr = framePtr;
+
+ /*
* Initialize support for code compilation and execution. We call
* TclCreateExecEnv after initializing namespaces since it tries to
* reference a Tcl variable (it links to the Tcl "tcl_traceExec"
@@ -1054,6 +1077,12 @@ DeleteInterpProc(
*/
Tcl_DeleteNamespace((Tcl_Namespace *) iPtr->globalNsPtr);
+ if (iPtr->framePtr != iPtr->rootFramePtr) {
+ Tcl_Panic("DeleteInterpProc: popping rootCallFrame with other frames on top");
+ }
+ Tcl_PopCallFrame(interp);
+ ckfree((char *)iPtr->rootFramePtr);
+ iPtr->rootFramePtr = NULL;
/*
* Free up the result *after* deleting variables, since variable deletion
@@ -3240,10 +3269,10 @@ TclEvalObjvInternal(
Interp *iPtr = (Interp *) interp;
Tcl_Obj **newObjv;
int i;
- CallFrame *savedVarFramePtr;/* Saves old copy of iPtr->varFramePtr in case
- * TCL_EVAL_GLOBAL was set. */
+ CallFrame *savedVarFramePtr = NULL;
+ CallFrame *varFramePtr = iPtr->varFramePtr;
int code = TCL_OK;
- int traceCode = TCL_OK;
+ int traceCode = TCL_OK;
int checkTraces = 1;
int cmdEpoch;
Namespace *savedNsPtr = NULL;
@@ -3257,12 +3286,19 @@ TclEvalObjvInternal(
}
/* Configure evaluation context to match the requested flags */
- savedVarFramePtr = iPtr->varFramePtr;
- if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
- } else if ((flags & TCL_EVAL_INVOKE) && iPtr->varFramePtr) {
- savedNsPtr = iPtr->varFramePtr->nsPtr;
- iPtr->varFramePtr->nsPtr = iPtr->globalNsPtr;
+
+ if ((flags & TCL_EVAL_GLOBAL)
+ && (varFramePtr != iPtr->rootFramePtr)) {
+ varFramePtr = iPtr->rootFramePtr;
+ savedVarFramePtr = iPtr->varFramePtr;
+ iPtr->varFramePtr = varFramePtr;
+ } else if (flags & TCL_EVAL_INVOKE) {
+ savedNsPtr = varFramePtr->nsPtr;
+ if (iPtr->lookupNsPtr) {
+ varFramePtr->nsPtr = iPtr->lookupNsPtr;
+ } else {
+ varFramePtr->nsPtr = iPtr->globalNsPtr;
+ }
}
/*
@@ -3286,14 +3322,12 @@ TclEvalObjvInternal(
int newObjc, handlerObjc;
Tcl_Obj **handlerObjv;
- if (iPtr->varFramePtr != NULL) {
- currNsPtr = iPtr->varFramePtr->nsPtr;
- }
+ currNsPtr = varFramePtr->nsPtr;
if ((currNsPtr == NULL) || (currNsPtr->unknownHandlerPtr == NULL)) {
currNsPtr = iPtr->globalNsPtr;
- }
- if (currNsPtr == NULL) {
- Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
+ if (currNsPtr == NULL) {
+ Tcl_Panic("TclEvalObjvInternal: NULL global namespace pointer");
+ }
}
if (currNsPtr->unknownHandlerPtr == NULL) {
/* Global namespace has lost unknown handler, reset. */
@@ -3330,14 +3364,16 @@ TclEvalObjvInternal(
}
ckfree((char *) newObjv);
if (savedNsPtr) {
- iPtr->varFramePtr->nsPtr = savedNsPtr;
+ varFramePtr->nsPtr = savedNsPtr;
+ iPtr->lookupNsPtr = NULL;
}
goto done;
}
if (savedNsPtr) {
- iPtr->varFramePtr->nsPtr = savedNsPtr;
+ varFramePtr->nsPtr = savedNsPtr;
+ iPtr->lookupNsPtr = NULL;
}
-
+
/*
* Call trace functions if needed.
*/
@@ -3427,7 +3463,9 @@ TclEvalObjvInternal(
}
done:
- iPtr->varFramePtr = savedVarFramePtr;
+ if (savedVarFramePtr) {
+ iPtr->varFramePtr = savedVarFramePtr;
+ }
return code;
}
@@ -3674,7 +3712,7 @@ Tcl_EvalEx(
savedVarFramePtr = iPtr->varFramePtr;
if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
+ iPtr->varFramePtr = iPtr->rootFramePtr;
}
/*
@@ -4054,7 +4092,7 @@ Tcl_EvalObjEx(
savedVarFramePtr = iPtr->varFramePtr;
if (flags & TCL_EVAL_GLOBAL) {
- iPtr->varFramePtr = NULL;
+ iPtr->varFramePtr = iPtr->rootFramePtr;
}
result = TclCompEvalObj(interp, objPtr);
@@ -4794,7 +4832,7 @@ Tcl_GlobalEval(
CallFrame *savedVarFramePtr;
savedVarFramePtr = iPtr->varFramePtr;
- iPtr->varFramePtr = NULL;
+ iPtr->varFramePtr = iPtr->rootFramePtr;
result = Tcl_Eval(interp, command);
iPtr->varFramePtr = savedVarFramePtr;
return result;
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index cedfb6b..8bf2dd3 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclCmdIL.c,v 1.89 2006/10/20 15:16:47 dkf Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.90 2006/10/23 21:36:54 msofer Exp $
*/
#include "tclInt.h"
@@ -1278,22 +1278,18 @@ InfoLevelCmd(dummy, interp, objc, objv)
{
Interp *iPtr = (Interp *) interp;
int level;
- CallFrame *framePtr;
+ CallFrame *framePtr, *rootFramePtr = iPtr->rootFramePtr;
Tcl_Obj *listPtr;
if (objc == 2) { /* just "info level" */
- if (iPtr->varFramePtr == NULL) {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(0));
- } else {
- Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
- }
+ Tcl_SetObjResult(interp, Tcl_NewIntObj(iPtr->varFramePtr->level));
return TCL_OK;
} else if (objc == 3) {
if (Tcl_GetIntFromObj(interp, objv[2], &level) != TCL_OK) {
return TCL_ERROR;
}
if (level <= 0) {
- if (iPtr->varFramePtr == NULL) {
+ if (iPtr->varFramePtr == rootFramePtr) {
levelError:
Tcl_AppendResult(interp, "bad level \"",
TclGetString(objv[2]), "\"", (char *) NULL);
@@ -1301,13 +1297,13 @@ InfoLevelCmd(dummy, interp, objc, objv)
}
level += iPtr->varFramePtr->level;
}
- for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+ for (framePtr = iPtr->varFramePtr; framePtr != rootFramePtr;
framePtr = framePtr->callerVarPtr) {
if (framePtr->level == level) {
break;
}
}
- if (framePtr == NULL) {
+ if (framePtr == rootFramePtr) {
goto levelError;
}
@@ -1451,8 +1447,7 @@ InfoLocalsCmd(dummy, interp, objc, objv)
return TCL_ERROR;
}
- if (iPtr->varFramePtr == NULL ||
- !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC )) {
+ if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC )) {
return TCL_OK;
}
@@ -2054,8 +2049,7 @@ InfoVarsCmd(dummy, interp, objc, objv)
listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL);
- if ((iPtr->varFramePtr == NULL)
- || !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
+ if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)
|| specificNsInPattern) {
/*
* There is no frame pointer, the frame pointer was pushed only to
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 57912ff..fffcffe 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.281 2006/10/20 15:16:47 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.282 2006/10/23 21:36:55 msofer Exp $
*/
#ifndef _TCLINT
@@ -1344,19 +1344,18 @@ typedef struct Interp {
* assumes that infinite recursion has
* occurred and it generates an error. */
CallFrame *framePtr; /* Points to top-most in stack of all nested
- * procedure invocations. NULL means there are
- * no active procedures. */
+ * procedure invocations. */
CallFrame *varFramePtr; /* Points to the call frame whose variables
* are currently in use (same as framePtr
- * unless an "uplevel" command is executing).
- * NULL means no procedure is active or
- * "uplevel 0" is executing. */
+ * unless an "uplevel" command is
+ * executing). */
ActiveVarTrace *activeVarTracePtr;
/* First in list of active traces for interp,
* or NULL if no active traces. */
int returnCode; /* [return -code] parameter */
- char *unused3; /* No longer used (was errorInfo) */
- char *unused4; /* No longer used (was errorCode) */
+ CallFrame *rootFramePtr; /* Global frame pointer for this interpreter */
+ Namespace *lookupNsPtr; /* Namespace to use ONLY on the next
+ * TCL_EVAL_INVOKE call to Tcl_EvalObjv */
/*
* Information used by Tcl_AppendResult to keep track of partial results.
diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c
index eae2530..b360211 100644
--- a/generic/tclNamesp.c
+++ b/generic/tclNamesp.c
@@ -22,7 +22,7 @@
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclNamesp.c,v 1.103 2006/10/20 15:16:47 dkf Exp $
+ * RCS: @(#) $Id: tclNamesp.c,v 1.104 2006/10/23 21:36:55 msofer Exp $
*/
#include "tclInt.h"
@@ -333,11 +333,7 @@ Tcl_GetCurrentNamespace(
register Interp *iPtr = (Interp *) interp;
register Namespace *nsPtr;
- if (iPtr->varFramePtr != NULL) {
- nsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- nsPtr = iPtr->globalNsPtr;
- }
+ nsPtr = iPtr->varFramePtr->nsPtr;
return (Tcl_Namespace *) nsPtr;
}
@@ -436,7 +432,7 @@ Tcl_PushCallFrame(
if (iPtr->varFramePtr != NULL) {
framePtr->level = (iPtr->varFramePtr->level + 1);
} else {
- framePtr->level = 1;
+ framePtr->level = 0;
}
framePtr->procPtr = NULL; /* no called procedure */
framePtr->varTablePtr = NULL; /* and no local variables */
@@ -486,8 +482,12 @@ Tcl_PopCallFrame(
* the variable deletion don't see the partially-deleted frame.
*/
- iPtr->framePtr = framePtr->callerPtr;
- iPtr->varFramePtr = framePtr->callerVarPtr;
+ if (framePtr->callerPtr) {
+ iPtr->framePtr = framePtr->callerPtr;
+ iPtr->varFramePtr = framePtr->callerVarPtr;
+ } else {
+ /* Tcl_PopCallFrame: trying to pop rootCallFrame! */
+ }
if (framePtr->varTablePtr != NULL) {
TclDeleteVars(iPtr, framePtr->varTablePtr);
@@ -968,7 +968,8 @@ Tcl_DeleteNamespace(
* refCount reaches 0.
*/
- if (nsPtr->activationCount > 0) {
+ if ((nsPtr->activationCount > 0)
+ && !((nsPtr == globalNsPtr) && (nsPtr->activationCount == 1))) {
nsPtr->flags |= NS_DYING;
if (nsPtr->parentPtr != NULL) {
entryPtr = Tcl_FindHashEntry(&nsPtr->parentPtr->childTable,
@@ -2082,11 +2083,7 @@ TclGetNamespaceForQualName(
if (flags & TCL_GLOBAL_ONLY) {
nsPtr = globalNsPtr;
} else if (nsPtr == NULL) {
- if (iPtr->varFramePtr != NULL) {
- nsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- nsPtr = iPtr->globalNsPtr;
- }
+ nsPtr = iPtr->varFramePtr->nsPtr;
}
start = qualName; /* Pts to start of qualifying namespace. */
@@ -2830,7 +2827,7 @@ TclGetNamespaceFromObj(
savedFramePtr = iPtr->varFramePtr;
name = TclGetString(objPtr);
if ((*name++ == ':') && (*name == ':')) {
- iPtr->varFramePtr = NULL;
+ iPtr->varFramePtr = iPtr->rootFramePtr;
}
currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp);
@@ -4585,11 +4582,11 @@ NamespaceUpvarCmd(
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
- Tcl_Namespace *nsPtr;
+ Interp *iPtr = (Interp *) interp;
+ Tcl_Namespace *nsPtr, *savedNsPtr;
int result;
Var *otherPtr, *arrayPtr;
char *myName;
- CallFrame frame, *framePtr = &frame;
if (objc < 5 || !(objc & 1)) {
Tcl_WrongNumArgs(interp, 2, objv,
@@ -4622,11 +4619,12 @@ NamespaceUpvarCmd(
* Locate the other variable
*/
- Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, nsPtr, 0);
+ savedNsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
+ iPtr->varFramePtr->nsPtr = (Namespace *) nsPtr;
otherPtr = TclObjLookupVar(interp, objv[0], NULL,
(TCL_NAMESPACE_ONLY | TCL_LEAVE_ERR_MSG), "access",
/*createPart1*/ 1, /*createPart2*/ 1, &arrayPtr);
- Tcl_PopCallFrame(interp);
+ iPtr->varFramePtr->nsPtr = (Namespace *) savedNsPtr;
if (otherPtr == NULL) {
return TCL_ERROR;
}
diff --git a/generic/tclObj.c b/generic/tclObj.c
index eb77e35..3b2658d 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.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: tclObj.c,v 1.113 2006/09/30 19:00:13 msofer Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.114 2006/10/23 21:36:55 msofer Exp $
*/
#include "tclInt.h"
@@ -3485,7 +3485,7 @@ Tcl_GetCommandFromObj(
savedFramePtr = iPtr->varFramePtr;
name = Tcl_GetString(objPtr);
if ((*name++ == ':') && (*name == ':')) {
- iPtr->varFramePtr = NULL;
+ iPtr->varFramePtr = iPtr->rootFramePtr;
}
/*
@@ -3507,11 +3507,7 @@ Tcl_GetCommandFromObj(
* Get the current namespace.
*/
- if (iPtr->varFramePtr != NULL) {
- currNsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- currNsPtr = iPtr->globalNsPtr;
- }
+ currNsPtr = iPtr->varFramePtr->nsPtr;
/*
* Check the context namespace and the namespace epoch of the resolved
@@ -3599,18 +3595,14 @@ TclSetCmdNameObj(
savedFramePtr = iPtr->varFramePtr;
name = Tcl_GetString(objPtr);
if ((*name++ == ':') && (*name == ':')) {
- iPtr->varFramePtr = NULL;
+ iPtr->varFramePtr = iPtr->rootFramePtr;
}
/*
* Get the current namespace.
*/
- if (iPtr->varFramePtr != NULL) {
- currNsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- currNsPtr = iPtr->globalNsPtr;
- }
+ currNsPtr = iPtr->varFramePtr->nsPtr;
cmdPtr->refCount++;
resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
@@ -3772,11 +3764,7 @@ SetCmdNameFromAny(
* Get the current namespace.
*/
- if (iPtr->varFramePtr != NULL) {
- currNsPtr = iPtr->varFramePtr->nsPtr;
- } else {
- currNsPtr = iPtr->globalNsPtr;
- }
+ currNsPtr = iPtr->varFramePtr->nsPtr;
cmdPtr->refCount++;
resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName));
diff --git a/generic/tclProc.c b/generic/tclProc.c
index 6429488..e6a70ab 100644
--- a/generic/tclProc.c
+++ b/generic/tclProc.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: tclProc.c,v 1.95 2006/10/20 15:16:47 dkf Exp $
+ * RCS: @(#) $Id: tclProc.c,v 1.96 2006/10/23 21:36:55 msofer Exp $
*/
#include "tclInt.h"
@@ -604,7 +604,7 @@ TclGetFrame(
*/
result = 1;
- curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
+ curLevel = iPtr->varFramePtr->level;
if (*name== '#') {
if (Tcl_GetInt(interp, name+1, &level) != TCL_OK || level < 0) {
goto levelError;
@@ -623,19 +623,16 @@ TclGetFrame(
* Figure out which frame to use, and return it to the caller.
*/
- if (level == 0) {
- framePtr = NULL;
- } else {
- for (framePtr = iPtr->varFramePtr; framePtr != NULL;
- framePtr = framePtr->callerVarPtr) {
- if (framePtr->level == level) {
- break;
- }
- }
- if (framePtr == NULL) {
- goto levelError;
+ for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+ framePtr = framePtr->callerVarPtr) {
+ if (framePtr->level == level) {
+ break;
}
}
+ if (framePtr == NULL) {
+ goto levelError;
+ }
+
*framePtrPtr = framePtr;
return result;
@@ -687,7 +684,7 @@ TclObjGetFrame(
*/
result = 1;
- curLevel = (iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level;
+ curLevel = iPtr->varFramePtr->level;
if (objPtr->typePtr == &levelReferenceType) {
if ((int) objPtr->internalRep.twoPtrValue.ptr1) {
level = curLevel - (int) objPtr->internalRep.twoPtrValue.ptr2;
@@ -753,19 +750,15 @@ TclObjGetFrame(
* Figure out which frame to use, and return it to the caller.
*/
- if (level == 0) {
- framePtr = NULL;
- } else {
- for (framePtr = iPtr->varFramePtr; framePtr != NULL;
- framePtr = framePtr->callerVarPtr) {
- if (framePtr->level == level) {
- break;
- }
- }
- if (framePtr == NULL) {
- goto levelError;
+ for (framePtr = iPtr->varFramePtr; framePtr != NULL;
+ framePtr = framePtr->callerVarPtr) {
+ if (framePtr->level == level) {
+ break;
}
}
+ if (framePtr == NULL) {
+ goto levelError;
+ }
*framePtrPtr = framePtr;
return result;
diff --git a/generic/tclTrace.c b/generic/tclTrace.c
index 65c53f8..3d0244c 100644
--- a/generic/tclTrace.c
+++ b/generic/tclTrace.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: tclTrace.c,v 1.33 2006/04/11 14:37:54 dgp Exp $
+ * RCS: @(#) $Id: tclTrace.c,v 1.34 2006/10/23 21:36:55 msofer Exp $
*/
#include "tclInt.h"
@@ -1417,7 +1417,7 @@ TclCheckExecutionTraces(
return traceCode;
}
- curLevel = ((iPtr->varFramePtr == NULL) ? 0 : iPtr->varFramePtr->level);
+ curLevel = iPtr->varFramePtr->level;
active.nextPtr = iPtr->activeCmdTracePtr;
iPtr->activeCmdTracePtr = &active;
diff --git a/generic/tclVar.c b/generic/tclVar.c
index 5f47e7e..4c22bd2 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.124 2006/10/20 15:16:47 dkf Exp $
+ * RCS: @(#) $Id: tclVar.c,v 1.125 2006/10/23 21:36:55 msofer Exp $
*/
#include "tclInt.h"
@@ -390,7 +390,7 @@ TclObjLookupVar(
}
part1 = Tcl_GetStringFromObj(part1Ptr, &len1);
- nsPtr = ((varFramePtr == NULL)? iPtr->globalNsPtr : varFramePtr->nsPtr);
+ nsPtr = varFramePtr->nsPtr;
if (nsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) {
goto doParse;
}
@@ -398,8 +398,7 @@ TclObjLookupVar(
if (typePtr == &localVarNameType) {
int localIndex = (int) part1Ptr->internalRep.longValue;
- if ((varFramePtr != NULL)
- && (varFramePtr->isProcCallFrame & FRAME_IS_PROC)
+ if ((varFramePtr->isProcCallFrame & FRAME_IS_PROC)
&& !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY))
&& (localIndex < varFramePtr->numCompiledLocals)) {
/*
@@ -422,20 +421,18 @@ TclObjLookupVar(
useGlobal = (cachedNsPtr == iPtr->globalNsPtr) && (
(flags & TCL_GLOBAL_ONLY) ||
(*part1==':' && *(part1+1)==':') ||
- (varFramePtr == NULL) ||
(!(varFramePtr->isProcCallFrame & FRAME_IS_PROC)
&& (nsPtr == iPtr->globalNsPtr)));
useReference = useGlobal || ((cachedNsPtr == nsPtr) && (
(flags & TCL_NAMESPACE_ONLY) ||
- (varFramePtr &&
- !(varFramePtr->isProcCallFrame & FRAME_IS_PROC) &&
- !(flags & TCL_GLOBAL_ONLY) &&
+ (!(varFramePtr->isProcCallFrame & FRAME_IS_PROC) &&
+ !(flags & TCL_GLOBAL_ONLY) &&
/*
* Careful: an undefined ns variable could be hiding a valid
* global reference.
*/
- !TclIsVarUndefined(varPtr))));
+ !TclIsVarUndefined(varPtr))));
if (useReference && (varPtr->hPtr != NULL)) {
/*
@@ -689,7 +686,7 @@ TclLookupSimpleVar(
varNsPtr = NULL; /* set non-NULL if a nonlocal variable */
*indexPtr = -3;
- if ((flags & TCL_GLOBAL_ONLY) || iPtr->varFramePtr == NULL) {
+ if (flags & TCL_GLOBAL_ONLY) {
cxtNsPtr = iPtr->globalNsPtr;
} else {
cxtNsPtr = iPtr->varFramePtr->nsPtr;
@@ -744,7 +741,6 @@ TclLookupSimpleVar(
*/
if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0)
- || (varFramePtr == NULL)
|| !(varFramePtr->isProcCallFrame & FRAME_IS_PROC)
|| (strstr(varName, "::") != NULL)) {
CONST char *tail;
@@ -3214,6 +3210,10 @@ ObjMakeUpvar(
* interpreter in order to use TclObjLookupVar.
*/
+ if (framePtr == NULL) {
+ framePtr = iPtr->rootFramePtr;
+ }
+
varFramePtr = iPtr->varFramePtr;
if (!(otherFlags & TCL_NAMESPACE_ONLY)) {
iPtr->varFramePtr = framePtr;
@@ -3553,8 +3553,7 @@ Tcl_GlobalObjCmd(
* If we are not executing inside a Tcl procedure, just return.
*/
- if ((iPtr->varFramePtr == NULL)
- || !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)) {
+ if (!(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)) {
return TCL_OK;
}
@@ -3705,8 +3704,7 @@ Tcl_VariableObjCmd(
* linked to the new namespace variable "varName".
*/
- if ((iPtr->varFramePtr != NULL)
- && (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)) {
+ if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC) {
/*
* varName might have a scope qualifier, but the name for the
* local "link" variable must be the simple name at the tail.
generated by cgit v0.12 at 2024-11-10 09:20:04 (GMT)