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