Subject: Avoid generating string for list dict list round trip.

From: pooryorick <[email-masked]>
Date: Fri, 22 Jul 2016 19:27:38 +0000

---
 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 ; i<objc ; i+=2) {
 	Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
@@ -1681,9 +1716,7 @@ DictRemoveCmd(
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
     }
-    if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
-    }
+    InvalidateOtherReps(dictPtr);
     for (i=2 ; i<objc ; i++) {
 	Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
     }
@@ -2155,7 +2188,7 @@ DictIncrCmd(
 	}
     }
     if (code == TCL_OK) {
-	TclInvalidateStringRep(dictPtr);
+	InvalidateOtherReps(dictPtr);
 	valuePtr = Tcl_ObjSetVar2(interp, objv[1], NULL,
 		dictPtr, TCL_LEAVE_ERR_MSG);
 	if (valuePtr == NULL) {
@@ -2244,7 +2277,7 @@ DictLappendCmd(
     if (allocatedValue) {
 	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
     } else if (dictPtr->bytes != 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