summaryrefslogtreecommitdiffstats
path: root/generic
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2007-11-20 20:43:08 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2007-11-20 20:43:08 (GMT)
commit69ece03dc014b44e93da9576bb02d060b202013b (patch)
treeb18999bb6907a1311f4eb7808445c05911198c15 /generic
parent0500cb0762976df7a95232b162dbb09d7876d0ea (diff)
downloadtcl-69ece03dc014b44e93da9576bb02d060b202013b.zip
tcl-69ece03dc014b44e93da9576bb02d060b202013b.tar.gz
tcl-69ece03dc014b44e93da9576bb02d060b202013b.tar.bz2
* generic/tclDictObj.c: Changed the underlying implementation of the
hash table used in dictionaries to additionally keep all entries in the hash table in a linked list, which is only ever added to at the end. This makes iteration over all entries in the dictionary in key insertion order a trivial operation, and so cleans up a great deal of complexity relating to dictionary representation and stability of iteration order.
Diffstat (limited to 'generic')
-rw-r--r--generic/tcl.h5
-rw-r--r--generic/tclDictObj.c477
-rw-r--r--generic/tclInt.h10
-rw-r--r--generic/tclObj.c37
4 files changed, 344 insertions, 185 deletions
diff --git a/generic/tcl.h b/generic/tcl.h
index f9fdb1f..db919dc 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tcl.h,v 1.244 2007/11/19 18:14:48 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.245 2007/11/20 20:43:11 dkf Exp $
*/
#ifndef _TCL
@@ -1264,7 +1264,8 @@ typedef struct Tcl_HashSearch {
*/
typedef struct {
- Tcl_HashSearch search; /* Search struct for underlying hash table. */
+ void *next; /* Search position for underlying hash
+ * table. */
int epoch; /* Epoch marker for dictionary being searched,
* or -1 if search has terminated. */
Tcl_Dict dictionaryPtr; /* Reference to dictionary being searched. */
diff --git a/generic/tclDictObj.c b/generic/tclDictObj.c
index f2d6807..1a81260 100644
--- a/generic/tclDictObj.c
+++ b/generic/tclDictObj.c
@@ -9,7 +9,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclDictObj.c,v 1.52 2007/11/19 11:17:24 dkf Exp $
+ * RCS: @(#) $Id: tclDictObj.c,v 1.53 2007/11/20 20:43:11 dkf Exp $
*/
#include "tclInt.h"
@@ -26,48 +26,65 @@ struct Dict;
static void DeleteDict(struct Dict *dict);
static int DictAppendCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictCreateCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictExistsCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictFilterCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictForCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictGetCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictIncrCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictInfoCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictKeysCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictLappendCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictMergeCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictRemoveCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictReplaceCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictSetCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictSizeCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictUnsetCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictValuesCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictUpdateCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static int DictWithCmd(Tcl_Interp *interp,
- int objc, Tcl_Obj *CONST *objv);
+ int objc, Tcl_Obj *const *objv);
static void DupDictInternalRep(Tcl_Obj *srcPtr, Tcl_Obj *copyPtr);
static void FreeDictInternalRep(Tcl_Obj *dictPtr);
static void InvalidateDictChain(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);
+static inline void InitChainTable(struct Dict *dict);
+static inline void DeleteChainTable(struct Dict *dict);
+static inline Tcl_HashEntry *CreateChainEntry(struct Dict *dict,
+ Tcl_Obj *keyPtr, int *newPtr);
+static inline int DeleteChainEntry(struct Dict *dict, Tcl_Obj *keyPtr);
+
+/*
+ * Internal representation of the entries in the hash table that backs a
+ * dictionary.
+ */
+
+typedef struct ChainEntry {
+ Tcl_HashEntry entry;
+ struct ChainEntry *prevPtr;
+ struct ChainEntry *nextPtr;
+} ChainEntry;
/*
* Internal representation of a dictionary.
@@ -86,6 +103,14 @@ static void UpdateStringOfDict(Tcl_Obj *dictPtr);
typedef struct Dict {
Tcl_HashTable table; /* Object hash table to store mapping in. */
+ ChainEntry *entryChainHead; /* Linked list of all entries in the
+ * dictionary. Used for doing traversal of the
+ * entries in the order that they are
+ * created. */
+ ChainEntry *entryChainTail; /* Other end of linked list of all entries in
+ * the dictionary. Used for doing traversal of
+ * the entries in the order that they are
+ * created. */
int epoch; /* Epoch counter */
int refcount; /* Reference counter (see above) */
Tcl_Obj *chain; /* Linked list used for invalidating the
@@ -105,6 +130,153 @@ Tcl_ObjType tclDictType = {
UpdateStringOfDict, /* updateStringProc */
SetDictFromAny /* setFromAnyProc */
};
+
+/*
+ * 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
+ * allocates a bit more space in each hash entry in order to hold the pointers
+ * used to keep the hash entries in a linked list.
+ */
+
+static Tcl_HashKeyType chainHashType = {
+ TCL_HASH_KEY_TYPE_VERSION,
+ 0,
+ TclHashObjKey,
+ TclCompareObjKeys,
+ AllocChainEntry,
+ TclFreeObjEntry
+};
+
+/***** START OF FUNCTIONS IMPLEMENTING DICT CORE API *****/
+
+/*
+ *----------------------------------------------------------------------
+ *
+ * AllocChainEntry --
+ *
+ * Allocate space for a Tcl_HashEntry containing the Tcl_Obj * key, and
+ * which has a bit of extra space afterwards for storing pointers to the
+ * rest of the chain of entries (the extra pointers are left NULL).
+ *
+ * Results:
+ * The return value is a pointer to the created entry.
+ *
+ * Side effects:
+ * Increments the reference count on the object.
+ *
+ *----------------------------------------------------------------------
+ */
+
+static Tcl_HashEntry *
+AllocChainEntry(
+ Tcl_HashTable *tablePtr,
+ void *keyPtr)
+{
+ Tcl_Obj *objPtr = keyPtr;
+ ChainEntry *cPtr;
+
+ cPtr = (ChainEntry *) ckalloc(sizeof(ChainEntry));
+ cPtr->entry.key.oneWordValue = (char *) objPtr;
+ Tcl_IncrRefCount(objPtr);
+ cPtr->entry.clientData = NULL;
+ cPtr->prevPtr = cPtr->nextPtr = NULL;
+
+ return &cPtr->entry;
+}
+
+/*
+ * Helper functions that disguise most of the details relating to how the
+ * linked list of hash entries is managed. In particular, these manage the
+ * creation of the table and initializing of the chain, the deletion of the
+ * table and chain, the adding of an entry to the chain, and the removal of an
+ * entry from the chain.
+ */
+
+static inline void
+InitChainTable(
+ Dict *dict)
+{
+ Tcl_InitCustomHashTable(&dict->table, TCL_CUSTOM_PTR_KEYS,
+ &chainHashType);
+ dict->entryChainHead = dict->entryChainTail = NULL;
+}
+
+static inline void
+DeleteChainTable(
+ Dict *dict)
+{
+ ChainEntry *cPtr;
+
+ for (cPtr=dict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
+ Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+
+ TclDecrRefCount(valuePtr);
+ }
+ Tcl_DeleteHashTable(&dict->table);
+}
+
+static inline Tcl_HashEntry *
+CreateChainEntry(
+ Dict *dict,
+ Tcl_Obj *keyPtr,
+ int *newPtr)
+{
+ ChainEntry *cPtr = (ChainEntry *)
+ Tcl_CreateHashEntry(&dict->table, (char *) keyPtr, newPtr);
+
+ /*
+ * If this is a new entry in the hash table, stitch it into the chain.
+ */
+
+ if (*newPtr) {
+ cPtr->nextPtr = NULL;
+ if (dict->entryChainHead == NULL) {
+ cPtr->prevPtr = NULL;
+ dict->entryChainHead = cPtr;
+ dict->entryChainTail = cPtr;
+ } else {
+ cPtr->prevPtr = dict->entryChainTail;
+ dict->entryChainTail->nextPtr = cPtr;
+ dict->entryChainTail = cPtr;
+ }
+ }
+
+ return &cPtr->entry;
+}
+
+static inline int
+DeleteChainEntry(
+ Dict *dict,
+ Tcl_Obj *keyPtr)
+{
+ ChainEntry *cPtr = (ChainEntry *)
+ Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
+
+ if (cPtr == NULL) {
+ return 0;
+ } else {
+ Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+ TclDecrRefCount(valuePtr);
+ }
+
+ /*
+ * Unstitch from the chain.
+ */
+
+ if (cPtr->nextPtr) {
+ cPtr->nextPtr->prevPtr = cPtr->prevPtr;
+ } else {
+ dict->entryChainTail = cPtr->prevPtr;
+ }
+ if (cPtr->prevPtr) {
+ cPtr->prevPtr->nextPtr = cPtr->nextPtr;
+ } else {
+ dict->entryChainHead = cPtr->nextPtr;
+ }
+
+ Tcl_DeleteHashEntry(&cPtr->entry);
+ return 1;
+}
/*
*----------------------------------------------------------------------
@@ -133,29 +305,33 @@ DupDictInternalRep(
Tcl_Obj *srcPtr,
Tcl_Obj *copyPtr)
{
- Dict *oldDict = (Dict *) srcPtr->internalRep.otherValuePtr;
+ Dict *oldDict = srcPtr->internalRep.otherValuePtr;
Dict *newDict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_HashEntry *hPtr, *newHPtr;
- Tcl_HashSearch search;
- Tcl_Obj *keyPtr, *valuePtr;
- int isNew;
+ ChainEntry *cPtr;
/*
* Copy values across from the old hash table.
*/
- Tcl_InitObjHashTable(&newDict->table);
- for (hPtr=Tcl_FirstHashEntry(&oldDict->table,&search); hPtr!=NULL;
- hPtr=Tcl_NextHashEntry(&search)) {
- keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&oldDict->table, hPtr);
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- newHPtr = Tcl_CreateHashEntry(&newDict->table, (char *)keyPtr, &isNew);
- Tcl_SetHashValue(newHPtr, (ClientData)valuePtr);
+
+ InitChainTable(newDict);
+ for (cPtr=oldDict->entryChainHead ; cPtr!=NULL ; cPtr=cPtr->nextPtr) {
+ void *key = Tcl_GetHashKey(&oldDict->table, &cPtr->entry);
+ Tcl_Obj *valuePtr = Tcl_GetHashValue(&cPtr->entry);
+ int n;
+ Tcl_HashEntry *hPtr = CreateChainEntry(newDict, key, &n);
+
+ /*
+ * Fill in the contents.
+ */
+
+ Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
Tcl_IncrRefCount(valuePtr);
}
/*
* Initialise other fields.
*/
+
newDict->epoch = 0;
newDict->chain = NULL;
newDict->refcount = 1;
@@ -163,7 +339,8 @@ DupDictInternalRep(
/*
* Store in the object.
*/
- copyPtr->internalRep.otherValuePtr = (void *) newDict;
+
+ copyPtr->internalRep.otherValuePtr = newDict;
copyPtr->typePtr = &tclDictType;
}
@@ -189,7 +366,7 @@ static void
FreeDictInternalRep(
Tcl_Obj *dictPtr)
{
- Dict *dict = (Dict *) dictPtr->internalRep.otherValuePtr;
+ Dict *dict = dictPtr->internalRep.otherValuePtr;
--dict->refcount;
if (dict->refcount <= 0) {
@@ -223,22 +400,7 @@ static void
DeleteDict(
Dict *dict)
{
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
- Tcl_Obj *valuePtr;
-
- /*
- * Delete the values ourselves, because hashes know nothing about their
- * contents (but do know about the key type, so that doesn't need explicit
- * attention.)
- */
-
- for (hPtr=Tcl_FirstHashEntry(&dict->table,&search); hPtr!=NULL;
- hPtr=Tcl_NextHashEntry(&search)) {
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- TclDecrRefCount(valuePtr);
- }
- Tcl_DeleteHashTable(&dict->table);
+ DeleteChainTable(dict);
ckfree((char *) dict);
}
@@ -270,9 +432,8 @@ UpdateStringOfDict(
{
#define LOCAL_SIZE 20
int localFlags[LOCAL_SIZE], *flagPtr;
- Dict *dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
+ Dict *dict = dictPtr->internalRep.otherValuePtr;
+ ChainEntry *cPtr;
Tcl_Obj *keyPtr, *valuePtr;
int numElems, i, length;
char *elem, *dst;
@@ -294,19 +455,18 @@ UpdateStringOfDict(
flagPtr = (int *) ckalloc((unsigned) numElems*sizeof(int));
}
dictPtr->length = 1;
- for (i=0,hPtr=Tcl_FirstHashEntry(&dict->table,&search) ; i<numElems ;
- i+=2,hPtr=Tcl_NextHashEntry(&search)) {
+ for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
/*
- * Assume that hPtr is never NULL since we know the number of array
+ * Assume that cPtr is never NULL since we know the number of array
* elements already.
*/
- keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);
+ keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
dictPtr->length += Tcl_ScanCountedElement(elem, length,
&flagPtr[i]) + 1;
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ valuePtr = Tcl_GetHashValue(&cPtr->entry);
elem = TclGetStringFromObj(valuePtr, &length);
dictPtr->length += Tcl_ScanCountedElement(elem, length,
&flagPtr[i+1]) + 1;
@@ -318,15 +478,14 @@ UpdateStringOfDict(
dictPtr->bytes = ckalloc((unsigned) dictPtr->length);
dst = dictPtr->bytes;
- for (i=0,hPtr=Tcl_FirstHashEntry(&dict->table,&search) ; i<numElems ;
- i+=2,hPtr=Tcl_NextHashEntry(&search)) {
- keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);
+ for (i=0,cPtr=dict->entryChainHead; i<numElems; i+=2,cPtr=cPtr->nextPtr) {
+ keyPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, &cPtr->entry);
elem = TclGetStringFromObj(keyPtr, &length);
dst += Tcl_ConvertCountedElement(elem, length, dst,
- flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH) );
+ flagPtr[i] | (i==0 ? 0 : TCL_DONT_QUOTE_HASH));
*(dst++) = ' ';
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ valuePtr = Tcl_GetHashValue(&cPtr->entry);
elem = TclGetStringFromObj(valuePtr, &length);
dst += Tcl_ConvertCountedElement(elem, length, dst,
flagPtr[i+1] | TCL_DONT_QUOTE_HASH);
@@ -369,14 +528,13 @@ SetDictFromAny(
Tcl_Obj *objPtr)
{
char *string, *s;
- CONST char *elemStart, *nextElem;
+ const char *elemStart, *nextElem;
int lenRemain, length, elemSize, hasBrace, result, isNew;
char *limit; /* Points just after string's last byte. */
- register CONST char *p;
+ register const char *p;
register Tcl_Obj *keyPtr, *valuePtr;
Dict *dict;
Tcl_HashEntry *hPtr;
- Tcl_HashSearch search;
/*
* Since lists and dictionaries have very closely-related string
@@ -411,20 +569,22 @@ SetDictFromAny(
/*
* Build the hash of key/value pairs.
*/
+
dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
+ InitChainTable(dict);
for (i=0 ; i<objc ; i+=2) {
/*
* Store key and value in the hash table we're building.
*/
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)objv[i], &isNew);
+ hPtr = CreateChainEntry(dict, objv[i], &isNew);
if (!isNew) {
- Tcl_Obj *discardedValue = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
+
TclDecrRefCount(discardedValue);
}
- Tcl_SetHashValue(hPtr, (ClientData) objv[i+1]);
- Tcl_IncrRefCount(objv[i+1]); /* since hash now holds ref to it */
+ Tcl_SetHashValue(hPtr, objv[i+1]);
+ Tcl_IncrRefCount(objv[i+1]); /* Since hash now holds ref to it */
}
/*
@@ -447,7 +607,7 @@ SetDictFromAny(
*/
dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
+ InitChainTable(dict);
for (p = string, lenRemain = length;
lenRemain > 0;
p = nextElem, lenRemain = (limit - nextElem)) {
@@ -514,17 +674,18 @@ SetDictFromAny(
* Store key and value in the hash table we're building.
*/
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyPtr, &isNew);
+ hPtr = CreateChainEntry(dict, keyPtr, &isNew);
if (!isNew) {
- Tcl_Obj *discardedValue = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *discardedValue = Tcl_GetHashValue(hPtr);
+
TclDecrRefCount(keyPtr);
TclDecrRefCount(discardedValue);
}
- Tcl_SetHashValue(hPtr, (ClientData) valuePtr);
+ Tcl_SetHashValue(hPtr, valuePtr);
Tcl_IncrRefCount(valuePtr); /* since hash now holds ref to it */
}
- installHash:
+ installHash:
/*
* Free the old internalRep before setting the new one. We do this as late
* as possible to allow the conversion code, in particular
@@ -535,24 +696,19 @@ SetDictFromAny(
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- objPtr->internalRep.otherValuePtr = (void *) dict;
+ objPtr->internalRep.otherValuePtr = dict;
objPtr->typePtr = &tclDictType;
return TCL_OK;
- missingKey:
+ missingKey:
if (interp != NULL) {
Tcl_SetResult(interp, "missing value to go with key", TCL_STATIC);
}
TclDecrRefCount(keyPtr);
result = TCL_ERROR;
- errorExit:
- for (hPtr=Tcl_FirstHashEntry(&dict->table,&search);
- hPtr!=NULL ; hPtr=Tcl_NextHashEntry(&search)) {
- valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- TclDecrRefCount(valuePtr);
- }
- Tcl_DeleteHashTable(&dict->table);
+ errorExit:
+ DeleteChainTable(dict);
ckfree((char *) dict);
return result;
}
@@ -594,7 +750,7 @@ TclTraceDictPath(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
int keyc,
- Tcl_Obj *CONST keyv[],
+ Tcl_Obj *const keyv[],
int flags)
{
Dict *dict, *newDict;
@@ -605,7 +761,7 @@ TclTraceDictPath(
return NULL;
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.otherValuePtr;
if (flags & DICT_PATH_UPDATE) {
dict->chain = NULL;
}
@@ -616,6 +772,7 @@ TclTraceDictPath(
if (hPtr == NULL) {
int isNew; /* Dummy */
+
if (flags & DICT_PATH_EXISTS) {
return DICT_PATH_NON_EXISTENT;
}
@@ -633,12 +790,13 @@ TclTraceDictPath(
/*
* The next line should always set isNew to 1.
*/
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyv[i], &isNew);
+
+ hPtr = CreateChainEntry(dict, keyv[i], &isNew);
tmpObj = Tcl_NewDictObj();
Tcl_IncrRefCount(tmpObj);
- Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
+ Tcl_SetHashValue(hPtr, tmpObj);
} else {
- tmpObj = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ tmpObj = Tcl_GetHashValue(hPtr);
if (tmpObj->typePtr != &tclDictType) {
if (SetDictFromAny(interp, tmpObj) != TCL_OK) {
return NULL;
@@ -646,7 +804,7 @@ TclTraceDictPath(
}
}
- newDict = (Dict *) tmpObj->internalRep.otherValuePtr;
+ newDict = tmpObj->internalRep.otherValuePtr;
if (flags & DICT_PATH_UPDATE) {
if (Tcl_IsShared(tmpObj)) {
TclDecrRefCount(tmpObj);
@@ -654,7 +812,7 @@ TclTraceDictPath(
Tcl_IncrRefCount(tmpObj);
Tcl_SetHashValue(hPtr, (ClientData) tmpObj);
dict->epoch++;
- newDict = (Dict *) tmpObj->internalRep.otherValuePtr;
+ newDict = tmpObj->internalRep.otherValuePtr;
}
newDict->chain = dictPtr;
@@ -689,7 +847,7 @@ static void
InvalidateDictChain(
Tcl_Obj *dictObj)
{
- Dict *dict = (Dict *) dictObj->internalRep.otherValuePtr;
+ Dict *dict = dictObj->internalRep.otherValuePtr;
do {
Tcl_InvalidateStringRep(dictObj);
@@ -699,7 +857,7 @@ InvalidateDictChain(
break;
}
dict->chain = NULL;
- dict = (Dict *) dictObj->internalRep.otherValuePtr;
+ dict = dictObj->internalRep.otherValuePtr;
} while (dict != NULL);
}
@@ -739,6 +897,7 @@ Tcl_DictObjPut(
if (dictPtr->typePtr != &tclDictType) {
int result = SetDictFromAny(interp, dictPtr);
+
if (result != TCL_OK) {
return result;
}
@@ -747,11 +906,12 @@ Tcl_DictObjPut(
if (dictPtr->bytes != NULL) {
Tcl_InvalidateStringRep(dictPtr);
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyPtr, &isNew);
+ dict = dictPtr->internalRep.otherValuePtr;
+ hPtr = CreateChainEntry(dict, keyPtr, &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
- Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
+
TclDecrRefCount(oldValuePtr);
}
Tcl_SetHashValue(hPtr, valuePtr);
@@ -796,12 +956,12 @@ Tcl_DictObjGet(
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyPtr);
+ dict = dictPtr->internalRep.otherValuePtr;
+ hPtr = Tcl_FindHashEntry(&dict->table, (char *) keyPtr);
if (hPtr == NULL) {
*valuePtrPtr = NULL;
} else {
- *valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ *valuePtrPtr = Tcl_GetHashValue(hPtr);
}
return TCL_OK;
}
@@ -832,7 +992,6 @@ Tcl_DictObjRemove(
Tcl_Obj *keyPtr)
{
Dict *dict;
- Tcl_HashEntry *hPtr;
if (Tcl_IsShared(dictPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_DictObjRemove");
@@ -848,13 +1007,8 @@ Tcl_DictObjRemove(
if (dictPtr->bytes != NULL) {
Tcl_InvalidateStringRep(dictPtr);
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyPtr);
- if (hPtr != NULL) {
- Tcl_Obj *valuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
-
- TclDecrRefCount(valuePtr);
- Tcl_DeleteHashEntry(hPtr);
+ dict = dictPtr->internalRep.otherValuePtr;
+ if (DeleteChainEntry(dict, keyPtr)) {
dict->epoch++;
}
return TCL_OK;
@@ -893,7 +1047,7 @@ Tcl_DictObjSize(
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.otherValuePtr;
*sizePtr = dict->table.numEntries;
return TCL_OK;
}
@@ -938,30 +1092,33 @@ Tcl_DictObjFirst(
* otherwise. */
{
Dict *dict;
- Tcl_HashEntry *hPtr;
+ ChainEntry *cPtr;
if (dictPtr->typePtr != &tclDictType) {
int result = SetDictFromAny(interp, dictPtr);
+
if (result != TCL_OK) {
return result;
}
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FirstHashEntry(&dict->table, &searchPtr->search);
- if (hPtr == NULL) {
+ dict = dictPtr->internalRep.otherValuePtr;
+ cPtr = dict->entryChainHead;
+ if (cPtr == NULL) {
searchPtr->epoch = -1;
*donePtr = 1;
} else {
*donePtr = 0;
searchPtr->dictionaryPtr = (Tcl_Dict) dict;
searchPtr->epoch = dict->epoch;
+ searchPtr->next = cPtr->nextPtr;
dict->refcount++;
if (keyPtrPtr != NULL) {
- *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table, hPtr);
+ *keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(&dict->table,
+ &cPtr->entry);
}
if (valuePtrPtr != NULL) {
- *valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
}
}
return TCL_OK;
@@ -1004,7 +1161,7 @@ Tcl_DictObjNext(
* values in the dictionary, or a 0
* otherwise. */
{
- Tcl_HashEntry *hPtr;
+ ChainEntry *cPtr;
/*
* If the searh is done; we do no work.
@@ -1024,20 +1181,21 @@ Tcl_DictObjNext(
Tcl_Panic("concurrent dictionary modification and search");
}
- hPtr = Tcl_NextHashEntry(&searchPtr->search);
- if (hPtr == NULL) {
+ cPtr = searchPtr->next;
+ if (cPtr == NULL) {
Tcl_DictObjDone(searchPtr);
*donePtr = 1;
return;
}
+ searchPtr->next = cPtr->nextPtr;
*donePtr = 0;
if (keyPtrPtr != NULL) {
*keyPtrPtr = (Tcl_Obj *) Tcl_GetHashKey(
- &((Dict *)searchPtr->dictionaryPtr)->table, hPtr);
+ &((Dict *)searchPtr->dictionaryPtr)->table, &cPtr->entry);
}
if (valuePtrPtr != NULL) {
- *valuePtrPtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ *valuePtrPtr = Tcl_GetHashValue(&cPtr->entry);
}
}
@@ -1101,7 +1259,7 @@ Tcl_DictObjPutKeyList(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
int keyc,
- Tcl_Obj *CONST keyv[],
+ Tcl_Obj *const keyv[],
Tcl_Obj *valuePtr)
{
Dict *dict;
@@ -1120,11 +1278,11 @@ Tcl_DictObjPutKeyList(
return TCL_ERROR;
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_CreateHashEntry(&dict->table, (char *)keyv[keyc-1], &isNew);
+ dict = dictPtr->internalRep.otherValuePtr;
+ hPtr = CreateChainEntry(dict, keyv[keyc-1], &isNew);
Tcl_IncrRefCount(valuePtr);
if (!isNew) {
- Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
+ Tcl_Obj *oldValuePtr = Tcl_GetHashValue(hPtr);
TclDecrRefCount(oldValuePtr);
}
Tcl_SetHashValue(hPtr, valuePtr);
@@ -1160,10 +1318,9 @@ Tcl_DictObjRemoveKeyList(
Tcl_Interp *interp,
Tcl_Obj *dictPtr,
int keyc,
- Tcl_Obj *CONST keyv[])
+ Tcl_Obj *const keyv[])
{
Dict *dict;
- Tcl_HashEntry *hPtr;
if (Tcl_IsShared(dictPtr)) {
Tcl_Panic("%s called with shared object", "Tcl_DictObjRemoveKeyList");
@@ -1177,13 +1334,8 @@ Tcl_DictObjRemoveKeyList(
return TCL_ERROR;
}
- dict = (Dict *) dictPtr->internalRep.otherValuePtr;
- hPtr = Tcl_FindHashEntry(&dict->table, (char *)keyv[keyc-1]);
- if (hPtr != NULL) {
- Tcl_Obj *oldValuePtr = (Tcl_Obj *) Tcl_GetHashValue(hPtr);
- TclDecrRefCount(oldValuePtr);
- Tcl_DeleteHashEntry(hPtr);
- }
+ dict = dictPtr->internalRep.otherValuePtr;
+ DeleteChainEntry(dict, keyv[keyc-1]);
InvalidateDictChain(dictPtr);
return TCL_OK;
}
@@ -1224,11 +1376,11 @@ Tcl_NewDictObj(void)
TclNewObj(dictPtr);
Tcl_InvalidateStringRep(dictPtr);
dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
+ InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = (void *) dict;
+ dictPtr->internalRep.otherValuePtr = dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#endif
@@ -1263,7 +1415,7 @@ Tcl_NewDictObj(void)
Tcl_Obj *
Tcl_DbNewDictObj(
- CONST char *file,
+ const char *file,
int line)
{
#ifdef TCL_MEM_DEBUG
@@ -1273,11 +1425,11 @@ Tcl_DbNewDictObj(
TclDbNewObj(dictPtr, file, line);
Tcl_InvalidateStringRep(dictPtr);
dict = (Dict *) ckalloc(sizeof(Dict));
- Tcl_InitObjHashTable(&dict->table);
+ InitChainTable(dict);
dict->epoch = 0;
dict->chain = NULL;
dict->refcount = 1;
- dictPtr->internalRep.otherValuePtr = (void *) dict;
+ dictPtr->internalRep.otherValuePtr = dict;
dictPtr->typePtr = &tclDictType;
return dictPtr;
#else /* !TCL_MEM_DEBUG */
@@ -1309,7 +1461,7 @@ static int
DictCreateCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictObj;
int i;
@@ -1358,7 +1510,7 @@ static int
DictGetCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr = NULL;
int result;
@@ -1448,7 +1600,7 @@ static int
DictReplaceCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
int i, result;
@@ -1499,7 +1651,7 @@ static int
DictRemoveCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
int i, result;
@@ -1550,7 +1702,7 @@ static int
DictMergeCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *targetObj, *keyObj, *valueObj;
int allocatedDict = 0;
@@ -1635,7 +1787,7 @@ static int
DictKeysCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *listPtr;
char *pattern = NULL;
@@ -1716,7 +1868,7 @@ static int
DictValuesCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *valuePtr, *listPtr;
Tcl_DictSearch search;
@@ -1772,7 +1924,7 @@ static int
DictSizeCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
int result, size;
@@ -1809,7 +1961,7 @@ static int
DictExistsCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr;
int result;
@@ -1858,7 +2010,7 @@ static int
DictInfoCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr;
Dict *dict;
@@ -1875,12 +2027,13 @@ DictInfoCmd(
return result;
}
}
- dict = (Dict *)dictPtr->internalRep.otherValuePtr;
+ dict = dictPtr->internalRep.otherValuePtr;
+
/*
* This next cast is actually OK.
*/
- Tcl_SetResult(interp, (char *)Tcl_HashStats(&dict->table), TCL_DYNAMIC);
+ Tcl_SetResult(interp, (char *) Tcl_HashStats(&dict->table), TCL_DYNAMIC);
return TCL_OK;
}
@@ -1906,7 +2059,7 @@ static int
DictIncrCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
int code = TCL_OK;
Tcl_Obj *dictPtr, *valuePtr = NULL;
@@ -2018,7 +2171,7 @@ static int
DictLappendCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int i, allocatedDict = 0, allocatedValue = 0;
@@ -2104,7 +2257,7 @@ static int
DictAppendCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *valuePtr, *resultPtr;
int i, allocatedDict = 0;
@@ -2175,7 +2328,7 @@ static int
DictForCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Interp* iPtr = (Interp*) interp;
Tcl_Obj *scriptObj, *keyVarObj, *valueVarObj;
@@ -2299,7 +2452,7 @@ static int
DictSetCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
@@ -2358,7 +2511,7 @@ static int
DictUnsetCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *resultPtr;
int result, allocatedDict = 0;
@@ -2416,10 +2569,10 @@ static int
DictFilterCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Interp* iPtr = (Interp*) interp;
- static CONST char *filters[] = {
+ static const char *filters[] = {
"key", "script", "value", NULL
};
enum FilterTypes {
@@ -2675,7 +2828,7 @@ static int
DictUpdateCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Tcl_Obj *dictPtr, *objPtr;
int i, result, dummy;
@@ -2801,7 +2954,7 @@ static int
DictWithCmd(
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
Interp* iPtr = (Interp*) interp;
Tcl_Obj *dictPtr, *keysPtr, *keyPtr, *valPtr, **keyv, *leafPtr;
@@ -2988,9 +3141,9 @@ Tcl_DictObjCmd(
/*ignored*/ ClientData clientData,
Tcl_Interp *interp,
int objc,
- Tcl_Obj *CONST *objv)
+ Tcl_Obj *const *objv)
{
- static CONST char *subcommands[] = {
+ static const char *subcommands[] = {
"append", "create", "exists", "filter", "for",
"get", "incr", "info", "keys", "lappend", "merge",
"remove", "replace", "set", "size", "unset",
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b40786c..479232b 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclInt.h,v 1.348 2007/11/18 21:59:25 dkf Exp $
+ * RCS: @(#) $Id: tclInt.h,v 1.349 2007/11/20 20:43:12 dkf Exp $
*/
#ifndef _TCLINT
@@ -3195,6 +3195,14 @@ MODULE_SCOPE int TclObjCallVarTraces(Interp *iPtr, Var *arrayPtr,
int flags, int leaveErrMsg, int index);
/*
+ * So tclObj.c and tclDictObj.c can share these implementations.
+ */
+
+MODULE_SCOPE int TclCompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
+MODULE_SCOPE void TclFreeObjEntry(Tcl_HashEntry *hPtr);
+MODULE_SCOPE unsigned TclHashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
+
+/*
*----------------------------------------------------------------
* Macros used by the Tcl core to create and release Tcl objects.
* TclNewObj(objPtr) creates a new object denoting an empty string.
diff --git a/generic/tclObj.c b/generic/tclObj.c
index f44f3af..91b3f35 100644
--- a/generic/tclObj.c
+++ b/generic/tclObj.c
@@ -13,7 +13,7 @@
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
- * RCS: @(#) $Id: tclObj.c,v 1.137 2007/11/11 19:32:16 msofer Exp $
+ * RCS: @(#) $Id: tclObj.c,v 1.138 2007/11/20 20:43:12 dkf Exp $
*/
#include "tclInt.h"
@@ -188,9 +188,6 @@ static int GetBignumFromObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
*/
static Tcl_HashEntry * AllocObjEntry(Tcl_HashTable *tablePtr, void *keyPtr);
-static int CompareObjKeys(void *keyPtr, Tcl_HashEntry *hPtr);
-static void FreeObjEntry(Tcl_HashEntry *hPtr);
-static unsigned int HashObjKey(Tcl_HashTable *tablePtr, void *keyPtr);
/*
* Prototypes for the CommandName object type.
@@ -258,12 +255,12 @@ Tcl_ObjType tclBignumType = {
*/
Tcl_HashKeyType tclObjHashKeyType = {
- TCL_HASH_KEY_TYPE_VERSION, /* version */
- 0, /* flags */
- HashObjKey, /* hashKeyProc */
- CompareObjKeys, /* compareKeysProc */
- AllocObjEntry, /* allocEntryProc */
- FreeObjEntry /* freeEntryProc */
+ TCL_HASH_KEY_TYPE_VERSION, /* version */
+ 0, /* flags */
+ TclHashObjKey, /* hashKeyProc */
+ TclCompareObjKeys, /* compareKeysProc */
+ AllocObjEntry, /* allocEntryProc */
+ TclFreeObjEntry /* freeEntryProc */
};
/*
@@ -3325,14 +3322,14 @@ AllocObjEntry(
hPtr->key.oneWordValue = (char *) objPtr;
Tcl_IncrRefCount(objPtr);
hPtr->clientData = NULL;
-
+
return hPtr;
}
/*
*----------------------------------------------------------------------
*
- * CompareObjKeys --
+ * TclCompareObjKeys --
*
* Compares two Tcl_Obj * keys.
*
@@ -3346,8 +3343,8 @@ AllocObjEntry(
*----------------------------------------------------------------------
*/
-static int
-CompareObjKeys(
+int
+TclCompareObjKeys(
void *keyPtr, /* New key to compare. */
Tcl_HashEntry *hPtr) /* Existing key to compare. */
{
@@ -3395,7 +3392,7 @@ CompareObjKeys(
/*
*----------------------------------------------------------------------
*
- * FreeObjEntry --
+ * TclFreeObjEntry --
*
* Frees space for a Tcl_HashEntry containing the Tcl_Obj * key.
*
@@ -3408,8 +3405,8 @@ CompareObjKeys(
*----------------------------------------------------------------------
*/
-static void
-FreeObjEntry(
+void
+TclFreeObjEntry(
Tcl_HashEntry *hPtr) /* Hash entry to free. */
{
Tcl_Obj *objPtr = (Tcl_Obj *) hPtr->key.oneWordValue;
@@ -3421,7 +3418,7 @@ FreeObjEntry(
/*
*----------------------------------------------------------------------
*
- * HashObjKey --
+ * TclHashObjKey --
*
* Compute a one-word summary of the string representation of the
* Tcl_Obj, which can be used to generate a hash index.
@@ -3436,8 +3433,8 @@ FreeObjEntry(
*----------------------------------------------------------------------
*/
-static unsigned int
-HashObjKey(
+unsigned int
+TclHashObjKey(
Tcl_HashTable *tablePtr, /* Hash table. */
void *keyPtr) /* Key from which to compute hash value. */
{