From bd20925e673c0a425280fc0163ce6febaf8c1e31 Mon Sep 17 00:00:00 2001 From: Miguel Sofer Date: Tue, 14 Dec 2004 21:11:42 +0000 Subject: changing the isProcCallFrame field of the CallFrame struct from a 0/1 field to flags. Should be perfectly backwards compatible. --- ChangeLog | 9 +++++++++ generic/tclCmdIL.c | 7 ++++--- generic/tclInt.h | 18 ++++++++++-------- generic/tclProc.c | 4 ++-- generic/tclVar.c | 21 +++++++++++---------- 5 files changed, 36 insertions(+), 23 deletions(-) diff --git a/ChangeLog b/ChangeLog index b855b53..4d790e2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,12 @@ +2004-12-12 Miguel Sofer + + * generic/tclCmdIL.c: + * generic/tclInt.h: + * generic/tclProc.c: + * generic/tclVar.c: changing the isProcCallFrame field of the + CallFrame struct from a 0/1 field to flags. Should be perfectly + backwards compatible. + 2004-12-14 Don Porter * unix/configure.in: Added special processing to remove "$U" diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c index cfff082..746d033 100644 --- a/generic/tclCmdIL.c +++ b/generic/tclCmdIL.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: tclCmdIL.c,v 1.70 2004/12/01 23:18:49 dgp Exp $ + * RCS: @(#) $Id: tclCmdIL.c,v 1.71 2004/12/14 21:11:45 msofer Exp $ */ #include "tclInt.h" @@ -1382,7 +1382,8 @@ InfoLocalsCmd(dummy, interp, objc, objv) return TCL_ERROR; } - if (iPtr->varFramePtr == NULL || !iPtr->varFramePtr->isProcCallFrame) { + if (iPtr->varFramePtr == NULL || + !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC )) { return TCL_OK; } @@ -1959,7 +1960,7 @@ InfoVarsCmd(dummy, interp, objc, objv) listPtr = Tcl_NewListObj(0, (Tcl_Obj **) NULL); if ((iPtr->varFramePtr == NULL) - || !iPtr->varFramePtr->isProcCallFrame + || !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC) || specificNsInPattern) { /* * There is no frame pointer, the frame pointer was pushed only diff --git a/generic/tclInt.h b/generic/tclInt.h index 983cceb..38be9d5 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.206 2004/12/11 14:41:46 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.207 2004/12/14 21:11:46 msofer Exp $ */ #ifndef _TCLINT @@ -775,13 +775,13 @@ typedef struct AssocData { typedef struct CallFrame { Namespace *nsPtr; /* Points to the namespace used to resolve * commands and global variables. */ - int isProcCallFrame; /* If nonzero, the frame was pushed to - * execute a Tcl procedure and may have - * local vars. If 0, the frame was pushed - * to execute a namespace command and var - * references are treated as references to - * namespace vars; varTablePtr and - * compiledLocals are ignored. */ + int isProcCallFrame; /* If 0, the frame was pushed to execute a + * namespace command and var references are + * treated as references to namespace vars; + * varTablePtr and compiledLocals are ignored. + * If FRAME_IS_PROC is set, the frame was + * pushed to execute a Tcl procedure and may + * have local vars. */ int objc; /* This and objv below describe the * arguments for this procedure call. */ Tcl_Obj *CONST *objv; /* Array of argument objects. */ @@ -818,6 +818,8 @@ typedef struct CallFrame { * using an index into this array. */ } CallFrame; +#define FRAME_IS_PROC 0x1 + /* *---------------------------------------------------------------- * Data structures and procedures related to TclHandles, which diff --git a/generic/tclProc.c b/generic/tclProc.c index 5ae99c1..bcf82d2 100644 --- a/generic/tclProc.c +++ b/generic/tclProc.c @@ -10,7 +10,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.67 2004/12/10 13:09:15 msofer Exp $ + * RCS: @(#) $Id: tclProc.c,v 1.68 2004/12/14 21:11:47 msofer Exp $ */ #include "tclInt.h" @@ -976,7 +976,7 @@ TclObjInterpProc(clientData, interp, objc, objv) */ result = Tcl_PushCallFrame(interp, (Tcl_CallFrame *) framePtr, - (Tcl_Namespace *) nsPtr, /*isProcCallFrame*/ 1); + (Tcl_Namespace *) nsPtr, FRAME_IS_PROC); if (result != TCL_OK) { return result; diff --git a/generic/tclVar.c b/generic/tclVar.c index ff0abce..362449a 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.100 2004/12/13 01:50:20 msofer Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.101 2004/12/14 21:11:47 msofer Exp $ */ #include "tclInt.h" @@ -403,7 +403,8 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, if (typePtr == &tclLocalVarNameType) { int localIndex = (int) part1Ptr->internalRep.longValue; - if ((varFramePtr != NULL) && varFramePtr->isProcCallFrame + if ((varFramePtr != NULL) + && (varFramePtr->isProcCallFrame & FRAME_IS_PROC) && !(flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) && (localIndex < varFramePtr->numCompiledLocals)) { /* @@ -428,11 +429,12 @@ TclObjLookupVar(interp, part1Ptr, part2, flags, msg, createPart1, createPart2, && ((flags & TCL_GLOBAL_ONLY) || ((*part1 == ':') && (*(part1+1) == ':')) || (varFramePtr == NULL) - || (!varFramePtr->isProcCallFrame + || (!(varFramePtr->isProcCallFrame & FRAME_IS_PROC) && (nsPtr == iPtr->globalNsPtr))); useReference = useGlobal || ((cachedNsPtr == nsPtr) && ((flags & TCL_NAMESPACE_ONLY) - || (varFramePtr && !varFramePtr->isProcCallFrame + || (varFramePtr + && !(varFramePtr->isProcCallFrame & FRAME_IS_PROC) && !(flags & TCL_GLOBAL_ONLY) /* careful: an undefined ns variable could * be hiding a valid global reference. */ @@ -699,7 +701,6 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) if ((cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) && !(flags & LOOKUP_FOR_UPVAR)) { resPtr = iPtr->resolverPtr; - if (cxtNsPtr->varResProc) { result = (*cxtNsPtr->varResProc)(interp, varName, (Tcl_Namespace *) cxtNsPtr, flags, &var); @@ -742,7 +743,7 @@ TclLookupSimpleVar(interp, varName, flags, create, errMsgPtr, indexPtr) if (((flags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) != 0) || (varFramePtr == NULL) - || !varFramePtr->isProcCallFrame + || !(varFramePtr->isProcCallFrame & FRAME_IS_PROC) || (strstr(varName, "::") != NULL)) { CONST char *tail; int lookGlobal; @@ -3358,7 +3359,7 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, } if (index >= 0) { - if (!varFramePtr->isProcCallFrame) { + if (!(varFramePtr->isProcCallFrame & FRAME_IS_PROC)) { Tcl_Panic("ObjMakeUpvar called with an index outside from a proc.\n"); } varPtr = &(varFramePtr->compiledLocals[index]); @@ -3373,7 +3374,7 @@ ObjMakeUpvar(interp, framePtr, otherP1Ptr, otherP2, otherFlags, myName, myFlags, if (((otherP2 ? arrayPtr->nsPtr : otherPtr->nsPtr) == NULL) && ((myFlags & (TCL_GLOBAL_ONLY | TCL_NAMESPACE_ONLY)) || (varFramePtr == NULL) - || !varFramePtr->isProcCallFrame + || !(varFramePtr->isProcCallFrame & FRAME_IS_PROC) || (strstr(myName, "::") != NULL))) { Tcl_AppendResult((Tcl_Interp *) iPtr, "bad variable name \"", myName, "\": upvar won't create namespace variable that ", @@ -3643,7 +3644,7 @@ Tcl_GlobalObjCmd(dummy, interp, objc, objv) */ if ((iPtr->varFramePtr == NULL) - || !iPtr->varFramePtr->isProcCallFrame) { + || !(iPtr->varFramePtr->isProcCallFrame & FRAME_IS_PROC)) { return TCL_OK; } @@ -3797,7 +3798,7 @@ Tcl_VariableObjCmd(dummy, interp, objc, objv) */ if ((iPtr->varFramePtr != NULL) - && iPtr->varFramePtr->isProcCallFrame) { + && (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. -- cgit v0.12