Implement TIP 445

1 files changed, 125 insertions, 97 deletions

diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index 119b7a0..305a678 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -12,6 +12,7 @@
 
 #include "tclInt.h"
 #include "tommath.h"
+#include <assert.h>
 
 /*
  * Forward declaration.
@@ -149,13 +150,6 @@ typedef struct Dict {
 } Dict;
 
 /*
- * Accessor macro for converting between a Tcl_Obj* and a Dict. Note that this
- * must be assignable as well as readable.
- */
-
-#define DICT(dictObj)   ((dictObj)->internalRep.twoPtrValue.ptr1)
-
-/*
  * The structure below defines the dictionary object type by means of
  * functions that can be invoked by generic object code.
  */
@@ -168,6 +162,21 @@ const Tcl_ObjType tclDictType = {
     SetDictFromAny			/* setFromAnyProc */
 };
 
+#define DictSetIntRep(objPtr, dictRepPtr)				\
+    do {                                                                \
+        Tcl_ObjIntRep ir;                                               \
+        ir.twoPtrValue.ptr1 = (dictRepPtr);                             \
+        ir.twoPtrValue.ptr2 = NULL;                                     \
+        Tcl_StoreIntRep((objPtr), &tclDictType, &ir);                   \
+    } while (0)
+
+#define DictGetIntRep(objPtr, dictRepPtr)				\
+    do {                                                                \
+        const Tcl_ObjIntRep *irPtr;                                     \
+        irPtr = Tcl_FetchIntRep((objPtr), &tclDictType);                \
+        (dictRepPtr) = irPtr ? irPtr->twoPtrValue.ptr1 : NULL;          \
+    } while (0)
+
 /*
  * The type of the specially adapted version of the Tcl_Obj*-containing hash
  * table defined in the tclObj.c code. This version differs in that it
@@ -363,10 +372,11 @@ DupDictInternalRep(
     Tcl_Obj *srcPtr,
     Tcl_Obj *copyPtr)
 {
-    Dict *oldDict = DICT(srcPtr);
-    Dict *newDict = Tcl_Alloc(sizeof(Dict));
+    Dict *oldDict, *newDict = Tcl_Alloc(sizeof(Dict));
     ChainEntry *cPtr;
 
+    DictGetIntRep(srcPtr, oldDict);
+
     /*
      * Copy values across from the old hash table.
      */
@@ -398,9 +408,7 @@ DupDictInternalRep(
      * Store in the object.
      */
 
-    DICT(copyPtr) = newDict;
-    copyPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    copyPtr->typePtr = &tclDictType;
+    DictSetIntRep(copyPtr, newDict);
 }
 
 /*
@@ -425,12 +433,13 @@ static void
 FreeDictInternalRep(
     Tcl_Obj *dictPtr)
 {
-    Dict *dict = DICT(dictPtr);
+    Dict *dict;
+
+    DictGetIntRep(dictPtr, dict);
 
     if (dict->refCount-- <= 1) {
 	DeleteDict(dict);
     }
-    dictPtr->typePtr = NULL;
 }
 
 /*
@@ -489,7 +498,7 @@ UpdateStringOfDict(
 {
 #define LOCAL_SIZE 64
     char localFlags[LOCAL_SIZE], *flagPtr = NULL;
-    Dict *dict = DICT(dictPtr);
+    Dict *dict;
     ChainEntry *cPtr;
     Tcl_Obj *keyPtr, *valuePtr;
     size_t i, length, bytesNeeded = 0;
@@ -501,12 +510,17 @@ UpdateStringOfDict(
      * is not exposed by any API function...
      */
 
-    size_t numElems = dict->table.numEntries * 2;
+    size_t numElems;
+
+    DictGetIntRep(dictPtr, dict);
+
+    assert (dict != NULL);
+
+    numElems = dict->table.numEntries * 2;
 
     /* Handle empty list case first, simplifies what follows */
     if (numElems == 0) {
-	dictPtr->bytes = &tclEmptyString;
-	dictPtr->length = 0;
+	Tcl_InitStringRep(dictPtr, NULL, 0);
 	return;
     }
 
@@ -542,9 +556,8 @@ UpdateStringOfDict(
      * Pass 2: copy into string rep buffer.
      */
 
-    dictPtr->length = bytesNeeded - 1;
-    dictPtr->bytes = Tcl_Alloc(bytesNeeded);
-    dst = dictPtr->bytes;
+    dst = Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
+    TclOOM(dst, bytesNeeded);
     for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
 	flagPtr[i] |= ( i ? TCL_DONT_QUOTE_HASH : 0 );
 	keyPtr = Tcl_GetHashKey(&dict->table, &cPtr->entry);
@@ -560,7 +573,7 @@ UpdateStringOfDict(
 	dst += TclConvertElement(elem, length, dst, flagPtr[i+1]);
 	*dst++ = ' ';
     }
-    dictPtr->bytes[dictPtr->length] = '\0';
+    (void)Tcl_InitStringRep(dictPtr, NULL, bytesNeeded - 1);
 
     if (flagPtr != localFlags) {
 	Tcl_Free(flagPtr);
@@ -604,7 +617,7 @@ SetDictFromAny(
      * the conversion from lists to dictionaries.
      */
 
-    if (objPtr->typePtr == &tclListType) {
+    if (Tcl_FetchIntRep(objPtr, &tclListType)) {
 	int objc, i;
 	Tcl_Obj **objv;
 
@@ -660,10 +673,14 @@ SetDictFromAny(
 		TclNewStringObj(keyPtr, elemStart, elemSize);
 	    } else {
 		/* Avoid double copy */
+		char *dst;
+
 		TclNewObj(keyPtr);
-		keyPtr->bytes = Tcl_Alloc((unsigned) elemSize + 1);
-		keyPtr->length = TclCopyAndCollapse(elemSize, elemStart,
-			keyPtr->bytes);
+		Tcl_InvalidateStringRep(keyPtr);
+		dst = Tcl_InitStringRep(keyPtr, NULL, elemSize);
+		TclOOM(dst, elemSize); /* Consider error */
+		(void)Tcl_InitStringRep(keyPtr, NULL,
+			TclCopyAndCollapse(elemSize, elemStart, dst));
 	    }
 
 	    if (TclFindDictElement(interp, nextElem, (limit - nextElem),
@@ -676,10 +693,14 @@ SetDictFromAny(
 		TclNewStringObj(valuePtr, elemStart, elemSize);
 	    } else {
 		/* Avoid double copy */
+		char *dst;
+
 		TclNewObj(valuePtr);
-		valuePtr->bytes = Tcl_Alloc((unsigned) elemSize + 1);
-		valuePtr->length = TclCopyAndCollapse(elemSize, elemStart,
-			valuePtr->bytes);
+		Tcl_InvalidateStringRep(valuePtr);
+		dst = Tcl_InitStringRep(valuePtr, NULL, elemSize);
+		TclOOM(dst, elemSize); /* Consider error */
+		(void)Tcl_InitStringRep(valuePtr, NULL,
+			TclCopyAndCollapse(elemSize, elemStart, dst));
 	    }
 
 	    /* Store key and value in the hash table we're building. */
@@ -701,13 +722,10 @@ SetDictFromAny(
      * Tcl_GetStringFromObj, to use that old internalRep.
      */
 
-    TclFreeIntRep(objPtr);
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DICT(objPtr) = dict;
-    objPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    objPtr->typePtr = &tclDictType;
+    DictSetIntRep(objPtr, dict);
     return TCL_OK;
 
   missingValue:
@@ -721,6 +739,23 @@ SetDictFromAny(
     Tcl_Free(dict);
     return TCL_ERROR;
 }
+
+static Dict *
+GetDictFromObj(
+    Tcl_Interp *interp,
+    Tcl_Obj *dictPtr)
+{
+    Dict *dict;
+
+    DictGetIntRep(dictPtr, dict);
+    if (dict == NULL) {
+	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	    return NULL;
+	}
+	DictGetIntRep(dictPtr, dict);
+    }
+    return dict;
+}
 
 /*
  *----------------------------------------------------------------------
@@ -765,11 +800,13 @@ TclTraceDictPath(
     Dict *dict, *newDict;
     int i;
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
-	return NULL;
+    DictGetIntRep(dictPtr, dict);
+    if (dict == NULL) {
+	if (SetDictFromAny(interp, dictPtr) != TCL_OK) {
+	    return NULL;
+	}
+	DictGetIntRep(dictPtr, dict);
     }
-    dict = DICT(dictPtr);
     if (flags & DICT_PATH_UPDATE) {
 	dict->chain = NULL;
     }
@@ -805,13 +842,17 @@ TclTraceDictPath(
 	    Tcl_SetHashValue(hPtr, tmpObj);
 	} else {
 	    tmpObj = Tcl_GetHashValue(hPtr);
-	    if (tmpObj->typePtr != &tclDictType
-		    && SetDictFromAny(interp, tmpObj) != TCL_OK) {
-		return NULL;
+
+	    DictGetIntRep(tmpObj, newDict);
+
+	    if (newDict == NULL) {
+		if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
+		    return NULL;
+		}
 	    }
 	}
 
-	newDict = DICT(tmpObj);
+	DictGetIntRep(tmpObj, newDict);
 	if (flags & DICT_PATH_UPDATE) {
 	    if (Tcl_IsShared(tmpObj)) {
 		TclDecrRefCount(tmpObj);
@@ -819,7 +860,7 @@ TclTraceDictPath(
 		Tcl_IncrRefCount(tmpObj);
 		Tcl_SetHashValue(hPtr, tmpObj);
 		dict->epoch++;
-		newDict = DICT(tmpObj);
+		DictGetIntRep(tmpObj, newDict);
 	    }
 
 	    newDict->chain = dictPtr;
@@ -854,17 +895,24 @@ static void
 InvalidateDictChain(
     Tcl_Obj *dictObj)
 {
-    Dict *dict = DICT(dictObj);
+    Dict *dict;
+
+    DictGetIntRep(dictObj, dict);
+    assert( dict != NULL);
 
     do {
+	dict->refCount++;
 	TclInvalidateStringRep(dictObj);
+	TclFreeIntRep(dictObj);
+	DictSetIntRep(dictObj, dict);
+
 	dict->epoch++;
 	dictObj = dict->chain;
 	if (dictObj == NULL) {
 	    break;
 	}
 	dict->chain = NULL;
-	dict = DICT(dictObj);
+	DictGetIntRep(dictObj, dict);
     } while (dict != NULL);
 }
 
@@ -902,16 +950,16 @@ Tcl_DictObjPut(
 	Tcl_Panic("%s called with shared object", "Tcl_DictObjPut");
     }
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, dictPtr);
+    if (dict == NULL) {
 	return TCL_ERROR;
     }
 
-    if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
-    }
-    dict = DICT(dictPtr);
+    TclInvalidateStringRep(dictPtr);
     hPtr = CreateChainEntry(dict, keyPtr, &isNew);
+    dict->refCount++;
+    TclFreeIntRep(dictPtr)
+    DictSetIntRep(dictPtr, dict);
     Tcl_IncrRefCount(valuePtr);
     if (!isNew) {
 	Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
@@ -953,13 +1001,12 @@ Tcl_DictObjGet(
     Dict *dict;
     Tcl_HashEntry *hPtr;
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, dictPtr);
+    if (dict == NULL) {
 	*valuePtrPtr = NULL;
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
     hPtr = Tcl_FindHashEntry(&dict->table, keyPtr);
     if (hPtr == NULL) {
 	*valuePtrPtr = NULL;
@@ -1000,16 +1047,13 @@ Tcl_DictObjRemove(
 	Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
     }
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, dictPtr);
+    if (dict == NULL) {
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
     if (DeleteChainEntry(dict, keyPtr)) {
-	if (dictPtr->bytes != NULL) {
-	    TclInvalidateStringRep(dictPtr);
-	}
+	TclInvalidateStringRep(dictPtr);
 	dict->epoch++;
     }
     return TCL_OK;
@@ -1041,12 +1085,11 @@ Tcl_DictObjSize(
 {
     Dict *dict;
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, dictPtr);
+    if (dict == NULL) {
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
     *sizePtr = dict->table.numEntries;
     return TCL_OK;
 }
@@ -1093,12 +1136,11 @@ Tcl_DictObjFirst(
     Dict *dict;
     ChainEntry *cPtr;
 
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, dictPtr);
+    if (dict == NULL) {
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
     cPtr = dict->entryChainHead;
     if (cPtr == NULL) {
 	searchPtr->epoch = 0;
@@ -1272,7 +1314,8 @@ Tcl_DictObjPutKeyList(
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
+    DictGetIntRep(dictPtr, dict);
+    assert(dict != NULL);
     hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
     Tcl_IncrRefCount(valuePtr);
     if (!isNew) {
@@ -1329,7 +1372,8 @@ Tcl_DictObjRemoveKeyList(
 	return TCL_ERROR;
     }
 
-    dict = DICT(dictPtr);
+    DictGetIntRep(dictPtr, dict);
+    assert(dict != NULL);
     DeleteChainEntry(dict, keyv[keyc-1]);
     InvalidateDictChain(dictPtr);
     return TCL_OK;
@@ -1375,9 +1419,7 @@ Tcl_NewDictObj(void)
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DICT(dictPtr) = dict;
-    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    dictPtr->typePtr = &tclDictType;
+    DictSetIntRep(dictPtr, dict);
     return dictPtr;
 #endif
 }
@@ -1425,9 +1467,7 @@ Tcl_DbNewDictObj(
     dict->epoch = 1;
     dict->chain = NULL;
     dict->refCount = 1;
-    DICT(dictPtr) = dict;
-    dictPtr->internalRep.twoPtrValue.ptr2 = NULL;
-    dictPtr->typePtr = &tclDictType;
+    DictSetIntRep(dictPtr, dict);
     return dictPtr;
 #else /* !TCL_MEM_DEBUG */
     return Tcl_NewDictObj();
@@ -1613,16 +1653,13 @@ DictReplaceCmd(
     }
 
     dictPtr = objv[1];
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    if (GetDictFromObj(interp, dictPtr) == NULL) {
 	return TCL_ERROR;
     }
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
     }
-    if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
-    }
+    TclInvalidateStringRep(dictPtr);
     for (i=2 ; i<objc ; i+=2) {
 	Tcl_DictObjPut(NULL, dictPtr, objv[i], objv[i+1]);
     }
@@ -1664,16 +1701,13 @@ DictRemoveCmd(
     }
 
     dictPtr = objv[1];
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    if (GetDictFromObj(interp, dictPtr) == NULL) {
 	return TCL_ERROR;
     }
     if (Tcl_IsShared(dictPtr)) {
 	dictPtr = Tcl_DuplicateObj(dictPtr);
     }
-    if (dictPtr->bytes != NULL) {
-	TclInvalidateStringRep(dictPtr);
-    }
+    TclInvalidateStringRep(dictPtr);
     for (i=2 ; i<objc ; i++) {
 	Tcl_DictObjRemove(NULL, dictPtr, objv[i]);
     }
@@ -1724,8 +1758,7 @@ DictMergeCmd(
      */
 
     targetObj = objv[1];
-    if (targetObj->typePtr != &tclDictType
-	    && SetDictFromAny(interp, targetObj) != TCL_OK) {
+    if (GetDictFromObj(interp, targetObj) == NULL) {
 	return TCL_ERROR;
     }
 
@@ -1808,8 +1841,7 @@ DictKeysCmd(
      * need. [Bug 1705778, leak K04]
      */
 
-    if (objv[1]->typePtr != &tclDictType
-	    && SetDictFromAny(interp, objv[1]) != TCL_OK) {
+    if (GetDictFromObj(interp, objv[1]) == NULL) {
 	return TCL_ERROR;
     }
 
@@ -2016,7 +2048,6 @@ DictInfoCmd(
     int objc,
     Tcl_Obj *const *objv)
 {
-    Tcl_Obj *dictPtr;
     Dict *dict;
     char *statsStr;
 
@@ -2025,12 +2056,10 @@ DictInfoCmd(
 	return TCL_ERROR;
     }
 
-    dictPtr = objv[1];
-    if (dictPtr->typePtr != &tclDictType
-	    && SetDictFromAny(interp, dictPtr) != TCL_OK) {
+    dict = GetDictFromObj(interp, objv[1]);
+    if (dict == NULL) {
 	return TCL_ERROR;
     }
-    dict = DICT(dictPtr);
 
     statsStr = Tcl_HashStats(&dict->table);
     Tcl_SetObjResult(interp, Tcl_NewStringObj(statsStr, -1));
@@ -2091,12 +2120,11 @@ DictIncrCmd(
 	 * soon be no good.
 	 */
 
-	char *saved = dictPtr->bytes;
 	Tcl_Obj *oldPtr = dictPtr;
 
-	dictPtr->bytes = NULL;
-	dictPtr = Tcl_DuplicateObj(dictPtr);
-	oldPtr->bytes = saved;
+	TclNewObj(dictPtr);
+	TclInvalidateStringRep(dictPtr);
+	DupDictInternalRep(oldPtr, dictPtr);
     }
     if (valuePtr == NULL) {
 	/*
@@ -2233,7 +2261,7 @@ DictLappendCmd(
 
     if (allocatedValue) {
 	Tcl_DictObjPut(NULL, dictPtr, objv[2], valuePtr);
-    } else if (dictPtr->bytes != NULL) {
+    } else {
 	TclInvalidateStringRep(dictPtr);
     }