diff options
| -rw-r--r-- | ChangeLog | 10 | ||||
| -rw-r--r-- | generic/tclInt.h | 13 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 141 | ||||
| -rw-r--r-- | generic/tclObj.c | 41 | ||||
| -rw-r--r-- | generic/tclVar.c | 6 |
5 files changed, 108 insertions, 103 deletions
@@ -1,3 +1,13 @@ +2007-06-10 Miguel Sofer <msofer@users.sf.net> + + * generic/tclInt.h: + * generic/tclNamesp.c: + * generic/tclObj.c: + * generic/tclvar.c: new macros TclGetCurrentNamespace() and + TclGetGlobalNamespace(); Tcl_GetCommandFromObj and + TclGetNamespaceFromObj rewritten to make the logic clearer; + slightly faster too. + 2007-06-09 Miguel Sofer <msofer@users.sf.net> * generic/tclExecute.c (INST_INVOKE): isolated two vars to the diff --git a/generic/tclInt.h b/generic/tclInt.h index dc0efa7..f3c7c5e 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.315 2007/06/10 00:08:30 msofer Exp $ + * RCS: @(#) $Id: tclInt.h,v 1.316 2007/06/10 20:25:55 msofer Exp $ */ #ifndef _TCLINT @@ -3405,6 +3405,17 @@ MODULE_SCOPE void TclBNInitBignumFromWideUInt(mp_int *bignum, /* *---------------------------------------------------------------- + * Inline version of Tcl_GetCurrentNamespace and Tcl_GetGlobalNamespace + */ + +#define TclGetCurrentNamespace(interp) \ + (Tcl_Namespace *) ((Interp *)(interp))->varFramePtr->nsPtr + +#define TclGetGlobalNamespace(interp) \ + (Tcl_Namespace *) ((Interp *)(interp))->globalNsPtr + +/* + *---------------------------------------------------------------- * Inline version of TclCleanupCommand; still need the function as it is in * the internal stubs, but the core can use the macro instead. */ diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 2d5d30b..df1f818 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.135 2007/06/05 17:57:07 dgp Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.136 2007/06/10 20:25:56 msofer Exp $ */ #include "tclInt.h" @@ -328,11 +328,7 @@ Tcl_GetCurrentNamespace( register Tcl_Interp *interp)/* Interpreter whose current namespace is * being queried. */ { - register Interp *iPtr = (Interp *) interp; - register Namespace *nsPtr; - - nsPtr = iPtr->varFramePtr->nsPtr; - return (Tcl_Namespace *) nsPtr; + return TclGetCurrentNamespace(interp); } /* @@ -356,9 +352,7 @@ Tcl_GetGlobalNamespace( register Tcl_Interp *interp)/* Interpreter whose global namespace should * be returned. */ { - register Interp *iPtr = (Interp *) interp; - - return (Tcl_Namespace *) iPtr->globalNsPtr; + return TclGetGlobalNamespace(interp); } /* @@ -411,7 +405,7 @@ Tcl_PushCallFrame( register Namespace *nsPtr; if (namespacePtr == NULL) { - nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; if (nsPtr->flags & NS_DEAD) { @@ -933,7 +927,7 @@ Tcl_DeleteNamespace( register Namespace *nsPtr = (Namespace *) namespacePtr; Interp *iPtr = (Interp *) nsPtr->interp; Namespace *globalNsPtr = - (Namespace *) Tcl_GetGlobalNamespace((Tcl_Interp *) iPtr); + (Namespace *) TclGetGlobalNamespace((Tcl_Interp *) iPtr); Tcl_HashEntry *entryPtr; /* @@ -1259,7 +1253,7 @@ Tcl_Export( { #define INIT_EXPORT_PATTERNS 5 Namespace *nsPtr, *exportNsPtr, *dummyPtr; - Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); const char *simplePattern; char *patternCpy; int neededElems, len, i; @@ -1397,7 +1391,7 @@ Tcl_AppendExportList( */ if (namespacePtr == NULL) { - nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; } @@ -1467,7 +1461,7 @@ Tcl_Import( */ if (namespacePtr == NULL) { - nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; } @@ -1739,7 +1733,7 @@ Tcl_ForgetImport( */ if (namespacePtr == NULL) { - nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else { nsPtr = (Namespace *) namespacePtr; } @@ -2390,11 +2384,11 @@ Tcl_FindCommand( */ if (flags & TCL_GLOBAL_ONLY) { - cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); + cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp); } else if (contextNsPtr != NULL) { cxtNsPtr = (Namespace *) contextNsPtr; } else { - cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp); } if (cxtNsPtr->cmdResProc != NULL || iPtr->resolverPtr != NULL) { @@ -2578,11 +2572,11 @@ Tcl_FindNamespaceVar( */ if ((flags & TCL_GLOBAL_ONLY) != 0) { - cxtNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); + cxtNsPtr = (Namespace *) TclGetGlobalNamespace(interp); } else if (contextNsPtr != NULL) { cxtNsPtr = (Namespace *) contextNsPtr; } else { - cxtNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + cxtNsPtr = (Namespace *) TclGetCurrentNamespace(interp); } if (cxtNsPtr->varResProc != NULL || iPtr->resolverPtr != NULL) { @@ -2682,7 +2676,7 @@ TclResetShadowedCmdRefs( Tcl_HashEntry *hPtr; register Namespace *nsPtr; Namespace *trailNsPtr, *shadowNsPtr; - Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); + Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); int found, i; /* @@ -2831,75 +2825,66 @@ TclGetNamespaceFromObj( Tcl_Namespace **nsPtrPtr) /* Result namespace pointer goes here. */ { Interp *iPtr = (Interp *) interp; - register ResolvedNsName *resNamePtr; - register Namespace *nsPtr; - Namespace *currNsPtr; - CallFrame *savedFramePtr; + ResolvedNsName *resPtr; + Namespace *nsPtr, *refNsPtr; int result = TCL_OK; char *name; - + int isFQ; + /* * If the namespace name is fully qualified, do as if the lookup were done * from the global namespace; this helps avoid repeated lookups of fully * qualified names. */ - savedFramePtr = iPtr->varFramePtr; name = TclGetString(objPtr); - if ((*name++ == ':') && (*name == ':')) { - iPtr->varFramePtr = iPtr->rootFramePtr; - } - - currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + isFQ = ((*name == ':') && (*(name+1) == ':')); + refNsPtr = (Namespace *) (isFQ + ? TclGetGlobalNamespace(interp) + : TclGetCurrentNamespace(interp)); /* * Get the internal representation, converting to a namespace type if * needed. The internal representation is a ResolvedNsName that points to * the actual namespace. - */ - - if (objPtr->typePtr != &tclNsNameType) { - result = tclNsNameType.setFromAnyProc(interp, objPtr); - if (result != TCL_OK) { - goto done; - } - } - resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr; - - /* + * * Check the context namespace of the resolved symbol to make sure that it - * is fresh. If not, then force another conversion to the namespace type, - * to discard the old rep and create a new one. Note that we verify that - * the namespace id of the cached namespace is the same as the id when we - * cached it; this insures that the namespace wasn't deleted and a new one - * created at the same address. + * is fresh. Note that we verify that the namespace id of the context + * namespace is the same as the one we cached; this insures that the + * namespace wasn't deleted and a new one created at the same address. + * + * If any check fails, then force another conversion to the command type, + * to discard the old rep and create a new one. */ - nsPtr = NULL; - if ((resNamePtr != NULL) && (resNamePtr->refNsPtr == currNsPtr) - && (resNamePtr->nsId == resNamePtr->nsPtr->nsId)) { - nsPtr = resNamePtr->nsPtr; - if (nsPtr->flags & NS_DEAD) { - nsPtr = NULL; + resPtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr; + if ((objPtr->typePtr != &tclNsNameType) + || (resPtr == NULL) + || (resPtr->refNsPtr != refNsPtr) + || (nsPtr = resPtr->nsPtr, nsPtr->flags & NS_DEAD) + || (resPtr->nsId != nsPtr->nsId)) { + + if (isFQ) { + refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); + iPtr->varFramePtr->nsPtr = (Namespace *) TclGetGlobalNamespace(interp); } - } - if (nsPtr == NULL) { /* Try again. */ result = tclNsNameType.setFromAnyProc(interp, objPtr); - if (result != TCL_OK) { - goto done; + if (isFQ) { + iPtr->varFramePtr->nsPtr = refNsPtr; } - resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr; - if (resNamePtr != NULL) { - nsPtr = resNamePtr->nsPtr; - if (nsPtr->flags & NS_DEAD) { + + resPtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr; + if ((result == TCL_OK) && resPtr) { + nsPtr = resPtr->nsPtr; + if (nsPtr && (nsPtr->flags & NS_DEAD)) { nsPtr = NULL; } + } else { + nsPtr = NULL; } } - *nsPtrPtr = (Tcl_Namespace *) nsPtr; - done: - iPtr->varFramePtr = savedFramePtr; + *nsPtrPtr = (Tcl_Namespace *) nsPtr; return result; } @@ -3071,7 +3056,7 @@ NamespaceChildrenCmd( { Tcl_Namespace *namespacePtr; Namespace *nsPtr, *childNsPtr; - Namespace *globalNsPtr = (Namespace *) Tcl_GetGlobalNamespace(interp); + Namespace *globalNsPtr = (Namespace *) TclGetGlobalNamespace(interp); char *pattern = NULL; Tcl_DString buffer; register Tcl_HashEntry *entryPtr; @@ -3083,7 +3068,7 @@ NamespaceChildrenCmd( */ if (objc == 2) { - nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } else if ((objc == 3) || (objc == 4)) { if (TclGetNamespaceFromObj(interp, objv[2], &namespacePtr) != TCL_OK) { return TCL_ERROR; @@ -3233,8 +3218,8 @@ NamespaceCodeCmd( Tcl_ListObjAppendElement(interp, listPtr, Tcl_NewStringObj("inscope", -1)); - currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); - if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) { + currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); + if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { TclNewLiteralStringObj(objPtr, "::"); } else { objPtr = Tcl_NewStringObj(currNsPtr->fullName, -1); @@ -3291,8 +3276,8 @@ NamespaceCurrentCmd( * namespace [namespace current]::bar { ... } */ - currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); - if (currNsPtr == (Namespace *) Tcl_GetGlobalNamespace(interp)) { + currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); + if (currNsPtr == (Namespace *) TclGetGlobalNamespace(interp)) { Tcl_SetObjResult(interp, Tcl_NewStringObj("::", 2)); } else { Tcl_SetObjResult(interp, Tcl_NewStringObj(currNsPtr->fullName, -1)); @@ -3595,7 +3580,7 @@ NamespaceExportCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); char *pattern, *string; int resetListFirst = 0; int firstArg, patternCt, i, result; @@ -3789,7 +3774,7 @@ NamespaceImportCmd( Tcl_HashEntry *hPtr; Tcl_HashSearch search; - Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp); Tcl_Obj *listPtr; TclNewObj(listPtr); @@ -4049,7 +4034,7 @@ NamespaceParentCmd( int result; if (objc == 2) { - nsPtr = Tcl_GetCurrentNamespace(interp); + nsPtr = TclGetCurrentNamespace(interp); } else if (objc == 3) { result = TclGetNamespaceFromObj(interp, objv[2], &nsPtr); if (result != TCL_OK) { @@ -4111,7 +4096,7 @@ NamespacePathCmd( int objc, /* Number of arguments. */ Tcl_Obj *const objv[]) /* Argument objects. */ { - Namespace *nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + Namespace *nsPtr = (Namespace *) TclGetCurrentNamespace(interp); int i, nsObjc, result = TCL_ERROR; Tcl_Obj **nsObjv; Tcl_Namespace **namespaceList = NULL; @@ -4419,7 +4404,7 @@ NamespaceUnknownCmd( return TCL_ERROR; } - currNsPtr = Tcl_GetCurrentNamespace(interp); + currNsPtr = TclGetCurrentNamespace(interp); if (objc == 2) { /* @@ -4925,7 +4910,7 @@ SetNsNameFromAny( if (nsPtr != NULL) { Namespace *currNsPtr = (Namespace *) - Tcl_GetCurrentNamespace(interp); + TclGetCurrentNamespace(interp); nsPtr->refCount++; resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName)); @@ -5053,7 +5038,7 @@ NamespaceEnsembleCmd( }; int index; - nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + nsPtr = (Namespace *) TclGetCurrentNamespace(interp); if (nsPtr == NULL || nsPtr->flags & NS_DEAD) { if (!Tcl_InterpDeleted(interp)) { Tcl_AppendResult(interp, @@ -5546,7 +5531,7 @@ Tcl_CreateEnsemble( Tcl_Obj *nameObj = NULL; if (nsPtr == NULL) { - nsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + nsPtr = (Namespace *) TclGetCurrentNamespace(interp); } /* diff --git a/generic/tclObj.c b/generic/tclObj.c index 1c6384a..53dff2f 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.124 2007/06/09 21:07:31 msofer Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.125 2007/06/10 20:25:56 msofer Exp $ */ #include "tclInt.h" @@ -3463,10 +3463,10 @@ Tcl_GetCommandFromObj( Interp *iPtr = (Interp *) interp; register ResolvedCmdName *resPtr; register Command *cmdPtr; - Namespace *currNsPtr; + Namespace *refNsPtr; int result; - CallFrame *savedFramePtr = NULL; char *name; + int isFQ; /* * If the variable name is fully qualified, do as if the lookup were done @@ -3476,17 +3476,11 @@ Tcl_GetCommandFromObj( * 456668] */ - name = Tcl_GetString(objPtr); - if ((*name++ == ':') && (*name == ':')) { - savedFramePtr = iPtr->varFramePtr; - iPtr->varFramePtr = iPtr->rootFramePtr; - } - - /* - * Get the current namespace. - */ - - currNsPtr = iPtr->varFramePtr->nsPtr; + name = TclGetString(objPtr); + isFQ = ((*name++ == ':') && (*name == ':')); + refNsPtr = (Namespace *) (isFQ + ? TclGetGlobalNamespace(interp) + : TclGetCurrentNamespace(interp)); /* * Get the internal representation, converting to a command type if @@ -3509,13 +3503,21 @@ Tcl_GetCommandFromObj( resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1; if ((objPtr->typePtr != &tclCmdNameType) || (resPtr == NULL) - || (resPtr->refNsPtr != currNsPtr) - || (resPtr->refNsId != currNsPtr->nsId) - || (resPtr->refNsCmdEpoch != currNsPtr->cmdRefEpoch) + || (resPtr->refNsPtr != refNsPtr) + || (resPtr->refNsId != refNsPtr->nsId) + || (resPtr->refNsCmdEpoch != refNsPtr->cmdRefEpoch) || (cmdPtr = resPtr->cmdPtr, cmdPtr->cmdEpoch != resPtr->cmdEpoch) || (cmdPtr->flags & CMD_IS_DELETED)) { - + + if (isFQ) { + refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); + iPtr->varFramePtr->nsPtr = (Namespace *) TclGetGlobalNamespace(interp); + } result = tclCmdNameType.setFromAnyProc(interp, objPtr); + if (isFQ) { + iPtr->varFramePtr->nsPtr = refNsPtr; + } + resPtr = (ResolvedCmdName *) objPtr->internalRep.twoPtrValue.ptr1; if ((result == TCL_OK) && resPtr) { cmdPtr = resPtr->cmdPtr; @@ -3524,9 +3526,6 @@ Tcl_GetCommandFromObj( } } - if (savedFramePtr) { - iPtr->varFramePtr = savedFramePtr; - } return (Tcl_Command) cmdPtr; } diff --git a/generic/tclVar.c b/generic/tclVar.c index 53e7739..05f7215 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.135 2007/05/11 09:44:59 dkf Exp $ + * RCS: @(#) $Id: tclVar.c,v 1.136 2007/06/10 20:25:56 msofer Exp $ */ #include "tclInt.h" @@ -4063,7 +4063,7 @@ TclDeleteNamespaceVars( if (nsPtr == iPtr->globalNsPtr) { flags = TCL_GLOBAL_ONLY; - } else if (nsPtr == (Namespace *) Tcl_GetCurrentNamespace(interp)) { + } else if (nsPtr == (Namespace *) TclGetCurrentNamespace(interp)) { flags = TCL_NAMESPACE_ONLY; } @@ -4131,7 +4131,7 @@ TclDeleteVars( int flags; ActiveVarTrace *activePtr; Tcl_Obj *objPtr; - Namespace *currNsPtr = (Namespace *) Tcl_GetCurrentNamespace(interp); + Namespace *currNsPtr = (Namespace *) TclGetCurrentNamespace(interp); /* * Determine what flags to pass to the trace callback functions. |