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 From f45faf8d9d3fca0e76d199068ef96385d5788bdc Mon Sep 17 00:00:00 2001 From: pooryorick Date: Tue, 26 Jul 2016 18:36:41 +0000 Subject: Converting to stringType no longer loses the existing internal representation of a value. --- generic/tclDictObj.c | 44 +++++++++++++++--------------- generic/tclInt.h | 24 ++++++++++++++++- generic/tclListObj.c | 70 +++++++++++++++++++++++++----------------------- generic/tclObj.c | 40 +++++++++++++++++++++++++++ generic/tclStringObj.c | 40 +++++++++++++++++++++++++-- generic/tclThreadAlloc.c | 5 ++++ unix/tcl.m4 | 2 +- 7 files changed, 167 insertions(+), 58 deletions(-) diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c index ad52ba3..613cdc8 100644 --- a/generic/tclDictObj.c +++ b/generic/tclDictObj.c @@ -500,19 +500,15 @@ UpdateStringOfDict( const char *elem; char *dst; const int maxFlags = UINT_MAX / sizeof(int); - void *tmp; + Tcl_Obj *listObj; 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; + listObj = dictPtr->internalRep.twoPtrValue.ptr2; + TclGetString(listObj); + dictPtr->bytes = listObj->bytes; + dictPtr->length = listObj->length; + listObj->bytes = NULL; return; } @@ -623,6 +619,7 @@ SetDictFromAny( Tcl_HashEntry *hPtr; int isNew, needlist = 0; Dict *dict = ckalloc(sizeof(Dict)); + Tcl_Obj *listObj; InitChainTable(dict); @@ -632,12 +629,14 @@ SetDictFromAny( * the conversion from lists to dictionaries. */ - if (objPtr->typePtr == &tclListType) { + + listObj = TclObjLookupTyped(objPtr, &tclListType); + if (listObj != NULL) { int objc, i; Tcl_Obj **objv; /* Cannot fail, we already know the Tcl_ObjType is "list". */ - TclListObjGetElements(NULL, objPtr, &objc, &objv); + TclListObjGetElements(NULL, listObj, &objc, &objv); if (objc & 1) { goto missingValue; } @@ -647,8 +646,9 @@ 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); needlist = 1; - continue; + Tcl_DecrRefCount(discardedValue); } Tcl_SetHashValue(hPtr, objv[i+1]); Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */ @@ -724,9 +724,13 @@ SetDictFromAny( dict->refcount = 1; if (needlist) { /* squirrel the list intrep away for use by SetListFromAny */ - objPtr->internalRep.twoPtrValue.ptr2 = objPtr->internalRep.twoPtrValue.ptr1; + listObj = Tcl_DuplicateObj(listObj); + Tcl_IncrRefCount(listObj); + } + TclFreeIntRep(objPtr); + if (needlist) { + objPtr->internalRep.twoPtrValue.ptr2 = listObj; } else { - TclFreeIntRep(objPtr); objPtr->internalRep.twoPtrValue.ptr2 = NULL; } DICT(objPtr) = dict; @@ -894,13 +898,11 @@ InvalidateDictChain( static void InvalidateListRep( Tcl_Obj *dictObj ) { - void *tmp; + Tcl_Obj *listObj; 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; + listObj = dictObj->internalRep.twoPtrValue.ptr2; + Tcl_DecrRefCount(listObj); dictObj->internalRep.twoPtrValue.ptr2 = NULL; } } @@ -1464,7 +1466,7 @@ Tcl_DbNewDictObj( Dict *dict; TclDbNewObj(dictPtr, file, line); - InvalidateOtherReps(dictPtr); + TclInvalidateStringRep(dictPtr); dict = ckalloc(sizeof(Dict)); InitChainTable(dict); dict->epoch = 0; diff --git a/generic/tclInt.h b/generic/tclInt.h index ca34bd7..94fa713 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -2512,6 +2512,28 @@ typedef struct List { #define DICT_PATH_NON_EXISTENT ((Tcl_Obj *) (void *) 1) +/* + * Macros for tclStringType objects + */ + +#define TclStringGetPrev(objPtr) \ + ((Tcl_Obj *)((objPtr)->internalRep.twoPtrValue.ptr2)) +#define TclStringSetPrev(objPtr,prevPtr) \ + do { \ + (objPtr)->internalRep.twoPtrValue.ptr2 = (void *) (prevPtr); \ + } while (0) +#define TclStringInvalidatePrev(objPtr) \ + do { \ + if (TclStringGetPrev((objPtr)) != NULL) { \ + Tcl_DecrRefCount(TclStringGetPrev((objPtr))); \ + } \ + (objPtr)->internalRep.twoPtrValue.ptr2 = NULL; \ + } while (0) + +#define TclStringPrevIs(objPtr, checkTypePtr) \ + (TclStringGetPrev((objPtr))->typePtr == &(checkTypePtr)) + + /* *---------------------------------------------------------------- * Data structures related to the filesystem internals @@ -3018,7 +3040,6 @@ 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, @@ -3040,6 +3061,7 @@ MODULE_SCOPE void TclObjVarErrMsg(Tcl_Interp *interp, Tcl_Obj *part1Ptr, MODULE_SCOPE int TclObjInvokeNamespace(Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], Tcl_Namespace *nsPtr, int flags); +MODULE_SCOPE Tcl_Obj * TclObjLookupTyped (Tcl_Obj * objPtr, Tcl_ObjType *typeptr); MODULE_SCOPE int TclObjUnsetVar2(Tcl_Interp *interp, Tcl_Obj *part1Ptr, Tcl_Obj *part2Ptr, int flags); MODULE_SCOPE int TclParseBackslash(const char *src, diff --git a/generic/tclListObj.c b/generic/tclListObj.c index dc40a53..0852c8c 100644 --- a/generic/tclListObj.c +++ b/generic/tclListObj.c @@ -21,6 +21,7 @@ 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 FreeListInternalRep(Tcl_Obj *listPtr); static void DupListInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr); static int SetListFromAny(Tcl_Interp *interp, Tcl_Obj *objPtr); static void UpdateStringOfList(Tcl_Obj *listPtr); @@ -40,7 +41,7 @@ static void UpdateStringOfList(Tcl_Obj *listPtr); const Tcl_ObjType tclListType = { "list", /* name */ - TclFreeListInternalRep, /* freeIntRepProc */ + FreeListInternalRep, /* freeIntRepProc */ DupListInternalRep, /* dupIntRepProc */ UpdateStringOfList, /* updateStringProc */ SetListFromAny /* setFromAnyProc */ @@ -1736,7 +1737,7 @@ TclListObjSetElement( /* *---------------------------------------------------------------------- * - * TclFreeListInternalRep -- + * FreeListInternalRep -- * * Deallocate the storage associated with a list object's internal * representation. @@ -1752,8 +1753,8 @@ TclListObjSetElement( *---------------------------------------------------------------------- */ -void -TclFreeListInternalRep( +static void +FreeListInternalRep( Tcl_Obj *listPtr) /* List object with internal rep to free. */ { List *listRepPtr = ListRepPtr(listPtr); @@ -1822,16 +1823,27 @@ SetListFromAny( Tcl_Interp *interp, /* Used for error reporting if not NULL. */ Tcl_Obj *objPtr) /* The object to convert. */ { + Tcl_Obj *listPtr; List *listRepPtr; Tcl_Obj **elemPtrs; /* - * Dictionaries are a special case; they have a string representation such - * that *all* valid dictionaries are valid lists. Hence we can convert - * more directly. - + * Dictionaries are a special case; they may have stored a previous list + * representation */ + listPtr = TclObjLookupTyped(objPtr, &tclListType); + if (listPtr != NULL) { + Tcl_IncrRefCount(listPtr); + TclFreeIntRep(objPtr); + DupListInternalRep(listPtr, objPtr); + Tcl_DecrRefCount(listPtr); + objPtr->typePtr = &tclListType; + /* To Do: Maybe keep the dict intrep around in case this object is + * used as a dict again */ + return TCL_OK; + } + if (objPtr->typePtr == &tclDictType) { Tcl_Obj *keyPtr, *valuePtr; Tcl_DictSearch search; @@ -1846,33 +1858,25 @@ SetListFromAny( * dictionary or iterating over it will not fail. */ - 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; + 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/generic/tclObj.c b/generic/tclObj.c index df17f13..ea1e5ae 100644 --- a/generic/tclObj.c +++ b/generic/tclObj.c @@ -4492,6 +4492,46 @@ Tcl_RepresentationCmd( } /* + *---------------------------------------------------------------------- + * + * TclLookupObjTyped -- + * + * Given a Tcl_Obj, find an corresponding object, if one exists, of a + * given type. + * + * Results: + * The found object, or, if no such corresponding object was found, NULL. + * + * + * Side effects: + * None + * + *---------------------------------------------------------------------- + */ + +Tcl_Obj * +TclObjLookupTyped (Tcl_Obj * objPtr, Tcl_ObjType *typePtr) { + Tcl_Obj *foundPtr; + if (typePtr == objPtr->typePtr) { + return objPtr; + } + if (objPtr->typePtr == &tclStringType) { + foundPtr = TclStringGetPrev(objPtr); + if (foundPtr == NULL) { + return NULL; + } + return TclObjLookupTyped(foundPtr, typePtr); + } + if (typePtr == &tclListType) { + if (objPtr->typePtr == &tclDictType && objPtr->internalRep.twoPtrValue.ptr2 != NULL) { + /* A usable list representation exists. */ + return objPtr->internalRep.twoPtrValue.ptr2; + } + } + return NULL; +} + +/* * Local Variables: * mode: c * c-basic-offset: 4 diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index e3cede6..8a95554 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -379,6 +379,7 @@ Tcl_NewUnicodeObj( Tcl_Obj *objPtr; TclNewObj(objPtr); + TclStringSetPrev(objPtr, NULL); SetUnicodeObj(objPtr, unicode, numChars); return objPtr; } @@ -942,11 +943,17 @@ Tcl_SetUnicodeObj( int numChars) /* Number of characters in the unicode * string. */ { + Tcl_Obj *prevPtr = NULL; if (Tcl_IsShared(objPtr)) { Tcl_Panic("%s called with shared object", "Tcl_SetUnicodeObj"); } + if (objPtr->typePtr != NULL && objPtr->typePtr != &tclStringType) { + prevPtr = Tcl_DuplicateObj(objPtr); + Tcl_IncrRefCount(prevPtr); + } TclFreeIntRep(objPtr); SetUnicodeObj(objPtr, unicode, numChars); + TclStringSetPrev(objPtr, prevPtr); } static int @@ -992,7 +999,6 @@ SetUnicodeObj( stringPtr->unicode[numChars] = 0; stringPtr->numChars = numChars; stringPtr->hasUnicode = 1; - TclInvalidateStringRep(objPtr); stringPtr->allocated = 0; } @@ -1328,6 +1334,9 @@ AppendUnicodeToUnicodeRep( } SetStringFromAny(NULL, objPtr); + if (appendNumChars > 0) { + TclStringInvalidatePrev(objPtr); + } stringPtr = GET_STRING(objPtr); /* @@ -1481,6 +1490,7 @@ AppendUtfToUtfRep( if (numBytes == 0) { return; } + TclStringInvalidatePrev(objPtr); /* * Copy the new string onto the end of the old string, then add the @@ -2782,6 +2792,9 @@ ExtendUnicodeRepWithString( if (numAppendChars == -1) { TclNumUtfChars(numAppendChars, bytes, numBytes); } + if (numAppendChars > 0) { + TclStringInvalidatePrev(objPtr); + } needed = numOrigChars + numAppendChars; stringCheckLimits(needed); @@ -2829,6 +2842,7 @@ DupStringInternalRep( { String *srcStringPtr = GET_STRING(srcPtr); String *copyStringPtr = NULL; + Tcl_Obj *prevPtr; if (srcStringPtr->numChars == -1) { /* @@ -2870,10 +2884,15 @@ DupStringInternalRep( * code, so it doesn't contain any extra bytes that might exist in the * source object. */ - copyStringPtr->allocated = copyPtr->bytes ? copyPtr->length : 0; SET_STRING(copyPtr, copyStringPtr); + prevPtr = TclStringGetPrev(srcPtr); + if (prevPtr != NULL) { + prevPtr = Tcl_DuplicateObj(prevPtr); + Tcl_IncrRefCount(prevPtr); + } + TclStringSetPrev(copyPtr, prevPtr); copyPtr->typePtr = &tclStringType; } @@ -2901,6 +2920,8 @@ SetStringFromAny( { if (objPtr->typePtr != &tclStringType) { String *stringPtr = stringAlloc(0); + Tcl_Obj *prevPtr = Tcl_DuplicateObj(objPtr); + Tcl_IncrRefCount(prevPtr); /* * Convert whatever we have into an untyped value. Just A String. @@ -2919,6 +2940,7 @@ SetStringFromAny( stringPtr->maxChars = 0; stringPtr->hasUnicode = 0; SET_STRING(objPtr, stringPtr); + TclStringSetPrev(objPtr, prevPtr); objPtr->typePtr = &tclStringType; } return TCL_OK; @@ -2977,6 +2999,7 @@ ExtendStringRepWithUnicode( if (numChars == 0) { return 0; } + TclStringInvalidatePrev(objPtr); if (objPtr->bytes == NULL) { objPtr->length = 0; @@ -3038,10 +3061,23 @@ static void FreeStringInternalRep( Tcl_Obj *objPtr) /* Object with internal rep to free. */ { + Tcl_Obj * prevPtr = TclStringGetPrev(objPtr); + if (prevPtr != NULL) { + Tcl_DecrRefCount(prevPtr); + } ckfree(GET_STRING(objPtr)); objPtr->typePtr = NULL; } +static void InvalidateCachedReps( + Tcl_Obj *objPtr +) { + Tcl_Obj * prevPtr = TclStringGetPrev(objPtr); + if (prevPtr != NULL) { + Tcl_DecrRefCount(TclStringGetPrev(objPtr)); + } +} + /* * Local Variables: * mode: c diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index 018f006..aa67895 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -620,15 +620,20 @@ void TclThreadFreeObj( Tcl_Obj *objPtr) { + return; Cache *cachePtr; GETCACHE(cachePtr); + /* * Get this thread's list and push on the free Tcl_Obj. */ objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; + if (objPtr == 0x1c19247) { + Tcl_WriteChars(Tcl_GetStdChannel(TCL_STDOUT), "helloGro", -1); + } cachePtr->firstObjPtr = objPtr; if (cachePtr->numObjects == 0) { cachePtr->lastPtr = objPtr; diff --git a/unix/tcl.m4 b/unix/tcl.m4 index f5aa84e..29bc0f5 100644 --- a/unix/tcl.m4 +++ b/unix/tcl.m4 @@ -734,7 +734,7 @@ AC_DEFUN([SC_ENABLE_SYMBOLS], [ AC_MSG_CHECKING([for build with symbols]) AC_ARG_ENABLE(symbols, AC_HELP_STRING([--enable-symbols], - [build with debugging symbols (default: off)]), + [build with debugging symbols (all, compile, or mem) (default: off)]), [tcl_ok=$enableval], [tcl_ok=no]) # FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT. DBGX="" -- cgit v0.12 From f1810dae6c5de7512c2d388b7631b7dc4a888928 Mon Sep 17 00:00:00 2001 From: pooryorick Date: Thu, 28 Jul 2016 19:46:14 +0000 Subject: Remove left-over debugging code. --- generic/tclThreadAlloc.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c index aa67895..12ce1c3 100644 --- a/generic/tclThreadAlloc.c +++ b/generic/tclThreadAlloc.c @@ -620,7 +620,6 @@ void TclThreadFreeObj( Tcl_Obj *objPtr) { - return; Cache *cachePtr; GETCACHE(cachePtr); @@ -631,9 +630,6 @@ TclThreadFreeObj( */ objPtr->internalRep.twoPtrValue.ptr1 = cachePtr->firstObjPtr; - if (objPtr == 0x1c19247) { - Tcl_WriteChars(Tcl_GetStdChannel(TCL_STDOUT), "helloGro", -1); - } cachePtr->firstObjPtr = objPtr; if (cachePtr->numObjects == 0) { cachePtr->lastPtr = objPtr; -- cgit v0.12