From 195d0288be26f564bc3fc8df6f5036763520a7b4 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Fri, 22 Jul 2016 19:27:38 +0000 Subject: Avoid generating string for list dict list round trip. --- generic/tclDictObj.c | 83 ++++++++++++++++++++++++++++++++++++---------------- generic/tclInt.h | 3 ++ generic/tclListObj.c | 59 +++++++++++++++++++++---------------- unix/Makefile.in | 1 + 4 files changed, 95 insertions(+), 51 deletions(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index 428173d..ad52ba3 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -62,6 +62,8 @@ static int DictWithCmd(ClientData dummy, Tcl_Interp *interp, static void DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static void FreeDictInternalRep(Tcl_Obj *dictPtr); static void InvalidateDictChain(Tcl_Obj *dictObj); +static void InvalidateListRep(Tcl_Obj *dictObj); +static void InvalidateOtherReps(Tcl_Obj *dictObj); static int SetDictFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfDict(Tcl_Obj *dictPtr); static Tcl_HashEntry * AllocChainEntry(Tcl_HashTable *tablePtr,void *keyPtr); @@ -426,6 +428,7 @@ FreeDictInternalRep( Tcl_Obj *dictPtr) { Dict *dict = DICT(dictPtr); + InvalidateListRep(dictPtr); dict->refcount--; if (dict->refcount <= 0) { @@ -497,13 +500,28 @@ UpdateStringOfDict( const char *elem; char *dst; const int maxFlags = UINT_MAX / sizeof(int); + void *tmp; + int numElems; + + if (dictPtr->internalRep.twoPtrValue.ptr2 != NULL) { + tmp = dictPtr->internalRep.twoPtrValue.ptr1; + dictPtr->internalRep.twoPtrValue.ptr1 = dictPtr->internalRep.twoPtrValue.ptr2; + dictPtr->typePtr = &tclListType ; + if (TclGetString(dictPtr) == NULL) { + Tcl_Panic("Could not update dict string from internal list"); + } + dictPtr->internalRep.twoPtrValue.ptr2 = dictPtr->internalRep.twoPtrValue.ptr1; + dictPtr->internalRep.twoPtrValue.ptr1 = tmp; + dictPtr->typePtr = &tclDictType; + return; + } /* * This field is the most useful one in the whole hash structure, and it * is not exposed by any API function... */ - int numElems = dict->table.numEntries * 2; + numElems = dict->table.numEntries * 2; /* Handle empty list case first, simplifies what follows */ if (numElems == 0) { @@ -603,7 +621,7 @@ SetDictFromAny( Tcl_Obj *objPtr) { Tcl_HashEntry *hPtr; - int isNew; + int isNew, needlist = 0; Dict *dict = ckalloc(sizeof(Dict)); InitChainTable(dict); @@ -629,17 +647,8 @@ SetDictFromAny( /* Store key and value in the hash table we're building. */ hPtr = CreateChainEntry(dict, objv[i], &isNew); if (!isNew) { - Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr); - - /* - * Not really a well-formed dictionary as there are duplicate - * keys, so better get the string rep here so that we can - * convert back. - */ - - (void) Tcl_GetString(objPtr); - - TclDecrRefCount(discardedValue); + needlist = 1; + continue; } Tcl_SetHashValue(hPtr, objv[i+1]); Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */ @@ -710,12 +719,17 @@ SetDictFromAny( * Tcl_GetStringFromObj, to use that old internalRep. */ - TclFreeIntRep(objPtr); dict->epoch = 0; dict->chain = NULL; dict->refcount = 1; + if (needlist) { + /* squirrel the list intrep away for use by SetListFromAny */ + objPtr->internalRep.twoPtrValue.ptr2 = objPtr->internalRep.twoPtrValue.ptr1; + } else { + TclFreeIntRep(objPtr); + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + } DICT(objPtr) = dict; - objPtr->internalRep.twoPtrValue.ptr2 = NULL; objPtr->typePtr = &tclDictType; return TCL_OK; @@ -866,7 +880,7 @@ InvalidateDictChain( Dict *dict = DICT(dictObj); do { - TclInvalidateStringRep(dictObj); + InvalidateOtherReps(dictObj); dict->epoch++; dictObj = dict->chain; if (dictObj == NULL) { @@ -877,6 +891,27 @@ InvalidateDictChain( } while (dict != NULL); } +static void InvalidateListRep( + Tcl_Obj *dictObj +) { + void *tmp; + + if (dictObj->internalRep.twoPtrValue.ptr2 != NULL) { + tmp = dictObj->internalRep.twoPtrValue.ptr1; + dictObj->internalRep.twoPtrValue.ptr1 = dictObj->internalRep.twoPtrValue.ptr2; + TclFreeListInternalRep(dictObj); + dictObj->internalRep.twoPtrValue.ptr1 = tmp; + dictObj->internalRep.twoPtrValue.ptr2 = NULL; + } +} + +static void InvalidateOtherReps( + Tcl_Obj * dictObj +) { + TclInvalidateStringRep(dictObj); + InvalidateListRep(dictObj); +} + /* *---------------------------------------------------------------------- * @@ -917,7 +952,7 @@ Tcl_DictObjPut( } if (dictPtr->bytes != NULL) { - TclInvalidateStringRep(dictPtr); + InvalidateOtherReps(dictPtr); } dict = DICT(dictPtr); hPtr = CreateChainEntry(dict, keyPtr, &isNew); @@ -1017,7 +1052,7 @@ Tcl_DictObjRemove( dict = DICT(dictPtr); if (DeleteChainEntry(dict, keyPtr)) { if (dictPtr->bytes != NULL) { - TclInvalidateStringRep(dictPtr); + InvalidateOtherReps(dictPtr); } dict->epoch++; } @@ -1429,7 +1464,7 @@ Tcl_DbNewDictObj( Dict *dict; TclDbNewObj(dictPtr, file, line); - TclInvalidateStringRep(dictPtr); + InvalidateOtherReps(dictPtr); dict = ckalloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 0; @@ -1631,7 +1666,7 @@ DictReplaceCmd( dictPtr = Tcl_DuplicateObj(dictPtr); } if (dictPtr->bytes != NULL) { - TclInvalidateStringRep(dictPtr); + InvalidateOtherReps(dictPtr); } for (i=2 ; ibytes != NULL) { - TclInvalidateStringRep(dictPtr); - } + InvalidateOtherReps(dictPtr); for (i=2 ; ibytes != NULL) { - TclInvalidateStringRep(dictPtr); + InvalidateOtherReps(dictPtr); } resultPtr = Tcl_ObjSetVar2(interp, objv[1], NULL, dictPtr, diff --git a/generic/tclInt.h b/generic/tclInt.h index b39c8ea..ca34bd7 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -883,6 +883,7 @@ typedef struct VarInHash { (TclIsVarDirectModifyable(varPtr) &&\ (!(arrayPtr) || !((arrayPtr)->flags & (VAR_TRACED_READ|VAR_TRACED_WRITE)))) + /* *---------------------------------------------------------------- * Data structures related to procedures. These are used primarily in @@ -2424,6 +2425,7 @@ typedef struct List { #define TclListObjIsCanonical(listPtr) \ (((listPtr)->typePtr == &tclListType) ? ListObjIsCanonical((listPtr)) : 0) + /* * Modes for collecting (or not) in the implementations of TclNRForeachCmd, * TclNRLmapCmd and their compilations. @@ -3016,6 +3018,7 @@ MODULE_SCOPE Tcl_Obj * TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, MODULE_SCOPE void TclListLines(Tcl_Obj *listObj, int line, int n, int *lines, Tcl_Obj *const *elems); MODULE_SCOPE Tcl_Obj * TclListObjCopy(Tcl_Interp *interp, Tcl_Obj *listPtr); +MODULE_SCOPE void TclFreeListInternalRep(Tcl_Obj *listPtr); MODULE_SCOPE Tcl_Obj * TclLsetList(Tcl_Interp *interp, Tcl_Obj *listPtr, Tcl_Obj *indexPtr, Tcl_Obj *valuePtr); MODULE_SCOPE Tcl_Obj * TclLsetFlat(Tcl_Interp *interp, Tcl_Obj *listPtr, diff --git a/generic/tclListObj.c b/generic/tclListObj.c index 14b8a14..dc40a53 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -13,6 +13,7 @@ #include "tclInt.h" +#define LIST(listObj) ((List *)(listObj)->internalRep.twoPtrValue.ptr1) /* * Prototypes for functions defined later in this file: */ @@ -21,7 +22,6 @@ static List * AttemptNewList(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); static List * NewListIntRep(int objc, Tcl_Obj *const objv[], int p); static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); -static void FreeListInternalRep(Tcl_Obj *listPtr); static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfList(Tcl_Obj *listPtr); @@ -40,7 +40,7 @@ static void UpdateStringOfList(Tcl_Obj *listPtr); const Tcl_ObjType tclListType = { "list", /* name */ - FreeListInternalRep, /* freeIntRepProc */ + TclFreeListInternalRep, /* freeIntRepProc */ DupListInternalRep, /* dupIntRepProc */ UpdateStringOfList, /* updateStringProc */ SetListFromAny /* setFromAnyProc */ @@ -1736,7 +1736,7 @@ TclListObjSetElement( /* *---------------------------------------------------------------------- * - * FreeListInternalRep -- + * TclFreeListInternalRep -- * * Deallocate the storage associated with a list object's internal * representation. @@ -1752,8 +1752,8 @@ TclListObjSetElement( *---------------------------------------------------------------------- */ -static void -FreeListInternalRep( +void +TclFreeListInternalRep( Tcl_Obj *listPtr) /* List object with internal rep to free. */ { List *listRepPtr = ListRepPtr(listPtr); @@ -1828,12 +1828,11 @@ SetListFromAny( /* * Dictionaries are a special case; they have a string representation such * that *all* valid dictionaries are valid lists. Hence we can convert - * more directly. Only do this when there's no existing string rep; if - * there is, it is the string rep that's authoritative (because it could - * describe duplicate keys). + * more directly. + */ - if (objPtr->typePtr == &tclDictType && !objPtr->bytes) { + if (objPtr->typePtr == &tclDictType) { Tcl_Obj *keyPtr, *valuePtr; Tcl_DictSearch search; int done, size; @@ -1847,25 +1846,33 @@ SetListFromAny( * dictionary or iterating over it will not fail. */ - Tcl_DictObjSize(NULL, objPtr, &size); - listRepPtr = AttemptNewList(interp, size > 0 ? 2*size : 1, NULL); - if (!listRepPtr) { - return TCL_ERROR; - } - listRepPtr->elemCount = 2 * size; + if (objPtr->internalRep.twoPtrValue.ptr2 != NULL) { + /* A usable list representation exists. */ + listRepPtr = objPtr->internalRep.twoPtrValue.ptr2; + objPtr->internalRep.twoPtrValue.ptr2 = NULL; + /* To Do: Maybe keep the dict intrep around in case this object is + * used as a dict again */ + } else { + Tcl_DictObjSize(NULL, objPtr, &size); + listRepPtr = AttemptNewList(interp, size > 0 ? 2*size : 1, NULL); + if (!listRepPtr) { + return TCL_ERROR; + } + listRepPtr->elemCount = 2 * size; - /* - * Populate the list representation. - */ + /* + * Populate the list representation. + */ - elemPtrs = &listRepPtr->elements; - Tcl_DictObjFirst(NULL, objPtr, &search, &keyPtr, &valuePtr, &done); - while (!done) { - *elemPtrs++ = keyPtr; - *elemPtrs++ = valuePtr; - Tcl_IncrRefCount(keyPtr); - Tcl_IncrRefCount(valuePtr); - Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); + elemPtrs = &listRepPtr->elements; + Tcl_DictObjFirst(NULL, objPtr, &search, &keyPtr, &valuePtr, &done); + while (!done) { + *elemPtrs++ = keyPtr; + *elemPtrs++ = valuePtr; + Tcl_IncrRefCount(keyPtr); + Tcl_IncrRefCount(valuePtr); + Tcl_DictObjNext(&search, &keyPtr, &valuePtr, &done); + } } } else { int estCount, length; diff --git a/unix/Makefile.in b/unix/Makefile.in index eb083e0..7d967e3 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -718,6 +718,7 @@ gdb-test: ${TCLTEST_EXE} @echo "set env @LD_LIBRARY_PATH_VAR@=`pwd`:$${@LD_LIBRARY_PATH_VAR@}" > gdb.run @echo "set env TCL_LIBRARY=${TCL_BUILDTIME_LIBRARY}" >> gdb.run @echo "set args $(TOP_DIR)/tests/all.tcl $(TESTFLAGS) -singleproc 1" >> gdb.run + @echo "$(GDBSCRIPT)" >> gdb.run $(GDB) ./${TCLTEST_EXE} --command=gdb.run rm gdb.run -- cgit v0.12