* 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.

5 files changed, 108 insertions, 103 deletions

diff --git a/ChangeLog b/ChangeLog
index 8fbf778..a1f969f 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -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.