summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authorMiguel Sofer <miguel.sofer@gmail.com>2007-06-10 20:25:54 (GMT)
committerMiguel Sofer <miguel.sofer@gmail.com>2007-06-10 20:25:54 (GMT)
commitf5d80971097cf57bdbe909fc600276f8670eaf9d (patch)
tree59689956cdc2f9a9567ae1da9764d77ba651689a /generic
parent5921307059d261f04a77cfeb4c0658454884c646 (diff)
downloadtcl-f5d80971097cf57bdbe909fc600276f8670eaf9d.zip
tcl-f5d80971097cf57bdbe909fc600276f8670eaf9d.tar.gz
tcl-f5d80971097cf57bdbe909fc600276f8670eaf9d.tar.bz2
* 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.
Diffstat (limited to 'generic')
-rw-r--r--generic/tclInt.h13
-rw-r--r--generic/tclNamesp.c141
-rw-r--r--generic/tclObj.c41
-rw-r--r--generic/tclVar.c6
4 files changed, 98 insertions, 103 deletions
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.