summaryrefslogtreecommitdiffstats
path: root/generic/tclObj.c
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2016-07-15 14:19:07 (GMT)
committerdgp <dgp@users.sourceforge.net>2016-07-15 14:19:07 (GMT)
commited70e9d86101ea6352b6623c9ca09ef68749abd9 (patch)
tree8fe9d6090341895119c0934c1a7d137185d67721 /generic/tclObj.c
parent059c3bec3a774772ceff7fc2fcc5c7bf690ab8cf (diff)
downloadtcl-ed70e9d86101ea6352b6623c9ca09ef68749abd9.zip
tcl-ed70e9d86101ea6352b6623c9ca09ef68749abd9.tar.gz
tcl-ed70e9d86101ea6352b6623c9ca09ef68749abd9.tar.bz2
Factor the cmdName intrep setting code into common utility routine.
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r--generic/tclObj.c138
1 files changed, 63 insertions, 75 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c
index e335ac3..b145d7e 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -4203,54 +4203,73 @@ Tcl_GetCommandFromObj(
*----------------------------------------------------------------------
*/
-void
-TclSetCmdNameObj(
- Tcl_Interp *interp, /* Points to interpreter containing command
- * that should be cached in objPtr. */
- register Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a
- * CmdName object. */
- Command *cmdPtr) /* Points to Command structure that the
- * CmdName object should refer to. */
+static void
+SetCmdNameObj(
+ Tcl_Interp *interp,
+ Tcl_Obj *objPtr,
+ Command *cmdPtr,
+ ResolvedCmdName *resPtr)
{
Interp *iPtr = (Interp *) interp;
- register ResolvedCmdName *resPtr;
- register Namespace *currNsPtr;
- const char *name;
+ ResolvedCmdName *fillPtr;
+ const char *name = TclGetString(objPtr);
- if (objPtr->typePtr == &tclCmdNameType) {
- return;
+ if (resPtr) {
+ fillPtr = resPtr;
+ } else {
+ fillPtr = ckalloc(sizeof(ResolvedCmdName));
+ fillPtr->refCount = 1;
}
+ fillPtr->cmdPtr = cmdPtr;
cmdPtr->refCount++;
- resPtr = ckalloc(sizeof(ResolvedCmdName));
- resPtr->cmdPtr = cmdPtr;
- resPtr->cmdEpoch = cmdPtr->cmdEpoch;
- resPtr->refCount = 1;
+ fillPtr->cmdEpoch = cmdPtr->cmdEpoch;
- name = TclGetString(objPtr);
- if ((*name++ == ':') && (*name == ':')) {
+ /* NOTE: relying on NULL termination here. */
+ if ((name[0] == ':') && (name[1] == ':')) {
/*
- * The name is fully qualified: set the referring namespace to
- * NULL.
+ * Fully qualified names always resolve to same thing. No need
+ * to record resolution context information.
*/
- resPtr->refNsPtr = NULL;
+ fillPtr->refNsPtr = NULL;
+ fillPtr->refNsId = 0; /* Will not be read */
+ fillPtr->refNsCmdEpoch = 0; /* Will not be read */
} else {
/*
- * Get the current namespace.
+ * Record current state of current namespace as the resolution
+ * context of this command name lookup.
*/
+ Namespace *currNsPtr = iPtr->varFramePtr->nsPtr;
- currNsPtr = iPtr->varFramePtr->nsPtr;
+ fillPtr->refNsPtr = currNsPtr;
+ fillPtr->refNsId = currNsPtr->nsId;
+ fillPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+ }
- resPtr->refNsPtr = currNsPtr;
- resPtr->refNsId = currNsPtr->nsId;
- resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+ if (resPtr == NULL) {
+ TclFreeIntRep(objPtr);
+
+ objPtr->internalRep.twoPtrValue.ptr1 = fillPtr;
+ objPtr->internalRep.twoPtrValue.ptr2 = NULL;
+ objPtr->typePtr = &tclCmdNameType;
}
+}
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclCmdNameType;
+void
+TclSetCmdNameObj(
+ Tcl_Interp *interp, /* Points to interpreter containing command
+ * that should be cached in objPtr. */
+ register Tcl_Obj *objPtr, /* Points to Tcl object to be changed to a
+ * CmdName object. */
+ Command *cmdPtr) /* Points to Command structure that the
+ * CmdName object should refer to. */
+{
+ if (objPtr->typePtr == &tclCmdNameType) {
+ return;
+ }
+
+ SetCmdNameObj(interp, objPtr, cmdPtr, NULL);
}
/*
@@ -4360,10 +4379,8 @@ SetCmdNameFromAny(
Tcl_Interp *interp, /* Used for error reporting if not NULL. */
register Tcl_Obj *objPtr) /* The object to convert. */
{
- Interp *iPtr = (Interp *) interp;
const char *name;
register Command *cmdPtr;
- Namespace *currNsPtr;
register ResolvedCmdName *resPtr;
if (interp == NULL) {
@@ -4391,52 +4408,23 @@ SetCmdNameFromAny(
return TCL_ERROR;
}
- /*
- * Free the old internalRep before setting the new one. Do this after
- * getting the string rep to allow the conversion code (in particular,
- * Tcl_GetStringFromObj) to use that old internalRep.
- */
-
- cmdPtr->refCount++;
- resPtr = objPtr->internalRep.twoPtrValue.ptr1;
- if ((objPtr->typePtr == &tclCmdNameType) && (resPtr->refCount == 1)) {
- /*
- * Reuse the old ResolvedCmdName struct instead of freeing it
- */
+ resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if ((objPtr->typePtr == &tclCmdNameType) && (resPtr->refCount == 1)) {
+ /*
+ * Re-use existing ResolvedCmdName struct when possible.
+ * Cleanup the old fields that need it.
+ */
- Command *oldCmdPtr = resPtr->cmdPtr;
+ Command *oldCmdPtr = resPtr->cmdPtr;
- if (--oldCmdPtr->refCount == 0) {
- TclCleanupCommandMacro(oldCmdPtr);
- }
- } else {
- TclFreeIntRep(objPtr);
- resPtr = ckalloc(sizeof(ResolvedCmdName));
- resPtr->refCount = 1;
- objPtr->internalRep.twoPtrValue.ptr1 = resPtr;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclCmdNameType;
+ if (--oldCmdPtr->refCount == 0) {
+ TclCleanupCommandMacro(oldCmdPtr);
}
- resPtr->cmdPtr = cmdPtr;
- resPtr->cmdEpoch = cmdPtr->cmdEpoch;
- if ((*name++ == ':') && (*name == ':')) {
- /*
- * The name is fully qualified: set the referring namespace to
- * NULL.
- */
-
- resPtr->refNsPtr = NULL;
- } else {
- /*
- * Get the current namespace.
- */
-
- currNsPtr = iPtr->varFramePtr->nsPtr;
+ } else {
+ resPtr = NULL;
+ }
- resPtr->refNsPtr = currNsPtr;
- resPtr->refNsId = currNsPtr->nsId;
- resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
- }
+ SetCmdNameObj(interp, objPtr, cmdPtr, resPtr);
return TCL_OK;
}