diff options
Diffstat (limited to 'generic/tclHash.c')
| -rw-r--r-- | generic/tclHash.c | 764 |
1 files changed, 439 insertions, 325 deletions
diff --git a/generic/tclHash.c b/generic/tclHash.c index 90be511..3eaf395 100644 --- a/generic/tclHash.c +++ b/generic/tclHash.c @@ -7,8 +7,8 @@ * 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. + * See the file "license.terms" for information on usage and redistribution + * of this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #include "tclInt.h" @@ -17,69 +17,89 @@ * Prevent macros from clashing with function definitions. */ -#undef Tcl_FindHashEntry -#undef Tcl_CreateHashEntry +#if TCL_PRESERVE_BINARY_COMPATABILITY +# undef Tcl_FindHashEntry +# undef Tcl_CreateHashEntry +#endif /* - * When there are this many entries per bucket, on average, rebuild the hash - * table to make it larger. + * 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) \ - ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask) + (((((long) (i))*1103515245) >> (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); +static Tcl_HashEntry * AllocArrayEntry _ANSI_ARGS_(( + Tcl_HashTable *tablePtr, + VOID *keyPtr)); +static int CompareArrayKeys _ANSI_ARGS_(( + VOID *keyPtr, Tcl_HashEntry *hPtr)); +static unsigned int HashArrayKey _ANSI_ARGS_(( + Tcl_HashTable *tablePtr, + VOID *keyPtr)); /* - * 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. + * Prototypes for the one word hash key methods. */ #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); +static Tcl_HashEntry * AllocOneWordEntry _ANSI_ARGS_(( + Tcl_HashTable *tablePtr, + VOID *keyPtr)); +static int CompareOneWordKeys _ANSI_ARGS_(( + VOID *keyPtr, Tcl_HashEntry *hPtr)); +static unsigned int HashOneWordKey _ANSI_ARGS_(( + 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); +static Tcl_HashEntry * AllocStringEntry _ANSI_ARGS_(( + Tcl_HashTable *tablePtr, + VOID *keyPtr)); +static int CompareStringKeys _ANSI_ARGS_(( + VOID *keyPtr, Tcl_HashEntry *hPtr)); +static unsigned int HashStringKey _ANSI_ARGS_(( + Tcl_HashTable *tablePtr, + VOID *keyPtr)); /* - * Function prototypes for static functions in this file: + * Procedure prototypes for static procedures 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); +#if TCL_PRESERVE_BINARY_COMPATABILITY +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 Tcl_HashEntry * FindHashEntry _ANSI_ARGS_((Tcl_HashTable *tablePtr, + CONST char *key)); +static Tcl_HashEntry * CreateHashEntry _ANSI_ARGS_((Tcl_HashTable *tablePtr, + CONST char *key, int *newPtr)); + +#endif -const Tcl_HashKeyType tclArrayHashKeyType = { +static void RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr)); + +Tcl_HashKeyType tclArrayHashKeyType = { TCL_HASH_KEY_TYPE_VERSION, /* version */ TCL_HASH_KEY_RANDOMIZE_HASH, /* flags */ HashArrayKey, /* hashKeyProc */ @@ -88,7 +108,7 @@ const Tcl_HashKeyType tclArrayHashKeyType = { NULL /* freeEntryProc */ }; -const Tcl_HashKeyType tclOneWordHashKeyType = { +Tcl_HashKeyType tclOneWordHashKeyType = { TCL_HASH_KEY_TYPE_VERSION, /* version */ 0, /* flags */ NULL, /* HashOneWordKey, */ /* hashProc */ @@ -97,7 +117,7 @@ const Tcl_HashKeyType tclOneWordHashKeyType = { NULL /* FreeOneWordKey, */ /* freeEntryProc */ }; -const Tcl_HashKeyType tclStringHashKeyType = { +Tcl_HashKeyType tclStringHashKeyType = { TCL_HASH_KEY_TYPE_VERSION, /* version */ 0, /* flags */ HashStringKey, /* hashKeyProc */ @@ -105,14 +125,15 @@ const Tcl_HashKeyType tclStringHashKeyType = { 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. @@ -124,23 +145,22 @@ const Tcl_HashKeyType tclStringHashKeyType = { *---------------------------------------------------------------------- */ +#undef Tcl_InitHashTable 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. */ +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. */ { /* - * 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. + * 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(tablePtr, keyType, (Tcl_HashKeyType *) -1); } /* @@ -148,9 +168,9 @@ Tcl_InitHashTable( * * 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. + * 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. @@ -163,19 +183,19 @@ Tcl_InitHashTable( */ void -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. */ +Tcl_InitCustomHashTable(tablePtr, keyType, typePtr) + 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. */ + Tcl_HashKeyType *typePtr; /* Pointer to structure which defines + * the behaviour of this table. */ { #if (TCL_SMALL_HASH_TABLE != 4) - Tcl_Panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4", + panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n", TCL_SMALL_HASH_TABLE); #endif @@ -188,6 +208,7 @@ Tcl_InitCustomHashTable( tablePtr->downShift = 28; tablePtr->mask = 3; tablePtr->keyType = keyType; +#if TCL_PRESERVE_BINARY_COMPATABILITY tablePtr->findProc = FindHashEntry; tablePtr->createProc = CreateHashEntry; @@ -198,16 +219,41 @@ Tcl_InitCustomHashTable( */ } else if (typePtr != (Tcl_HashKeyType *) -1) { /* - * The caller is requesting a customized hash table so it must be an - * extended version. + * The caller is requesting a customized hash table so it must be + * an extended version. */ - tablePtr->typePtr = typePtr; } else { /* - * The caller has not been rebuilt so the hash table is not extended. + * The caller has not been rebuilt so the hash table is not + * extended. + */ + } +#else + if (typePtr == NULL) { + /* + * Use the key type to decide which key type is needed. */ + if (keyType == TCL_STRING_KEYS) { + typePtr = &tclStringHashKeyType; + } else if (keyType == TCL_ONE_WORD_KEYS) { + typePtr = &tclOneWordHashKeyType; + } else if (keyType == TCL_CUSTOM_TYPE_KEYS) { + Tcl_Panic ("No type structure specified for TCL_CUSTOM_TYPE_KEYS"); + } else if (keyType == TCL_CUSTOM_PTR_KEYS) { + Tcl_Panic ("No type structure specified for TCL_CUSTOM_PTR_KEYS"); + } else { + typePtr = &tclArrayHashKeyType; + } + } else if (typePtr == (Tcl_HashKeyType *) -1) { + /* + * If the caller has not been rebuilt then we cannot continue as + * the hash table is not an extended version. + */ + Tcl_Panic ("Hash table is not compatible"); } + tablePtr->typePtr = typePtr; +#endif } /* @@ -218,8 +264,8 @@ Tcl_InitCustomHashTable( * 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. + * 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. @@ -228,36 +274,104 @@ Tcl_InitCustomHashTable( */ Tcl_HashEntry * -Tcl_FindHashEntry( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const void *key) /* Key to use to find matching entry. */ +Tcl_FindHashEntry(tablePtr, key) + Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ + CONST char *key; /* Key to use to find matching entry. */ +#if TCL_PRESERVE_BINARY_COMPATABILITY { - return (*((tablePtr)->findProc))(tablePtr, key); + 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. */ +FindHashEntry(tablePtr, key) + Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ + CONST char *key; /* Key to use to find matching entry. */ +#endif /* TCL_PRESERVE_BINARY_COMPATABILITY */ { - return CreateHashEntry(tablePtr, key, NULL); -} + register Tcl_HashEntry *hPtr; + Tcl_HashKeyType *typePtr; + unsigned int hash; + int index; + +#if TCL_PRESERVE_BINARY_COMPATABILITY + 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; + } +#else + typePtr = tablePtr->typePtr; + if (typePtr == NULL) { + Tcl_Panic("called Tcl_FindHashEntry on deleted table"); + return NULL; + } +#endif + 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 = (unsigned int) 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 != (unsigned int) hPtr->hash) { + continue; + } +#endif + if (compareKeysProc ((VOID *) key, hPtr)) { + return hPtr; + } + } + } else { + for (hPtr = tablePtr->buckets[index]; hPtr != NULL; + hPtr = hPtr->nextPtr) { +#if TCL_HASH_KEY_STORE_HASH + if (hash != (unsigned int) hPtr->hash) { + continue; + } +#endif + if (key == hPtr->key.oneWordValue) { + return hPtr; + } + } + } + + return 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. + * 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. + * 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. @@ -266,50 +380,60 @@ FindHashEntry( */ Tcl_HashEntry * -Tcl_CreateHashEntry( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const void *key, /* Key to use to find or create matching +Tcl_CreateHashEntry(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. */ + int *newPtr; /* Store info here telling whether a new + * entry was created. */ +#if TCL_PRESERVE_BINARY_COMPATABILITY { - return (*((tablePtr)->createProc))(tablePtr, key, newPtr); + 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 +CreateHashEntry(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. */ + int *newPtr; /* Store info here telling whether a new + * entry was created. */ +#endif /* TCL_PRESERVE_BINARY_COMPATABILITY */ { register Tcl_HashEntry *hPtr; - const Tcl_HashKeyType *typePtr; + Tcl_HashKeyType *typePtr; unsigned int hash; int index; +#if TCL_PRESERVE_BINARY_COMPATABILITY 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) { + || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { typePtr = tablePtr->typePtr; } else { typePtr = &tclArrayHashKeyType; } +#else + typePtr = tablePtr->typePtr; + if (typePtr == NULL) { + Tcl_Panic("called Tcl_CreateHashEntry on deleted table"); + return NULL; + } +#endif if (typePtr->hashKeyProc) { - hash = typePtr->hashKeyProc(tablePtr, (void *) key); + hash = typePtr->hashKeyProc (tablePtr, (VOID *) key); if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, hash); + index = RANDOM_INDEX (tablePtr, hash); } else { index = hash & tablePtr->mask; } } else { - hash = PTR2UINT(key); - index = RANDOM_INDEX(tablePtr, hash); + hash = (unsigned int) key; + index = RANDOM_INDEX (tablePtr, hash); } /* @@ -318,70 +442,65 @@ CreateHashEntry( if (typePtr->compareKeysProc) { Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc; - for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { + hPtr = hPtr->nextPtr) { #if TCL_HASH_KEY_STORE_HASH - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != (unsigned int) hPtr->hash) { continue; } #endif - if (compareKeysProc((void *) key, hPtr)) { - if (newPtr) { - *newPtr = 0; - } + if (compareKeysProc ((VOID *) key, hPtr)) { + *newPtr = 0; return hPtr; } } } else { for (hPtr = tablePtr->buckets[index]; hPtr != NULL; - hPtr = hPtr->nextPtr) { + hPtr = hPtr->nextPtr) { #if TCL_HASH_KEY_STORE_HASH - if (hash != PTR2UINT(hPtr->hash)) { + if (hash != (unsigned int) hPtr->hash) { continue; } #endif if (key == hPtr->key.oneWordValue) { - if (newPtr) { - *newPtr = 0; - } + *newPtr = 0; return hPtr; } } } - if (!newPtr) { - return NULL; - } - /* - * Entry not found. Add a new one to the bucket. + * Entry not found. Add a new one to the bucket. */ *newPtr = 1; if (typePtr->allocEntryProc) { - hPtr = typePtr->allocEntryProc(tablePtr, (void *) key); + hPtr = typePtr->allocEntryProc (tablePtr, (VOID *) key); } else { - hPtr = ckalloc(sizeof(Tcl_HashEntry)); + hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry)); hPtr->key.oneWordValue = (char *) key; - hPtr->clientData = 0; } hPtr->tablePtr = tablePtr; #if TCL_HASH_KEY_STORE_HASH - hPtr->hash = UINT2PTR(hash); +# if TCL_PRESERVE_BINARY_COMPATABILITY + hPtr->hash = (VOID *) hash; +# else + hPtr->hash = hash; +# endif hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; #else - hPtr->bucketPtr = &tablePtr->buckets[index]; + hPtr->bucketPtr = &(tablePtr->buckets[index]); hPtr->nextPtr = *hPtr->bucketPtr; *hPtr->bucketPtr = hPtr; #endif + hPtr->clientData = 0; tablePtr->numEntries++; /* - * If the table has exceeded a decent size, rebuild it with many more - * buckets. + * If the table has exceeded a decent size, rebuild it with many + * more buckets. */ if (tablePtr->numEntries >= tablePtr->rebuildSize) { @@ -401,19 +520,20 @@ CreateHashEntry( * 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( - Tcl_HashEntry *entryPtr) +Tcl_DeleteHashEntry(entryPtr) + Tcl_HashEntry *entryPtr; { register Tcl_HashEntry *prevPtr; - const Tcl_HashKeyType *typePtr; + Tcl_HashKeyType *typePtr; Tcl_HashTable *tablePtr; Tcl_HashEntry **bucketPtr; #if TCL_HASH_KEY_STORE_HASH @@ -422,26 +542,30 @@ Tcl_DeleteHashEntry( tablePtr = entryPtr->tablePtr; +#if TCL_PRESERVE_BINARY_COMPATABILITY 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) { + || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { typePtr = tablePtr->typePtr; } else { typePtr = &tclArrayHashKeyType; } +#else + typePtr = tablePtr->typePtr; +#endif #if TCL_HASH_KEY_STORE_HASH if (typePtr->hashKeyProc == NULL - || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash)); + || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { + index = RANDOM_INDEX (tablePtr, entryPtr->hash); } else { - index = PTR2UINT(entryPtr->hash) & tablePtr->mask; + index = ((unsigned int) entryPtr->hash) & tablePtr->mask; } - bucketPtr = &tablePtr->buckets[index]; + bucketPtr = &(tablePtr->buckets[index]); #else bucketPtr = entryPtr->bucketPtr; #endif @@ -451,7 +575,7 @@ Tcl_DeleteHashEntry( } else { for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) { if (prevPtr == NULL) { - Tcl_Panic("malformed bucket chain in Tcl_DeleteHashEntry"); + panic("malformed bucket chain in Tcl_DeleteHashEntry"); } if (prevPtr->nextPtr == entryPtr) { prevPtr->nextPtr = entryPtr->nextPtr; @@ -462,9 +586,9 @@ Tcl_DeleteHashEntry( tablePtr->numEntries--; if (typePtr->freeEntryProc) { - typePtr->freeEntryProc(entryPtr); + typePtr->freeEntryProc (entryPtr); } else { - ckfree(entryPtr); + ckfree((char *) entryPtr); } } @@ -473,8 +597,8 @@ Tcl_DeleteHashEntry( * * 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. @@ -486,23 +610,27 @@ Tcl_DeleteHashEntry( */ void -Tcl_DeleteHashTable( - register Tcl_HashTable *tablePtr) /* Table to delete. */ +Tcl_DeleteHashTable(tablePtr) + register Tcl_HashTable *tablePtr; /* Table to delete. */ { register Tcl_HashEntry *hPtr, *nextPtr; - const Tcl_HashKeyType *typePtr; + Tcl_HashKeyType *typePtr; int i; +#if TCL_PRESERVE_BINARY_COMPATABILITY 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) { + || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) { typePtr = tablePtr->typePtr; } else { typePtr = &tclArrayHashKeyType; } +#else + typePtr = tablePtr->typePtr; +#endif /* * Free up all the entries in the table. @@ -513,9 +641,9 @@ Tcl_DeleteHashTable( while (hPtr != NULL) { nextPtr = hPtr->nextPtr; if (typePtr->freeEntryProc) { - typePtr->freeEntryProc(hPtr); + typePtr->freeEntryProc (hPtr); } else { - ckfree(hPtr); + ckfree((char *) hPtr); } hPtr = nextPtr; } @@ -526,11 +654,7 @@ Tcl_DeleteHashTable( */ if (tablePtr->buckets != tablePtr->staticBuckets) { - if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { - TclpSysFree((char *) tablePtr->buckets); - } else { - ckfree(tablePtr->buckets); - } + ckfree((char *) tablePtr->buckets); } /* @@ -538,8 +662,12 @@ Tcl_DeleteHashTable( * re-initialization. */ +#if TCL_PRESERVE_BINARY_COMPATABILITY tablePtr->findProc = BogusFind; tablePtr->createProc = BogusCreate; +#else + tablePtr->typePtr = NULL; +#endif } /* @@ -547,14 +675,16 @@ Tcl_DeleteHashTable( * * 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. @@ -563,10 +693,10 @@ Tcl_DeleteHashTable( */ Tcl_HashEntry * -Tcl_FirstHashEntry( - Tcl_HashTable *tablePtr, /* Table to search. */ - Tcl_HashSearch *searchPtr) /* Place to store information about progress - * through the table. */ +Tcl_FirstHashEntry(tablePtr, searchPtr) + Tcl_HashTable *tablePtr; /* Table to search. */ + Tcl_HashSearch *searchPtr; /* Place to store information about + * progress through the table. */ { searchPtr->tablePtr = tablePtr; searchPtr->nextIndex = 0; @@ -580,12 +710,12 @@ Tcl_FirstHashEntry( * Tcl_NextHashEntry -- * * Once a hash table enumeration has been initiated by calling - * Tcl_FirstHashEntry, this function may be called to return successive - * elements of the table. + * Tcl_FirstHashEntry, this procedure 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. @@ -594,12 +724,11 @@ Tcl_FirstHashEntry( */ Tcl_HashEntry * -Tcl_NextHashEntry( - register Tcl_HashSearch *searchPtr) - /* Place to store information about progress - * through the table. Must have been - * initialized by calling - * Tcl_FirstHashEntry. */ +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_HashEntry *hPtr; Tcl_HashTable *tablePtr = searchPtr->tablePtr; @@ -622,12 +751,13 @@ Tcl_NextHashEntry( * * 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. @@ -636,8 +766,8 @@ Tcl_NextHashEntry( */ char * -Tcl_HashStats( - Tcl_HashTable *tablePtr) /* Table for which to produce stats. */ +Tcl_HashStats(tablePtr) + Tcl_HashTable *tablePtr; /* Table for which to produce stats. */ { #define NUM_COUNTERS 10 int count[NUM_COUNTERS], overflow, i, j; @@ -665,16 +795,14 @@ Tcl_HashStats( overflow++; } tmp = j; - if (tablePtr->numEntries != 0) { - average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0; - } + average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0; } /* * Print out the histogram and a few other pieces of information. */ - result = ckalloc((NUM_COUNTERS * 60) + 300); + result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300)); sprintf(result, "%d entries in table, %d buckets\n", tablePtr->numEntries, tablePtr->numBuckets); p = result + strlen(result); @@ -707,9 +835,9 @@ Tcl_HashStats( */ static Tcl_HashEntry * -AllocArrayEntry( - Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key to store in the hash table entry. */ +AllocArrayEntry(tablePtr, keyPtr) + Tcl_HashTable *tablePtr; /* Hash table. */ + VOID *keyPtr; /* Key to store in the hash table entry. */ { int *array = (int *) keyPtr; register int *iPtr1, *iPtr2; @@ -720,16 +848,14 @@ AllocArrayEntry( count = tablePtr->keyType; size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key); - if (size < sizeof(Tcl_HashEntry)) { + if (size < sizeof(Tcl_HashEntry)) size = sizeof(Tcl_HashEntry); - } - hPtr = ckalloc(size); + hPtr = (Tcl_HashEntry *) ckalloc(size); for (iPtr1 = array, iPtr2 = hPtr->key.words; count > 0; count--, iPtr1++, iPtr2++) { *iPtr2 = *iPtr1; } - hPtr->clientData = 0; return hPtr; } @@ -742,8 +868,8 @@ AllocArrayEntry( * Compares two array keys. * * Results: - * The return value is 0 if they are different and 1 if they are the - * same. + * The return value is 0 if they are different and 1 if they are + * the same. * * Side effects: * None. @@ -752,12 +878,12 @@ AllocArrayEntry( */ static int -CompareArrayKeys( - void *keyPtr, /* New key to compare. */ - Tcl_HashEntry *hPtr) /* Existing key to compare. */ +CompareArrayKeys(keyPtr, hPtr) + VOID *keyPtr; /* New key to compare. */ + Tcl_HashEntry *hPtr; /* Existing key to compare. */ { - register const int *iPtr1 = (const int *) keyPtr; - register const int *iPtr2 = (const int *) hPtr->key.words; + register CONST int *iPtr1 = (CONST int *) keyPtr; + register CONST int *iPtr2 = (CONST int *) hPtr->key.words; Tcl_HashTable *tablePtr = hPtr->tablePtr; int count; @@ -777,8 +903,8 @@ CompareArrayKeys( * * HashArrayKey -- * - * Compute a one-word summary of an array, which can be used to generate - * a hash index. + * Compute a one-word summary of an array, which can be + * used to generate a hash index. * * Results: * The return value is a one-word summary of the information in @@ -791,11 +917,11 @@ CompareArrayKeys( */ static unsigned int -HashArrayKey( - Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key from which to compute hash value. */ +HashArrayKey(tablePtr, keyPtr) + Tcl_HashTable *tablePtr; /* Hash table. */ + VOID *keyPtr; /* Key from which to compute hash value. */ { - register const int *array = (const int *) keyPtr; + register CONST int *array = (CONST int *) keyPtr; register unsigned int result; int count; @@ -823,11 +949,11 @@ HashArrayKey( */ static Tcl_HashEntry * -AllocStringEntry( - Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key to store in the hash table entry. */ +AllocStringEntry(tablePtr, keyPtr) + Tcl_HashTable *tablePtr; /* Hash table. */ + VOID *keyPtr; /* Key to store in the hash table entry. */ { - const char *string = (const char *) keyPtr; + CONST char *string = (CONST char *) keyPtr; Tcl_HashEntry *hPtr; unsigned int size, allocsize; @@ -835,9 +961,8 @@ AllocStringEntry( if (size < sizeof(hPtr->key)) { allocsize = sizeof(hPtr->key); } - hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize); + hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key)); memcpy(hPtr->key.string, string, size); - hPtr->clientData = 0; return hPtr; } @@ -849,8 +974,8 @@ AllocStringEntry( * Compares two string keys. * * Results: - * The return value is 0 if they are different and 1 if they are the - * same. + * The return value is 0 if they are different and 1 if they are + * the same. * * Side effects: * None. @@ -859,14 +984,22 @@ AllocStringEntry( */ static int -CompareStringKeys( - void *keyPtr, /* New key to compare. */ - Tcl_HashEntry *hPtr) /* Existing key to compare. */ +CompareStringKeys(keyPtr, hPtr) + VOID *keyPtr; /* New key to compare. */ + Tcl_HashEntry *hPtr; /* Existing key to compare. */ { - register const char *p1 = (const char *) keyPtr; - register const char *p2 = (const char *) hPtr->key.string; + register CONST char *p1 = (CONST char *) keyPtr; + register CONST char *p2 = (CONST char *) hPtr->key.string; - return !strcmp(p1, p2); + for (;; p1++, p2++) { + if (*p1 != *p2) { + break; + } + if (*p1 == '\0') { + return 1; + } + } + return 0; } /* @@ -874,11 +1007,12 @@ CompareStringKeys( * * HashStringKey -- * - * Compute a one-word summary of a text string, which can be used to - * generate a hash index. + * Compute a one-word summary of a text string, which can be + * used to generate a hash index. * * Results: - * The return value is a one-word summary of the information in string. + * The return value is a one-word summary of the information in + * string. * * Side effects: * None. @@ -886,65 +1020,55 @@ CompareStringKeys( *---------------------------------------------------------------------- */ -static unsigned -HashStringKey( - Tcl_HashTable *tablePtr, /* Hash table. */ - void *keyPtr) /* Key from which to compute hash value. */ +static unsigned int +HashStringKey(tablePtr, keyPtr) + Tcl_HashTable *tablePtr; /* Hash table. */ + VOID *keyPtr; /* Key from which to compute hash value. */ { - register const char *string = keyPtr; + register CONST char *string = (CONST char *) keyPtr; register unsigned int result; - register char c; + 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, 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. + * 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: * - * See also HashString in tclLiteral.c. - * See also TclObjHashKey in tclObj.c. - * - * See [tcl-Feature Request #2958832] + * 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. */ - if ((result = UCHAR(*string)) != 0) { - while ((c = *++string) != 0) { - result += (result << 3) + UCHAR(c); + result = 0; + while (1) { + c = *string; + if (c == 0) { + break; } + result += (result<<3) + c; + string++; } return result; } +#if TCL_PRESERVE_BINARY_COMPATABILITY /* *---------------------------------------------------------------------- * * BogusFind -- * - * This function is invoked when an Tcl_FindHashEntry is called on a - * table that has been deleted. + * This procedure is invoked when an Tcl_FindHashEntry is called + * on a table that has been deleted. * * Results: - * If Tcl_Panic returns (which it shouldn't) this function returns NULL. + * If panic returns (which it shouldn't) this procedure returns + * NULL. * * Side effects: * Generates a panic. @@ -954,11 +1078,11 @@ HashStringKey( /* ARGSUSED */ static Tcl_HashEntry * -BogusFind( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const char *key) /* Key to use to find matching entry. */ +BogusFind(tablePtr, key) + Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */ + CONST char *key; /* Key to use to find matching entry. */ { - Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry"); + panic("called Tcl_FindHashEntry on deleted table"); return NULL; } @@ -967,11 +1091,12 @@ BogusFind( * * BogusCreate -- * - * This function is invoked when an Tcl_CreateHashEntry is called on a - * table that has been deleted. + * This procedure is invoked when an Tcl_CreateHashEntry is called + * on a table that has been deleted. * * Results: - * If panic returns (which it shouldn't) this function returns NULL. + * If panic returns (which it shouldn't) this procedure returns + * NULL. * * Side effects: * Generates a panic. @@ -981,72 +1106,59 @@ BogusFind( /* ARGSUSED */ static Tcl_HashEntry * -BogusCreate( - Tcl_HashTable *tablePtr, /* Table in which to lookup entry. */ - const char *key, /* Key to use to find or create matching +BogusCreate(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. */ + int *newPtr; /* Store info here telling whether a new + * entry was created. */ { - Tcl_Panic("called %s on deleted table", "Tcl_CreateHashEntry"); + panic("called Tcl_CreateHashEntry on deleted table"); return NULL; } +#endif /* *---------------------------------------------------------------------- * * RebuildTable -- * - * 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. + * 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. * * 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( - register Tcl_HashTable *tablePtr) /* Table to enlarge. */ +RebuildTable(tablePtr) + 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; - } + Tcl_HashKeyType *typePtr; 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; - 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 *)); - } + tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned) + (tablePtr->numBuckets * sizeof(Tcl_HashEntry *))); for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets; count > 0; count--, newChainPtr++) { *newChainPtr = NULL; @@ -1055,6 +1167,21 @@ RebuildTable( tablePtr->downShift -= 2; tablePtr->mask = (tablePtr->mask << 2) + 3; +#if TCL_PRESERVE_BINARY_COMPATABILITY + 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; + } +#else + typePtr = tablePtr->typePtr; +#endif + /* * Rehash all of the existing entries into the new bucket array. */ @@ -1062,32 +1189,31 @@ RebuildTable( for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) { for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) { *oldChainPtr = hPtr->nextPtr; + #if TCL_HASH_KEY_STORE_HASH if (typePtr->hashKeyProc == NULL - || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash)); + || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { + index = RANDOM_INDEX (tablePtr, hPtr->hash); } else { - index = PTR2UINT(hPtr->hash) & tablePtr->mask; + index = ((unsigned int) hPtr->hash) & tablePtr->mask; } hPtr->nextPtr = tablePtr->buckets[index]; tablePtr->buckets[index] = hPtr; #else - void *key = Tcl_GetHashKey(tablePtr, hPtr); - + VOID *key = (VOID *) Tcl_GetHashKey (tablePtr, hPtr); if (typePtr->hashKeyProc) { unsigned int hash; - - hash = typePtr->hashKeyProc(tablePtr, key); + hash = typePtr->hashKeyProc (tablePtr, (VOID *) key); if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) { - index = RANDOM_INDEX(tablePtr, hash); + index = RANDOM_INDEX (tablePtr, hash); } else { index = hash & tablePtr->mask; } } else { - index = RANDOM_INDEX(tablePtr, key); + index = RANDOM_INDEX (tablePtr, key); } - hPtr->bucketPtr = &tablePtr->buckets[index]; + hPtr->bucketPtr = &(tablePtr->buckets[index]); hPtr->nextPtr = *hPtr->bucketPtr; *hPtr->bucketPtr = hPtr; #endif @@ -1099,18 +1225,6 @@ RebuildTable( */ if (oldBuckets != tablePtr->staticBuckets) { - if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) { - TclpSysFree((char *) oldBuckets); - } else { - ckfree(oldBuckets); - } + ckfree((char *) oldBuckets); } } - -/* - * Local Variables: - * mode: c - * c-basic-offset: 4 - * fill-column: 78 - * End: - */ |