diff options
Diffstat (limited to 'generic/tclHash.c')
| -rw-r--r-- | generic/tclHash.c | 1114 |
1 files changed, 652 insertions, 462 deletions
diff --git a/generic/tclHash.c b/generic/tclHash.c index 973c003..90be511 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -1,4 +1,4 @@ -/* +/* * tclHash.c -- * * Implementation of in-memory hash tables for Tcl and Tcl-based @@ -7,63 +7,150 @@ * Copyright (c) 1991-1993 The Regents of the University of California. * Copyright (c) 1994 Sun Microsystems, Inc. * - * 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 1999/04/16 00:46:46 stanton Exp $ + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" /* - * When there are this many entries per bucket, on average, rebuild - * the hash table to make it larger. + * Prevent macros from clashing with function definitions. */ -#define REBUILD_MULTIPLIER 3 +#undef Tcl_FindHashEntry +#undef Tcl_CreateHashEntry + +/* + * When there are this many entries per bucket, on average, rebuild the hash + * table to make it larger. + */ +#define REBUILD_MULTIPLIER 3 /* - * The following macro takes a preliminary integer hash value and - * produces an index into a hash tables bucket list. The idea is - * to make it so that preliminary values that are arbitrarily similar - * will end up in different buckets. The hash function was taken - * from a random-number generator. + * The following macro takes a preliminary integer hash value and produces an + * index into a hash tables bucket list. The idea is to make it so that + * preliminary values that are arbitrarily similar will end up in different + * buckets. The hash function was taken from a random-number generator. */ #define RANDOM_INDEX(tablePtr, i) \ - (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask) + ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask) + +/* + * Prototypes for the array hash key methods. + */ + +static Tcl_HashEntry * AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr); +static int CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr); +static unsigned int HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr); /* - * Procedure prototypes for static procedures in this file: + * Prototypes for the one word hash key methods. Not actually declared because + * this is a critical path that is implemented in the core hash table access + * function. */ -static Tcl_HashEntry * ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr, - CONST char *key)); -static Tcl_HashEntry * ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr, - CONST char *key, int *newPtr)); -static Tcl_HashEntry * BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr, - CONST char *key)); -static Tcl_HashEntry * BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr, - CONST char *key, int *newPtr)); -static unsigned int HashString _ANSI_ARGS_((CONST char *string)); -static void RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr)); -static Tcl_HashEntry * StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr, - CONST char *key)); -static Tcl_HashEntry * StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr, - CONST char *key, int *newPtr)); -static Tcl_HashEntry * OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr, - CONST char *key)); -static Tcl_HashEntry * OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr, - CONST char *key, int *newPtr)); +#if 0 +static Tcl_HashEntry * AllocOneWordEntry(Tcl_HashTable *tablePtr, + void *keyPtr); +static int CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr); +static unsigned int HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr); +#endif + +/* + * Prototypes for the string hash key methods. + */ + +static Tcl_HashEntry * AllocStringEntry(Tcl_HashTable *tablePtr, + void *keyPtr); +static int CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr); +static unsigned int HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr); + +/* + * Function prototypes for static functions in this file: + */ + +static Tcl_HashEntry * BogusFind(Tcl_HashTable *tablePtr, const char *key); +static Tcl_HashEntry * BogusCreate(Tcl_HashTable *tablePtr, const char *key, + int *newPtr); +static Tcl_HashEntry * CreateHashEntry(Tcl_HashTable *tablePtr, const char *key, + int *newPtr); +static Tcl_HashEntry * FindHashEntry(Tcl_HashTable *tablePtr, const char *key); +static void RebuildTable(Tcl_HashTable *tablePtr); + +const Tcl_HashKeyType tclArrayHashKeyType = { + TCL_HASH_KEY_TYPE_VERSION, /* version */ + TCL_HASH_KEY_RANDOMIZE_HASH, /* flags */ + HashArrayKey, /* hashKeyProc */ + CompareArrayKeys, /* compareKeysProc */ + AllocArrayEntry, /* allocEntryProc */ + NULL /* freeEntryProc */ +}; + +const Tcl_HashKeyType tclOneWordHashKeyType = { + TCL_HASH_KEY_TYPE_VERSION, /* version */ + 0, /* flags */ + NULL, /* HashOneWordKey, */ /* hashProc */ + NULL, /* CompareOneWordKey, */ /* compareProc */ + NULL, /* AllocOneWordKey, */ /* allocEntryProc */ + NULL /* FreeOneWordKey, */ /* freeEntryProc */ +}; + +const Tcl_HashKeyType tclStringHashKeyType = { + TCL_HASH_KEY_TYPE_VERSION, /* version */ + 0, /* flags */ + HashStringKey, /* hashKeyProc */ + CompareStringKeys, /* compareKeysProc */ + AllocStringEntry, /* allocEntryProc */ + NULL /* freeEntryProc */ +}; /* *---------------------------------------------------------------------- * * Tcl_InitHashTable -- * - * Given storage for a hash table, set up the fields to prepare - * the hash table for use. + * Given storage for a hash table, set up the fields to prepare the hash + * table for use. + * + * Results: + * None. + * + * Side effects: + * TablePtr is now ready to be passed to Tcl_FindHashEntry and + * Tcl_CreateHashEntry. + * + *---------------------------------------------------------------------- + */ + +void +Tcl_InitHashTable( + register Tcl_HashTable *tablePtr, + /* Pointer to table record, which is supplied + * by the caller. */ + int keyType) /* Type of keys to use in table: + * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an + * integer >= 2. */ +{ + /* + * Use a special value to inform the extended version that it must not + * access any of the new fields in the Tcl_HashTable. If an extension is + * rebuilt then any calls to this function will be redirected to the + * extended version by a macro. + */ + + Tcl_InitCustomHashTable(tablePtr, keyType, (const Tcl_HashKeyType *) -1); +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_InitCustomHashTable -- + * + * Given storage for a hash table, set up the fields to prepare the hash + * table for use. This is an extended version of Tcl_InitHashTable which + * supports user defined keys. * * Results: * None. @@ -76,18 +163,22 @@ static Tcl_HashEntry * OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr, */ void -Tcl_InitHashTable(tablePtr, keyType) - register Tcl_HashTable *tablePtr; /* Pointer to table record, which - * is supplied by the caller. */ - int keyType; /* Type of keys to use in table: - * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, - * or an integer >= 2. */ +Tcl_InitCustomHashTable( + register Tcl_HashTable *tablePtr, + /* Pointer to table record, which is supplied + * by the caller. */ + int keyType, /* Type of keys to use in table: + * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, + * TCL_CUSTOM_TYPE_KEYS, TCL_CUSTOM_PTR_KEYS, + * or an integer >= 2. */ + const Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the + * behaviour of this table. */ { -#if (TCL_SMALL_HASH_TABLE != 4) - panic("Tcl_InitHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n", +#if (TCL_SMALL_HASH_TABLE != 4) + Tcl_Panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4", TCL_SMALL_HASH_TABLE); #endif - + tablePtr->buckets = tablePtr->staticBuckets; tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0; tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0; @@ -97,16 +188,206 @@ Tcl_InitHashTable(tablePtr, keyType) 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) { - tablePtr->findProc = OneWordFind; - tablePtr->createProc = OneWordCreate; + tablePtr->findProc = FindHashEntry; + tablePtr->createProc = CreateHashEntry; + + if (typePtr == NULL) { + /* + * The caller has been rebuilt so the hash table is an extended + * version. + */ + } else if (typePtr != (Tcl_HashKeyType *) -1) { + /* + * The caller is requesting a customized hash table so it must be an + * extended version. + */ + + tablePtr->typePtr = typePtr; } else { - tablePtr->findProc = ArrayFind; - tablePtr->createProc = ArrayCreate; - }; + /* + * The caller has not been rebuilt so the hash table is not extended. + */ + } +} + +/* + *---------------------------------------------------------------------- + * + * Tcl_FindHashEntry -- + * + * Given a hash table 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. + * + *---------------------------------------------------------------------- + */ + +Tcl_HashEntry * +Tcl_FindHashEntry( + Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ + const void *key) /* Key to use to find matching entry. */ +{ + return (*((tablePtr)->findProc))(tablePtr, key); +} + +static Tcl_HashEntry * +FindHashEntry( + Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ + const char *key) /* Key to use to find matching entry. */ +{ + return CreateHashEntry(tablePtr, key, NULL); +} + + +/* + *---------------------------------------------------------------------- + * + * Tcl_CreateHashEntry -- + * + * 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. + * + *---------------------------------------------------------------------- + */ + +Tcl_HashEntry * +Tcl_CreateHashEntry( + Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ + const void *key, /* Key to use to find or create matching + * entry. */ + int *newPtr) /* Store info here telling whether a new entry + * was created. */ +{ + return (*((tablePtr)->createProc))(tablePtr, key, newPtr); +} + +static Tcl_HashEntry * +CreateHashEntry( + 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. */ +{ + register Tcl_HashEntry *hPtr; + const Tcl_HashKeyType *typePtr; + unsigned int hash; + int index; + + if (tablePtr->keyType == TCL_STRING_KEYS) { + typePtr = &tclStringHashKeyType; + } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { + typePtr = &tclOneWordHashKeyType; + } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS + || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { + typePtr = tablePtr->typePtr; + } else { + typePtr = &tclArrayHashKeyType; + } + + if (typePtr->hashKeyProc) { + hash = typePtr->hashKeyProc(tablePtr, (void *) key); + if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { + index = RANDOM_INDEX(tablePtr, hash); + } else { + index = hash & tablePtr->mask; + } + } else { + hash = PTR2UINT(key); + index = RANDOM_INDEX(tablePtr, hash); + } + + /* + * Search all of the entries in the appropriate bucket. + */ + + if (typePtr->compareKeysProc) { + Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc; + + for (hPtr = tablePtr->buckets[index]; hPtr != NULL; + hPtr = hPtr->nextPtr) { +#if TCL_HASH_KEY_STORE_HASH + if (hash != PTR2UINT(hPtr->hash)) { + continue; + } +#endif + if (compareKeysProc((void *) key, hPtr)) { + if (newPtr) { + *newPtr = 0; + } + return hPtr; + } + } + } else { + for (hPtr = tablePtr->buckets[index]; hPtr != NULL; + hPtr = hPtr->nextPtr) { +#if TCL_HASH_KEY_STORE_HASH + if (hash != PTR2UINT(hPtr->hash)) { + continue; + } +#endif + if (key == hPtr->key.oneWordValue) { + if (newPtr) { + *newPtr = 0; + } + return hPtr; + } + } + } + + if (!newPtr) { + return NULL; + } + + /* + * Entry not found. Add a new one to the bucket. + */ + + *newPtr = 1; + if (typePtr->allocEntryProc) { + hPtr = typePtr->allocEntryProc(tablePtr, (void *) key); + } else { + hPtr = ckalloc(sizeof(Tcl_HashEntry)); + hPtr->key.oneWordValue = (char *) key; + hPtr->clientData = 0; + } + + hPtr->tablePtr = tablePtr; +#if TCL_HASH_KEY_STORE_HASH + hPtr->hash = UINT2PTR(hash); + hPtr->nextPtr = tablePtr->buckets[index]; + tablePtr->buckets[index] = hPtr; +#else + hPtr->bucketPtr = &tablePtr->buckets[index]; + hPtr->nextPtr = *hPtr->bucketPtr; + *hPtr->bucketPtr = hPtr; +#endif + 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; } /* @@ -120,26 +401,57 @@ Tcl_InitHashTable(tablePtr, keyType) * None. * * Side effects: - * The entry given by entryPtr is deleted from its table and - * should never again be used by the caller. It is up to the - * caller to free the clientData field of the entry, if that - * is relevant. + * The entry given by entryPtr is deleted from its table and should never + * again be used by the caller. It is up to the caller to free the + * clientData field of the entry, if that is relevant. * *---------------------------------------------------------------------- */ void -Tcl_DeleteHashEntry(entryPtr) - Tcl_HashEntry *entryPtr; +Tcl_DeleteHashEntry( + Tcl_HashEntry *entryPtr) { register Tcl_HashEntry *prevPtr; + const Tcl_HashKeyType *typePtr; + Tcl_HashTable *tablePtr; + Tcl_HashEntry **bucketPtr; +#if TCL_HASH_KEY_STORE_HASH + int index; +#endif + + tablePtr = entryPtr->tablePtr; + + if (tablePtr->keyType == TCL_STRING_KEYS) { + typePtr = &tclStringHashKeyType; + } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { + typePtr = &tclOneWordHashKeyType; + } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS + || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { + typePtr = tablePtr->typePtr; + } else { + typePtr = &tclArrayHashKeyType; + } - if (*entryPtr->bucketPtr == entryPtr) { - *entryPtr->bucketPtr = entryPtr->nextPtr; +#if TCL_HASH_KEY_STORE_HASH + if (typePtr->hashKeyProc == NULL + || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { + index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash)); } else { - for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) { + index = PTR2UINT(entryPtr->hash) & tablePtr->mask; + } + + bucketPtr = &tablePtr->buckets[index]; +#else + bucketPtr = entryPtr->bucketPtr; +#endif + + if (*bucketPtr == entryPtr) { + *bucketPtr = entryPtr->nextPtr; + } else { + for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) { if (prevPtr == NULL) { - panic("malformed bucket chain in Tcl_DeleteHashEntry"); + Tcl_Panic("malformed bucket chain in Tcl_DeleteHashEntry"); } if (prevPtr->nextPtr == entryPtr) { prevPtr->nextPtr = entryPtr->nextPtr; @@ -147,8 +459,13 @@ Tcl_DeleteHashEntry(entryPtr) } } } - entryPtr->tablePtr->numEntries--; - ckfree((char *) entryPtr); + + tablePtr->numEntries--; + if (typePtr->freeEntryProc) { + typePtr->freeEntryProc(entryPtr); + } else { + ckfree(entryPtr); + } } /* @@ -156,8 +473,8 @@ Tcl_DeleteHashEntry(entryPtr) * * Tcl_DeleteHashTable -- * - * Free up everything associated with a hash table except for - * the record for the table itself. + * Free up everything associated with a hash table except for the record + * for the table itself. * * Results: * None. @@ -169,12 +486,24 @@ Tcl_DeleteHashEntry(entryPtr) */ void -Tcl_DeleteHashTable(tablePtr) - register Tcl_HashTable *tablePtr; /* Table to delete. */ +Tcl_DeleteHashTable( + register Tcl_HashTable *tablePtr) /* Table to delete. */ { register Tcl_HashEntry *hPtr, *nextPtr; + const Tcl_HashKeyType *typePtr; int i; + if (tablePtr->keyType == TCL_STRING_KEYS) { + typePtr = &tclStringHashKeyType; + } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { + typePtr = &tclOneWordHashKeyType; + } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS + || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { + typePtr = tablePtr->typePtr; + } else { + typePtr = &tclArrayHashKeyType; + } + /* * Free up all the entries in the table. */ @@ -183,7 +512,11 @@ Tcl_DeleteHashTable(tablePtr) hPtr = tablePtr->buckets[i]; while (hPtr != NULL) { nextPtr = hPtr->nextPtr; - ckfree((char *) hPtr); + if (typePtr->freeEntryProc) { + typePtr->freeEntryProc(hPtr); + } else { + ckfree(hPtr); + } hPtr = nextPtr; } } @@ -193,7 +526,11 @@ Tcl_DeleteHashTable(tablePtr) */ if (tablePtr->buckets != tablePtr->staticBuckets) { - ckfree((char *) tablePtr->buckets); + if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { + TclpSysFree((char *) tablePtr->buckets); + } else { + ckfree(tablePtr->buckets); + } } /* @@ -210,16 +547,14 @@ Tcl_DeleteHashTable(tablePtr) * * Tcl_FirstHashEntry -- * - * Locate the first entry in a hash table and set up a record - * that can be used to step through all the remaining entries - * of the table. + * Locate the first entry in a hash table and set up a record that can be + * used to step through all the remaining entries of the table. * * Results: - * The return value is a pointer to the first entry in tablePtr, - * or NULL if tablePtr has no entries in it. The memory at - * *searchPtr is initialized so that subsequent calls to - * Tcl_NextHashEntry will return all of the entries in the table, - * one at a time. + * The return value is a pointer to the first entry in tablePtr, or NULL + * if tablePtr has no entries in it. The memory at *searchPtr is + * initialized so that subsequent calls to Tcl_NextHashEntry will return + * all of the entries in the table, one at a time. * * Side effects: * None. @@ -228,10 +563,10 @@ Tcl_DeleteHashTable(tablePtr) */ Tcl_HashEntry * -Tcl_FirstHashEntry(tablePtr, searchPtr) - Tcl_HashTable *tablePtr; /* Table to search. */ - Tcl_HashSearch *searchPtr; /* Place to store information about - * progress through the table. */ +Tcl_FirstHashEntry( + Tcl_HashTable *tablePtr, /* Table to search. */ + Tcl_HashSearch *searchPtr) /* Place to store information about progress + * through the table. */ { searchPtr->tablePtr = tablePtr; searchPtr->nextIndex = 0; @@ -245,12 +580,12 @@ Tcl_FirstHashEntry(tablePtr, searchPtr) * Tcl_NextHashEntry -- * * Once a hash table enumeration has been initiated by calling - * Tcl_FirstHashEntry, this procedure may be called to return - * successive elements of the table. + * Tcl_FirstHashEntry, this function may be called to return successive + * elements of the table. * * Results: - * The return value is the next entry in the hash table being - * enumerated, or NULL if the end of the table is reached. + * The return value is the next entry in the hash table being enumerated, + * or NULL if the end of the table is reached. * * Side effects: * None. @@ -259,20 +594,22 @@ Tcl_FirstHashEntry(tablePtr, searchPtr) */ Tcl_HashEntry * -Tcl_NextHashEntry(searchPtr) - register Tcl_HashSearch *searchPtr; /* Place to store information about - * progress through the table. Must - * have been initialized by calling - * Tcl_FirstHashEntry. */ +Tcl_NextHashEntry( + register Tcl_HashSearch *searchPtr) + /* Place to store information about progress + * through the table. Must have been + * initialized by calling + * Tcl_FirstHashEntry. */ { Tcl_HashEntry *hPtr; + Tcl_HashTable *tablePtr = searchPtr->tablePtr; while (searchPtr->nextEntryPtr == NULL) { - if (searchPtr->nextIndex >= searchPtr->tablePtr->numBuckets) { + if (searchPtr->nextIndex >= tablePtr->numBuckets) { return NULL; } searchPtr->nextEntryPtr = - searchPtr->tablePtr->buckets[searchPtr->nextIndex]; + tablePtr->buckets[searchPtr->nextIndex]; searchPtr->nextIndex++; } hPtr = searchPtr->nextEntryPtr; @@ -285,13 +622,12 @@ Tcl_NextHashEntry(searchPtr) * * Tcl_HashStats -- * - * Return statistics describing the layout of the hash table - * in its hash buckets. + * Return statistics describing the layout of the hash table in its hash + * buckets. * * Results: - * The return value is a malloc-ed string containing information - * about tablePtr. It is the caller's responsibility to free - * this string. + * The return value is a malloc-ed string containing information about + * tablePtr. It is the caller's responsibility to free this string. * * Side effects: * None. @@ -300,8 +636,8 @@ Tcl_NextHashEntry(searchPtr) */ char * -Tcl_HashStats(tablePtr) - Tcl_HashTable *tablePtr; /* Table for which to produce stats. */ +Tcl_HashStats( + Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 int count[NUM_COUNTERS], overflow, i, j; @@ -329,14 +665,16 @@ Tcl_HashStats(tablePtr) overflow++; } tmp = j; - average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0; + if (tablePtr->numEntries != 0) { + average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0; + } } /* * Print out the histogram and a few other pieces of information. */ - result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300)); + result = ckalloc((NUM_COUNTERS * 60) + 300); sprintf(result, "%d entries in table, %d buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); @@ -355,67 +693,12 @@ Tcl_HashStats(tablePtr) /* *---------------------------------------------------------------------- * - * HashString -- + * AllocArrayEntry -- * - * Compute a one-word summary of a text string, which can be - * used to generate a hash index. + * Allocate space for a Tcl_HashEntry containing the array key. * * Results: - * The return value is a one-word summary of the information in - * string. - * - * Side effects: - * None. - * - *---------------------------------------------------------------------- - */ - -static unsigned int -HashString(string) - register CONST char *string;/* String from which to compute hash value. */ -{ - register unsigned int result; - register int c; - - /* - * 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 (1) { - c = *string; - string++; - if (c == 0) { - break; - } - result += (result<<3) + c; - } - return result; -} - -/* - *---------------------------------------------------------------------- - * - * StringFind -- - * - * 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. + * The return value is a pointer to the created entry. * * Side effects: * None. @@ -424,123 +707,82 @@ HashString(string) */ static Tcl_HashEntry * -StringFind(tablePtr, key) - Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ - CONST char *key; /* Key to use to find matching entry. */ +AllocArrayEntry( + Tcl_HashTable *tablePtr, /* Hash table. */ + void *keyPtr) /* Key to store in the hash table entry. */ { - register Tcl_HashEntry *hPtr; - register CONST char *p1, *p2; - int index; + int *array = (int *) keyPtr; + register int *iPtr1, *iPtr2; + Tcl_HashEntry *hPtr; + int count; + unsigned int size; - index = HashString(key) & tablePtr->mask; + count = tablePtr->keyType; - /* - * Search all of the entries in the appropriate bucket. - */ + size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key); + if (size < sizeof(Tcl_HashEntry)) { + size = sizeof(Tcl_HashEntry); + } + hPtr = ckalloc(size); - for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { - for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) { - if (*p1 != *p2) { - break; - } - if (*p1 == '\0') { - return hPtr; - } - } + for (iPtr1 = array, iPtr2 = hPtr->key.words; + count > 0; count--, iPtr1++, iPtr2++) { + *iPtr2 = *iPtr1; } - return NULL; + hPtr->clientData = 0; + + return hPtr; } /* *---------------------------------------------------------------------- * - * StringCreate -- + * CompareArrayKeys -- * - * 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. + * Compares two array keys. * * 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. + * The return value is 0 if they are different and 1 if they are the + * same. * * Side effects: - * A new entry may be added to the hash table. + * None. * *---------------------------------------------------------------------- */ -static Tcl_HashEntry * -StringCreate(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. */ +static int +CompareArrayKeys( + void *keyPtr, /* New key to compare. */ + Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - register Tcl_HashEntry *hPtr; - register CONST char *p1, *p2; - int index; - - index = HashString(key) & tablePtr->mask; - - /* - * Search all of the entries in this bucket. - */ - - for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { - for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) { - if (*p1 != *p2) { - break; - } - if (*p1 == '\0') { - *newPtr = 0; - return hPtr; - } + register const int *iPtr1 = (const int *) keyPtr; + register const int *iPtr2 = (const int *) hPtr->key.words; + Tcl_HashTable *tablePtr = hPtr->tablePtr; + int count; + + for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) { + if (count == 0) { + return 1; + } + if (*iPtr1 != *iPtr2) { + break; } } - - /* - * Entry not found. Add a new one to the bucket. - */ - - *newPtr = 1; - hPtr = (Tcl_HashEntry *) ckalloc((unsigned) - (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1))); - hPtr->tablePtr = tablePtr; - hPtr->bucketPtr = &(tablePtr->buckets[index]); - hPtr->nextPtr = *hPtr->bucketPtr; - hPtr->clientData = 0; - strcpy(hPtr->key.string, key); - *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; + return 0; } /* *---------------------------------------------------------------------- * - * OneWordFind -- + * HashArrayKey -- * - * Given a hash table with one-word keys, and a one-word key, find - * the entry with a matching key. + * Compute a one-word summary of an array, which can be used to generate + * a hash index. * * Results: - * The return value is a token for the matching entry in the - * hash table, or NULL if there was no matching entry. + * The return value is a one-word summary of the information in + * string. * * Side effects: * None. @@ -548,111 +790,67 @@ StringCreate(tablePtr, key, newPtr) *---------------------------------------------------------------------- */ -static Tcl_HashEntry * -OneWordFind(tablePtr, key) - Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ - register CONST char *key; /* Key to use to find matching entry. */ +static unsigned int +HashArrayKey( + Tcl_HashTable *tablePtr, /* Hash table. */ + void *keyPtr) /* Key from which to compute hash value. */ { - register Tcl_HashEntry *hPtr; - int index; - - index = RANDOM_INDEX(tablePtr, key); - - /* - * Search all of the entries in the appropriate bucket. - */ + register const int *array = (const int *) keyPtr; + register unsigned int result; + int count; - for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { - if (hPtr->key.oneWordValue == key) { - return hPtr; - } + for (result = 0, count = tablePtr->keyType; count > 0; + count--, array++) { + result += *array; } - return NULL; + return result; } /* *---------------------------------------------------------------------- * - * OneWordCreate -- + * AllocStringEntry -- * - * Given a hash table with one-word keys, and a one-word key, find - * the entry with a matching key. If there is no matching entry, - * then create a new entry that does match. + * Allocate space for a Tcl_HashEntry containing the string key. * * 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. + * The return value is a pointer to the created entry. * * Side effects: - * A new entry may be added to the hash table. + * None. * *---------------------------------------------------------------------- */ static Tcl_HashEntry * -OneWordCreate(tablePtr, key, newPtr) - Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ - register CONST char *key; /* Key to use to find or create matching - * entry. */ - int *newPtr; /* Store info here telling whether a new - * entry was created. */ +AllocStringEntry( + Tcl_HashTable *tablePtr, /* Hash table. */ + void *keyPtr) /* Key to store in the hash table entry. */ { - register Tcl_HashEntry *hPtr; - int index; - - index = RANDOM_INDEX(tablePtr, key); - - /* - * Search all of the entries in this bucket. - */ + const char *string = (const char *) keyPtr; + Tcl_HashEntry *hPtr; + unsigned int size, allocsize; - for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { - if (hPtr->key.oneWordValue == key) { - *newPtr = 0; - return hPtr; - } + allocsize = size = strlen(string) + 1; + if (size < sizeof(hPtr->key)) { + allocsize = sizeof(hPtr->key); } - - /* - * Entry not found. Add a new one to the bucket. - */ - - *newPtr = 1; - hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry)); - hPtr->tablePtr = tablePtr; - hPtr->bucketPtr = &(tablePtr->buckets[index]); - hPtr->nextPtr = *hPtr->bucketPtr; + hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize); + memcpy(hPtr->key.string, string, size); hPtr->clientData = 0; - hPtr->key.oneWordValue = (char *) key; /* CONST XXXX */ - *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; } /* *---------------------------------------------------------------------- * - * ArrayFind -- + * CompareStringKeys -- * - * Given a hash table with array-of-int keys, and a key, find - * the entry with a matching key. + * Compares two string keys. * * Results: - * The return value is a token for the matching entry in the - * hash table, or NULL if there was no matching entry. + * The return value is 0 if they are different and 1 if they are the + * same. * * Side effects: * None. @@ -660,126 +858,81 @@ OneWordCreate(tablePtr, key, newPtr) *---------------------------------------------------------------------- */ -static Tcl_HashEntry * -ArrayFind(tablePtr, key) - Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ - CONST char *key; /* Key to use to find matching entry. */ +static int +CompareStringKeys( + void *keyPtr, /* New key to compare. */ + Tcl_HashEntry *hPtr) /* Existing key to compare. */ { - register Tcl_HashEntry *hPtr; - int *arrayPtr = (int *) key; - register int *iPtr1, *iPtr2; - int index, count; + register const char *p1 = (const char *) keyPtr; + register const char *p2 = (const char *) hPtr->key.string; - for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr; - count > 0; count--, iPtr1++) { - index += *iPtr1; - } - index = RANDOM_INDEX(tablePtr, index); - - /* - * Search all of the entries in the appropriate bucket. - */ - - for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { - for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, - count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) { - if (count == 0) { - return hPtr; - } - if (*iPtr1 != *iPtr2) { - break; - } - } - } - return NULL; + return !strcmp(p1, p2); } /* *---------------------------------------------------------------------- * - * ArrayCreate -- + * HashStringKey -- * - * Given a hash table with one-word keys, and a one-word key, find - * the entry with a matching key. If there is no matching entry, - * then create a new entry that does match. + * Compute a one-word summary of a text string, which can be used to + * generate a hash index. * * 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. + * The return value is a one-word summary of the information in string. * * Side effects: - * A new entry may be added to the hash table. + * None. * *---------------------------------------------------------------------- */ -static Tcl_HashEntry * -ArrayCreate(tablePtr, key, newPtr) - Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ - register CONST char *key; /* Key to use to find or create matching - * entry. */ - int *newPtr; /* Store info here telling whether a new - * entry was created. */ +static unsigned +HashStringKey( + Tcl_HashTable *tablePtr, /* Hash table. */ + void *keyPtr) /* Key from which to compute hash value. */ { - register Tcl_HashEntry *hPtr; - int *arrayPtr = (int *) key; - register int *iPtr1, *iPtr2; - int index, count; - - for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr; - count > 0; count--, iPtr1++) { - index += *iPtr1; - } - index = RANDOM_INDEX(tablePtr, index); + register const char *string = keyPtr; + register unsigned int result; + register char c; /* - * Search all of the entries in the appropriate bucket. + * 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, but isn't strong against maliciously-chosen + * keys. + * + * Note that this function is very weak against malicious strings; it's + * very easy to generate multiple keys that have the same hashcode. On the + * other hand, that hardly ever actually occurs and this function *is* + * very cheap, even by comparison with industry-standard hashes like FNV. + * If real strength of hash is required though, use a custom hash based on + * Bob Jenkins's lookup3(), but be aware that it's significantly slower. + * Since Tcl command and namespace names are usually reasonably-named (the + * main use for string hashes in modern Tcl) speed is far more important + * than strength. + * + * See also HashString in tclLiteral.c. + * See also TclObjHashKey in tclObj.c. + * + * See [tcl-Feature Request #2958832] */ - for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { - for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, - count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) { - if (count == 0) { - *newPtr = 0; - return hPtr; - } - if (*iPtr1 != *iPtr2) { - break; - } + if ((result = UCHAR(*string)) != 0) { + while ((c = *++string) != 0) { + result += (result << 3) + UCHAR(c); } } - - /* - * Entry not found. Add a new one to the bucket. - */ - - *newPtr = 1; - hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry) - + (tablePtr->keyType*sizeof(int)) - 4)); - hPtr->tablePtr = tablePtr; - hPtr->bucketPtr = &(tablePtr->buckets[index]); - hPtr->nextPtr = *hPtr->bucketPtr; - hPtr->clientData = 0; - for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType; - count > 0; count--, iPtr1++, iPtr2++) { - *iPtr2 = *iPtr1; - } - *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; + return result; } /* @@ -787,12 +940,11 @@ ArrayCreate(tablePtr, key, newPtr) * * BogusFind -- * - * This procedure is invoked when an Tcl_FindHashEntry is called - * on a table that has been deleted. + * This function is invoked when an Tcl_FindHashEntry is called on a + * table that has been deleted. * * Results: - * If panic returns (which it shouldn't) this procedure returns - * NULL. + * If Tcl_Panic returns (which it shouldn't) this function returns NULL. * * Side effects: * Generates a panic. @@ -802,11 +954,11 @@ ArrayCreate(tablePtr, key, newPtr) /* ARGSUSED */ static Tcl_HashEntry * -BogusFind(tablePtr, key) - Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ - CONST char *key; /* Key to use to find matching entry. */ +BogusFind( + Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ + const char *key) /* Key to use to find matching entry. */ { - panic("called Tcl_FindHashEntry on deleted table"); + Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry"); return NULL; } @@ -815,12 +967,11 @@ BogusFind(tablePtr, key) * * BogusCreate -- * - * This procedure is invoked when an Tcl_CreateHashEntry is called - * on a table that has been deleted. + * This function is invoked when an Tcl_CreateHashEntry is called on a + * table that has been deleted. * * Results: - * If panic returns (which it shouldn't) this procedure returns - * NULL. + * If panic returns (which it shouldn't) this function returns NULL. * * Side effects: * Generates a panic. @@ -830,14 +981,14 @@ BogusFind(tablePtr, key) /* ARGSUSED */ static Tcl_HashEntry * -BogusCreate(tablePtr, key, newPtr) - Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ - CONST char *key; /* Key to use to find or create matching +BogusCreate( + 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. */ + int *newPtr) /* Store info here telling whether a new entry + * was created. */ { - panic("called Tcl_CreateHashEntry on deleted table"); + Tcl_Panic("called %s on deleted table", "Tcl_CreateHashEntry"); return NULL; } @@ -846,41 +997,56 @@ BogusCreate(tablePtr, key, newPtr) * * RebuildTable -- * - * This procedure is invoked when the ratio of entries to hash - * buckets becomes too large. It creates a new table with a - * larger bucket array and moves all of the entries into the - * new table. + * This function is invoked when the ratio of entries to hash buckets + * becomes too large. It creates a new table with a larger bucket array + * and moves all of the entries into the new table. * * Results: * None. * * Side effects: - * Memory gets reallocated and entries get re-hashed to new - * buckets. + * Memory gets reallocated and entries get re-hashed to new buckets. * *---------------------------------------------------------------------- */ static void -RebuildTable(tablePtr) - register Tcl_HashTable *tablePtr; /* Table to enlarge. */ +RebuildTable( + register Tcl_HashTable *tablePtr) /* Table to enlarge. */ { int oldSize, count, index; Tcl_HashEntry **oldBuckets; register Tcl_HashEntry **oldChainPtr, **newChainPtr; register Tcl_HashEntry *hPtr; + const Tcl_HashKeyType *typePtr; + + if (tablePtr->keyType == TCL_STRING_KEYS) { + typePtr = &tclStringHashKeyType; + } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) { + typePtr = &tclOneWordHashKeyType; + } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS + || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { + typePtr = tablePtr->typePtr; + } else { + typePtr = &tclArrayHashKeyType; + } oldSize = tablePtr->numBuckets; oldBuckets = tablePtr->buckets; /* - * Allocate and initialize the new bucket array, and set up - * hashing constants for new array size. + * Allocate and initialize the new bucket array, and set up hashing + * constants for new array size. */ tablePtr->numBuckets *= 4; - tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned) - (tablePtr->numBuckets * sizeof(Tcl_HashEntry *))); + if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { + tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned) + (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0); + } else { + tablePtr->buckets = + ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *)); + } for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets; count > 0; count--, newChainPtr++) { *newChainPtr = NULL; @@ -896,23 +1062,35 @@ RebuildTable(tablePtr) 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); +#if TCL_HASH_KEY_STORE_HASH + if (typePtr->hashKeyProc == NULL + || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { + index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash)); } else { - register int *iPtr; - int count; - - for (index = 0, count = tablePtr->keyType, - iPtr = hPtr->key.words; count > 0; count--, iPtr++) { - index += *iPtr; + index = PTR2UINT(hPtr->hash) & tablePtr->mask; + } + hPtr->nextPtr = tablePtr->buckets[index]; + tablePtr->buckets[index] = hPtr; +#else + void *key = Tcl_GetHashKey(tablePtr, hPtr); + + if (typePtr->hashKeyProc) { + unsigned int hash; + + hash = typePtr->hashKeyProc(tablePtr, key); + if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { + index = RANDOM_INDEX(tablePtr, hash); + } else { + index = hash & tablePtr->mask; } - index = RANDOM_INDEX(tablePtr, index); + } else { + index = RANDOM_INDEX(tablePtr, key); } - hPtr->bucketPtr = &(tablePtr->buckets[index]); + + hPtr->bucketPtr = &tablePtr->buckets[index]; hPtr->nextPtr = *hPtr->bucketPtr; *hPtr->bucketPtr = hPtr; +#endif } } @@ -921,6 +1099,18 @@ RebuildTable(tablePtr) */ if (oldBuckets != tablePtr->staticBuckets) { - ckfree((char *) oldBuckets); + if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { + TclpSysFree((char *) oldBuckets); + } else { + ckfree(oldBuckets); + } } } + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |