Subject: Request Tcl 8.4a1 Enhance Tcl hash table with Tcl_Obj* keys - DN [1]
pduffin@hursley.ibm.com - 22 Jun 2000 - comp.lang.tcl
Tcl 8.4a1 Request: Generated by Ajuba's bug entry form at
http://www.ajubasolutions.com/support/bugForm.html
Responses to this post are encouraged.
------
Submitted by: Paul Duffin
OperatingSystem: All
Synopsis: Enhance Tcl hash table with Tcl_Obj* keys
DesiredBehavior:
The Tcl hash table allows strings, single words and multiple words as keys but not Tcl_Obj*. Tcl_Obj* have a number of advantages when used as a key because they do not have to be copied like string keys, comparisons can be speeded up by first comparing the Tcl_Obj * pointers and only if they are not the same do you have to check the lengths and only if they are the same do you have to compare the contents.
Patch:
Index: tcl/generic/tcl.h
diff -c tcl/generic/tcl.h:1.70 tcl/generic/tcl.h:1.71
*** tcl/generic/tcl.h:1.70 Tue May 16 02:27:03 2000
--- tcl/generic/tcl.h Tue May 16 02:30:01 2000
***************
*** 12,18 ****
* 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.70 2000/05/16 01:27:03 pduffin Exp $
*/
#ifndef _TCL
--- 12,18 ----
* 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.71 2000/05/16 01:30:01 pduffin Exp $
*/
#ifndef _TCL
***************
*** 969,974 ****
--- 969,975 ----
* with Tcl_SetHashValue. */
union { /* Key has one of these forms: */
char *oneWordValue; /* One-word value for key. */
+ Tcl_Obj *objPtr; /* Tcl_Obj * key value. */
int words[1]; /* Multiple integer words for key.
* The actual size will be as large
* as necessary for this table's
***************
*** 1005,1014 ****
int mask; /* Mask value used in hashing
* function. */
int keyType; /* Type of keys used in this table.
! * It's either TCL_STRING_KEYS,
! * TCL_ONE_WORD_KEYS, or an integer
! * giving the number of ints that
! * is the size of the key.
*/
Tcl_HashEntry *(*findProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
CONST char *key));
--- 1006,1015 ----
int mask; /* Mask value used in hashing
* function. */
int keyType; /* Type of keys used in this table.
! * It's either TCL_OBJ_KEYS,
! * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
! * or an integer giving the number of
! * ints that is the size of the key.
*/
Tcl_HashEntry *(*findProc) _ANSI_ARGS_((struct Tcl_HashTable *tablePtr,
CONST char *key));
***************
*** 1033,1038 ****
--- 1034,1040 ----
* Acceptable key types for hash tables:
*/
+ #define TCL_OBJ_KEYS -1
#define TCL_STRING_KEYS 0
#define TCL_ONE_WORD_KEYS 1
***************
*** 1043,1050 ****
#define Tcl_GetHashValue(h) ((h)->clientData)
#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
#define Tcl_GetHashKey(tablePtr, h) \
! ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS) ? (h)->key.oneWordValue \
! : (h)->key.string))
/*
* Macros to use for clients to use to invoke find and create procedures
--- 1045,1054 ----
#define Tcl_GetHashValue(h) ((h)->clientData)
#define Tcl_SetHashValue(h, value) ((h)->clientData = (ClientData) (value))
#define Tcl_GetHashKey(tablePtr, h) \
! ((char *) (((tablePtr)->keyType == TCL_ONE_WORD_KEYS || \
! (tablePtr)->keyType == TCL_OBJ_KEYS) \
! ? (h)->key.oneWordValue \
! : (h)->key.string))
/*
* Macros to use for clients to use to invoke find and create procedures
Index: tcl/generic/tclHash.c
diff -c tcl/generic/tclHash.c:1.3 tcl/generic/tclHash.c:1.4
*** tcl/generic/tclHash.c:1.3 Tue May 16 02:26:38 2000
--- tcl/generic/tclHash.c Tue May 16 02:30:01 2000
***************
*** 10,16 ****
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
! * RCS: @(#) $Id: tclHash.c,v 1.3 2000/05/16 01:26:38 pduffin Exp $
*/
#include "tclInt.h"
--- 10,16 ----
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
! * RCS: @(#) $Id: tclHash.c,v 1.4 2000/05/16 01:30:01 pduffin Exp $
*/
#include "tclInt.h"
***************
*** 56,61 ****
--- 56,66 ----
CONST char *key));
static Tcl_HashEntry * OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
CONST char *key, int *newPtr));
+ static unsigned int HashObj _ANSI_ARGS_((Tcl_Obj *objPtr));
+ static Tcl_HashEntry * ObjFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+ CONST char *key));
+ static Tcl_HashEntry * ObjCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
+ CONST char *key, int *newPtr));
/*
*----------------------------------------------------------------------
***************
*** 97,103 ****
tablePtr->downShift = 28;
tablePtr->mask = 3;
tablePtr->keyType = keyType;
! if (keyType == TCL_STRING_KEYS) {
tablePtr->findProc = StringFind;
tablePtr->createProc = StringCreate;
} else if (keyType == TCL_ONE_WORD_KEYS) {
--- 102,111 ----
tablePtr->downShift = 28;
tablePtr->mask = 3;
tablePtr->keyType = keyType;
! if (keyType == TCL_OBJ_KEYS) {
! tablePtr->findProc = ObjFind;
! tablePtr->createProc = ObjCreate;
! } else if (keyType == TCL_STRING_KEYS) {
tablePtr->findProc = StringFind;
tablePtr->createProc = StringCreate;
} else if (keyType == TCL_ONE_WORD_KEYS) {
***************
*** 147,152 ****
--- 155,164 ----
}
}
}
+
+ if (entryPtr->tablePtr->keyType == TCL_OBJ_KEYS) {
+ Tcl_DecrRefCount (entryPtr->key.objPtr);
+ }
entryPtr->tablePtr->numEntries--;
ckfree((char *) entryPtr);
}
***************
*** 183,188 ****
--- 195,203 ----
hPtr = tablePtr->buckets[i];
while (hPtr != NULL) {
nextPtr = hPtr->nextPtr;
+ if (tablePtr->keyType == TCL_OBJ_KEYS) {
+ Tcl_DecrRefCount (hPtr->key.objPtr);
+ }
ckfree((char *) hPtr);
hPtr = nextPtr;
}
***************
*** 844,849 ****
--- 859,1092 ----
/*
*----------------------------------------------------------------------
*
+ * HashObj --
+ *
+ * Compute a one-word summary of the string representation of the
+ * Tcl_Obj, which can be used to generate a hash index.
+ *
+ * Results:
+ * The return value is a one-word summary of the information in
+ * the string representation of the Tcl_Obj.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ static unsigned int
+ HashObj(objPtr)
+ Tcl_Obj *objPtr;
+ {
+ register CONST char *string;
+ register int length;
+ register unsigned int result;
+ register int c;
+
+ string = Tcl_GetStringFromObj (objPtr, NULL);
+ length = objPtr->length;
+
+ /*
+ * I tried a zillion different hash functions and asked many other
+ * people for advice. Many people had their own favorite functions,
+ * all different, but no-one had much idea why they were good ones.
+ * I chose the one below (multiply by 9 and add new character)
+ * because of the following reasons:
+ *
+ * 1. Multiplying by 10 is perfect for keys that are decimal strings,
+ * and multiplying by 9 is just about as good.
+ * 2. Times-9 is (shift-left-3) plus (old). This means that each
+ * character's bits hang around in the low-order bits of the
+ * hash value for ever, plus they spread fairly rapidly up to
+ * the high-order bits to fill out the hash value. This seems
+ * works well both for decimal and non-decimal strings.
+ */
+
+ result = 0;
+ while (length) {
+ c = *string;
+ string++;
+ length--;
+ if (length == 0) {
+ break;
+ }
+ result += (result<<3) + c;
+ }
+ return result;
+ }
+
+ /*
+ *----------------------------------------------------------------------
+ *
+ * ObjFind --
+ *
+ * Given a hash table with string keys, and a string key, find
+ * the entry with a matching key.
+ *
+ * Results:
+ * The return value is a token for the matching entry in the
+ * hash table, or NULL if there was no matching entry.
+ *
+ * Side effects:
+ * None.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ static Tcl_HashEntry *
+ ObjFind(tablePtr, key)
+ Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
+ CONST char *key; /* Key to use to find matching entry. */
+ {
+ Tcl_Obj *objPtr = (Tcl_Obj *) key;
+ register Tcl_HashEntry *hPtr;
+ register CONST char *p1, *p2;
+ register int l1, l2;
+ int index;
+
+ index = HashObj(objPtr) & tablePtr->mask;
+
+ /*
+ * Search all of the entries in the appropriate bucket.
+ */
+
+ for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+ hPtr = hPtr->nextPtr) {
+ /*
+ * If the object pointers are the same then they match.
+ */
+ if (objPtr == hPtr->key.objPtr) {
+ return hPtr;
+ }
+
+ p1 = Tcl_GetStringFromObj (objPtr, (int *) 0);
+ l1 = objPtr->length;
+ p2 = Tcl_GetStringFromObj (hPtr->key.objPtr, (int *) 0);
+ l2 = hPtr->key.objPtr->length;
+
+ /*
+ * If the lengths are different then they do not match.
+ */
+ if (l1 != l2) {
+ continue;
+ }
+
+ for (;; p1++, p2++, l1--) {
+ if (*p1 != *p2) {
+ break;
+ }
+ if (l1 == 0) {
+ return hPtr;
+ }
+ }
+ }
+ return NULL;
+ }
+
+ /*
+ *----------------------------------------------------------------------
+ *
+ * ObjCreate --
+ *
+ * Given a hash table with string keys, and a string key, find
+ * the entry with a matching key. If there is no matching entry,
+ * then create a new entry that does match.
+ *
+ * Results:
+ * The return value is a pointer to the matching entry. If this
+ * is a newly-created entry, then *newPtr will be set to a non-zero
+ * value; otherwise *newPtr will be set to 0. If this is a new
+ * entry the value stored in the entry will initially be 0.
+ *
+ * Side effects:
+ * A new entry may be added to the hash table.
+ *
+ *----------------------------------------------------------------------
+ */
+
+ static Tcl_HashEntry *
+ ObjCreate(tablePtr, key, newPtr)
+ Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
+ CONST char *key; /* Key to use to find or create matching
+ * entry. */
+ int *newPtr; /* Store info here telling whether a new
+ * entry was created. */
+ {
+ Tcl_Obj *objPtr = (Tcl_Obj *) key;
+ register Tcl_HashEntry *hPtr;
+ register CONST char *p1, *p2;
+ register int l1, l2;
+ int index;
+
+ index = HashObj(objPtr) & tablePtr->mask;
+
+ /*
+ * Search all of the entries in this bucket.
+ */
+
+ for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
+ hPtr = hPtr->nextPtr) {
+ /*
+ * If the object pointers are the same then they match.
+ */
+ if (objPtr == hPtr->key.objPtr) {
+ *newPtr = 0;
+ return hPtr;
+ }
+
+ p1 = Tcl_GetStringFromObj (objPtr, (int *) 0);
+ l1 = objPtr->length;
+ p2 = Tcl_GetStringFromObj (hPtr->key.objPtr, (int *) 0);
+ l2 = hPtr->key.objPtr->length;
+
+ /*
+ * If the lengths are different then they do not match.
+ */
+ if (l1 != l2) {
+ continue;
+ }
+
+ for (;; p1++, p2++, l1--) {
+ if (*p1 != *p2) {
+ break;
+ }
+ if (l1 == 0) {
+ *newPtr = 0;
+ return hPtr;
+ }
+ }
+ }
+
+ /*
+ * Entry not found. Add a new one to the bucket.
+ */
+
+ *newPtr = 1;
+ hPtr = (Tcl_HashEntry *)
+ Tcl_Alloc((unsigned) sizeof(Tcl_HashEntry));
+ hPtr->tablePtr = tablePtr;
+ hPtr->bucketPtr = &(tablePtr->buckets[index]);
+ hPtr->nextPtr = *hPtr->bucketPtr;
+ hPtr->clientData = 0;
+ hPtr->key.objPtr = objPtr;
+ Tcl_IncrRefCount (objPtr);
+ *hPtr->bucketPtr = hPtr;
+ tablePtr->numEntries++;
+
+ /*
+ * If the table has exceeded a decent size, rebuild it with many
+ * more buckets.
+ */
+
+ if (tablePtr->numEntries >= tablePtr->rebuildSize) {
+ RebuildTable(tablePtr);
+ }
+ return hPtr;
+ }
+
+ /*
+ *----------------------------------------------------------------------
+ *
* RebuildTable --
*
* This procedure is invoked when the ratio of entries to hash
***************
*** 896,902 ****
for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
*oldChainPtr = hPtr->nextPtr;
! if (tablePtr->keyType == TCL_STRING_KEYS) {
index = HashString(hPtr->key.string) & tablePtr->mask;
} else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
--- 1139,1147 ----
for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
*oldChainPtr = hPtr->nextPtr;
! if (tablePtr->keyType == TCL_OBJ_KEYS) {
! index = HashObj(hPtr->key.objPtr) & tablePtr->mask;
! } else if (tablePtr->keyType == TCL_STRING_KEYS) {
index = HashString(hPtr->key.string) & tablePtr->mask;
} else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
PatchFiles:
tclHash.c tcl.h
Last modified
2000-07-20
2000-07-20
(195.108.246.52)
Note: you are looking at
the snapshot of an old wiki
- much of this information
is likely to be very outdated