summaryrefslogtreecommitdiffstats
path: root/generic/tclBasic.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclBasic.c')
-rw-r--r--generic/tclBasic.c90
1 files changed, 64 insertions, 26 deletions
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;