diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2006-10-23 21:36:54 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2006-10-23 21:36:54 (GMT) |
commit | 00a65742087d6d3b1aca1c8153ba4d16b169ee27 (patch) | |
tree | 3333dae28c1795f39b85a6647ffc38ca89c7e9b1 /generic/tclNamesp.c | |
parent | a45dac076ba36370d50f550d483af81d54f88513 (diff) | |
download | tcl-00a65742087d6d3b1aca1c8153ba4d16b169ee27.zip tcl-00a65742087d6d3b1aca1c8153ba4d16b169ee27.tar.gz tcl-00a65742087d6d3b1aca1c8153ba4d16b169ee27.tar.bz2 |
* generic/tcl.h: Modified the Tcl call stack so
* generic/tclBasic.c: there is always a valid CallFrame, even
* generic/tclCmdIL.c: at level 0 [Patch 1577278]. Most of the
* generic/tclInt.h: changes involve removing tests for
* generic/tclNamesp.c: iPtr->(var)framePtr==NULL. There is now a
* generic/tclObj.c: CallFrame pushed at interp creation
* generic/tclProc.c: with a pointer to it stored in
* generic/tclTrace.c: iPtr->rootFramePtr. A second unused
* generic/tclVar.c: field in Interp is hijacked to enable
further functionality, currently unused (but with several FRQs
depending on it).
Diffstat (limited to 'generic/tclNamesp.c')
-rw-r--r-- | generic/tclNamesp.c | 38 |
1 files changed, 18 insertions, 20 deletions
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; } |