summaryrefslogtreecommitdiffstats
path: root/generic/tclObj.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclObj.c')
-rw-r--r--generic/tclObj.c166
1 files changed, 77 insertions, 89 deletions
diff --git a/generic/tclObj.c b/generic/tclObj.c
index a45a392..d3f59ec 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -402,7 +402,6 @@ TclInitObjSubsystem(void)
Tcl_RegisterObjType(&tclListType);
Tcl_RegisterObjType(&tclDictType);
Tcl_RegisterObjType(&tclByteCodeType);
- Tcl_RegisterObjType(&tclArraySearchType);
Tcl_RegisterObjType(&tclCmdNameType);
Tcl_RegisterObjType(&tclRegexpType);
Tcl_RegisterObjType(&tclProcBodyType);
@@ -663,7 +662,7 @@ TclContinuationsEnterDerived(
* better way which doesn't shimmer?)
*/
- Tcl_GetStringFromObj(objPtr, &length);
+ TclGetStringFromObj(objPtr, &length);
end = start + length; /* First char after the word */
/*
@@ -1989,7 +1988,7 @@ TclSetBooleanFromAny(
badBoolean:
if (interp != NULL) {
int length;
- const char *str = Tcl_GetStringFromObj(objPtr, &length);
+ const char *str = TclGetStringFromObj(objPtr, &length);
Tcl_Obj *msg;
TclNewLiteralStringObj(msg, "expected boolean value but got \"");
@@ -4048,7 +4047,7 @@ TclFreeObjEntry(
*----------------------------------------------------------------------
*/
-unsigned int
+TCL_HASH_TYPE
TclHashObjKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
@@ -4098,7 +4097,7 @@ TclHashObjKey(
result += (result << 3) + UCHAR(*++string);
}
}
- return result;
+ return (TCL_HASH_TYPE) result;
}
/*
@@ -4152,11 +4151,10 @@ Tcl_GetCommandFromObj(
*/
resPtr = objPtr->internalRep.twoPtrValue.ptr1;
- if ((objPtr->typePtr == &tclCmdNameType) && (resPtr != NULL)) {
+ if (objPtr->typePtr == &tclCmdNameType) {
register Command *cmdPtr = resPtr->cmdPtr;
if ((cmdPtr->cmdEpoch == resPtr->cmdEpoch)
- && !(cmdPtr->flags & CMD_IS_DELETED)
&& (interp == cmdPtr->nsPtr->interp)
&& !(cmdPtr->nsPtr->flags & NS_DYING)) {
register Namespace *refNsPtr = (Namespace *)
@@ -4204,54 +4202,78 @@ 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;
+
+ fillPtr->refNsPtr = currNsPtr;
+ fillPtr->refNsId = currNsPtr->nsId;
+ fillPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+ }
- currNsPtr = iPtr->varFramePtr->nsPtr;
+ if (resPtr == NULL) {
+ TclFreeIntRep(objPtr);
- resPtr->refNsPtr = currNsPtr;
- resPtr->refNsId = currNsPtr->nsId;
- resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+ 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. */
+{
+ register ResolvedCmdName *resPtr;
+
+ if (objPtr->typePtr == &tclCmdNameType) {
+ resPtr = objPtr->internalRep.twoPtrValue.ptr1;
+ if (resPtr != NULL && resPtr->cmdPtr == cmdPtr) {
+ return;
+ }
+ }
+
+ SetCmdNameObj(interp, objPtr, cmdPtr, NULL);
}
/*
@@ -4282,7 +4304,6 @@ FreeCmdNameInternalRep(
{
register ResolvedCmdName *resPtr = objPtr->internalRep.twoPtrValue.ptr1;
- if (resPtr != NULL) {
/*
* Decrement the reference count of the ResolvedCmdName structure. If
* there are no more uses, free the ResolvedCmdName structure.
@@ -4300,7 +4321,6 @@ FreeCmdNameInternalRep(
TclCleanupCommandMacro(cmdPtr);
ckfree(resPtr);
}
- }
objPtr->typePtr = NULL;
}
@@ -4333,9 +4353,7 @@ DupCmdNameInternalRep(
copyPtr->internalRep.twoPtrValue.ptr1 = resPtr;
copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
- if (resPtr != NULL) {
resPtr->refCount++;
- }
copyPtr->typePtr = &tclCmdNameType;
}
@@ -4365,10 +4383,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) {
@@ -4388,59 +4404,31 @@ SetCmdNameFromAny(
Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0);
/*
- * 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.
+ * Stop shimmering and caching nothing when we found nothing. Just
+ * report the failure to find the command as an error.
*/
- if (cmdPtr) {
- cmdPtr->refCount++;
- resPtr = objPtr->internalRep.twoPtrValue.ptr1;
- if ((objPtr->typePtr == &tclCmdNameType)
- && resPtr && (resPtr->refCount == 1)) {
- /*
- * Reuse the old ResolvedCmdName struct instead of freeing it
- */
-
- 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;
- }
- resPtr->cmdPtr = cmdPtr;
- resPtr->cmdEpoch = cmdPtr->cmdEpoch;
- if ((*name++ == ':') && (*name == ':')) {
- /*
- * The name is fully qualified: set the referring namespace to
- * NULL.
- */
+ if (cmdPtr == NULL) {
+ return TCL_ERROR;
+ }
- resPtr->refNsPtr = NULL;
- } else {
- /*
- * Get the current namespace.
- */
+ 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.
+ */
- currNsPtr = iPtr->varFramePtr->nsPtr;
+ Command *oldCmdPtr = resPtr->cmdPtr;
- resPtr->refNsPtr = currNsPtr;
- resPtr->refNsId = currNsPtr->nsId;
- resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch;
+ if (--oldCmdPtr->refCount == 0) {
+ TclCleanupCommandMacro(oldCmdPtr);
}
} else {
- TclFreeIntRep(objPtr);
- objPtr->internalRep.twoPtrValue.ptr1 = NULL;
- objPtr->internalRep.twoPtrValue.ptr2 = NULL;
- objPtr->typePtr = &tclCmdNameType;
+ resPtr = NULL;
}
+
+ SetCmdNameObj(interp, objPtr, cmdPtr, resPtr);
return TCL_OK;
}
generated by cgit v0.12 at 2024-08-19 19:01:08 (GMT)