diff options
| -rw-r--r-- | ChangeLog | 6 | ||||
| -rw-r--r-- | generic/tclNamesp.c | 49 | ||||
| -rw-r--r-- | generic/tclObj.c | 53 |
3 files changed, 66 insertions, 42 deletions
@@ -1,3 +1,9 @@ +2007-07-05 Miguel Sofer <msofer@users.sf.net> + + * generic/tclNamesp.c (SetNsNameFromAny): + * generic/tclObj.c (SetCmdNameFromAny): Avoid unnecessary + ckfree/ckalloc when the old structs can be reused. + 2007-07-04 Miguel Sofer <msofer@users.sf.net> * generic/tclNamesp.c: Fix case where a FQ cmd or ns was being diff --git a/generic/tclNamesp.c b/generic/tclNamesp.c index 8e25637..564be56 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.144 2007/07/04 23:56:58 msofer Exp $ + * RCS: @(#) $Id: tclNamesp.c,v 1.145 2007/07/05 11:49:16 msofer Exp $ */ #include "tclInt.h" @@ -4819,29 +4819,45 @@ SetNsNameFromAny( register ResolvedNsName *resNamePtr; /* - * Get the string representation. Make it up-to-date if necessary. - */ - - name = TclGetString(objPtr); - - /* * Look for the namespace "name" in the current namespace. If there is an * error parsing the (possibly qualified) name, return an error. If the * namespace isn't found, we convert the object to an nsName object with a * NULL ResolvedNsName* internal rep. */ + name = TclGetString(objPtr); TclGetNamespaceForQualName(interp, name, NULL, TCL_FIND_ONLY_NS, &nsPtr, &dummy1Ptr, &dummy2Ptr, &dummy); /* * If we found a namespace, then create a new ResolvedNsName structure * that holds a reference to it. + * + * 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. */ - if (nsPtr != NULL) { + if (nsPtr) { nsPtr->refCount++; - resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName)); + resNamePtr = (ResolvedNsName *) objPtr->internalRep.otherValuePtr; + if ((objPtr->typePtr == &tclNsNameType) + && resNamePtr && (resNamePtr->refCount == 1)) { + /* + * Reuse the old ResolvedNsName struct after freeing it + */ + + Namespace *oldNsPtr = resNamePtr->nsPtr; + if ((--oldNsPtr->refCount == 0) && (oldNsPtr->flags & NS_DEAD)) { + NamespaceFree(oldNsPtr); + } + } else { + TclFreeIntRep(objPtr); + resNamePtr = (ResolvedNsName *) ckalloc(sizeof(ResolvedNsName)); + resNamePtr->refCount = 1; + objPtr->internalRep.otherValuePtr = (void *) resNamePtr; + objPtr->typePtr = &tclNsNameType; + } resNamePtr->nsPtr = nsPtr; resNamePtr->nsId = nsPtr->nsId; if ((*name++ == ':') && (*name == ':')) { @@ -4850,20 +4866,11 @@ SetNsNameFromAny( resNamePtr->refNsPtr = (Namespace *) TclGetCurrentNamespace(interp); } - resNamePtr->refCount = 1; } else { - resNamePtr = NULL; + TclFreeIntRep(objPtr); + objPtr->internalRep.otherValuePtr = (void *) NULL; + objPtr->typePtr = &tclNsNameType; } - - /* - * Free the old internalRep before setting the new one. We do this as late - * as possible to allow the conversion code (in particular, - * Tcl_GetStringFromObj) to use that old internalRep. - */ - - TclFreeIntRep(objPtr); - objPtr->internalRep.otherValuePtr = (void *) resNamePtr; - objPtr->typePtr = &tclNsNameType; return TCL_OK; } diff --git a/generic/tclObj.c b/generic/tclObj.c index 58f1c97..c0f4395 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.128 2007/07/04 23:56:58 msofer Exp $ + * RCS: @(#) $Id: tclObj.c,v 1.129 2007/07/05 11:49:16 msofer Exp $ */ #include "tclInt.h" @@ -3695,7 +3695,6 @@ SetCmdNameFromAny( { Interp *iPtr = (Interp *) interp; char *name; - Tcl_Command cmd; register Command *cmdPtr; Namespace *currNsPtr; register ResolvedCmdName *resPtr; @@ -3709,16 +3708,37 @@ SetCmdNameFromAny( */ name = TclGetString(objPtr); - cmd = Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0); + cmdPtr = (Command *) Tcl_FindCommand(interp, name, /*ns*/ NULL, /*flags*/ 0); - cmdPtr = (Command *) cmd; - if (cmdPtr != NULL) { + /* + * 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. + */ + + if (cmdPtr) { cmdPtr->refCount++; - resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName)); + resPtr = (ResolvedCmdName *) objPtr->internalRep.otherValuePtr; + if ((objPtr->typePtr == &tclCmdNameType) + && resPtr && (resPtr->refCount == 1)) { + /* + * Reuse the old ResolvedCmdName struct after freeing it + */ + + Command *oldCmdPtr = resPtr->cmdPtr; + if (--oldCmdPtr->refCount == 0) { + TclCleanupCommandMacro(oldCmdPtr); + } + } else { + TclFreeIntRep(objPtr); + resPtr = (ResolvedCmdName *) ckalloc(sizeof(ResolvedCmdName)); + resPtr->refCount = 1; + objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + objPtr->typePtr = &tclCmdNameType; + } resPtr->cmdPtr = cmdPtr; resPtr->cmdEpoch = cmdPtr->cmdEpoch; - resPtr->refCount = 1; - if ((*name++ == ':') && (*name == ':')) { /* * The name is fully qualified: set the referring namespace to @@ -3738,20 +3758,11 @@ SetCmdNameFromAny( resPtr->refNsCmdEpoch = currNsPtr->cmdRefEpoch; } } else { - resPtr = NULL; /* no command named "name" was found */ + TclFreeIntRep(objPtr); + objPtr->internalRep.twoPtrValue.ptr1 = NULL; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + objPtr->typePtr = &tclCmdNameType; } - - /* - * Free the old internalRep before setting the new one. We do this as late - * as possible to allow the conversion code, in particular - * GetStringFromObj, to use that old internalRep. If no Command structure - * was found, leave NULL as the cached value. - */ - - TclFreeIntRep(objPtr); - objPtr->internalRep.twoPtrValue.ptr1 = (void *) resPtr; - objPtr->internalRep.twoPtrValue.ptr2 = NULL; - objPtr->typePtr = &tclCmdNameType; return TCL_OK; } |