sl@0: /* 
sl@0:  * tclHash.c --
sl@0:  *
sl@0:  *	Implementation of in-memory hash tables for Tcl and Tcl-based
sl@0:  *	applications.
sl@0:  *
sl@0:  * Copyright (c) 1991-1993 The Regents of the University of California.
sl@0:  * Copyright (c) 1994 Sun Microsystems, Inc.
sl@0:  * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclHash.c,v 1.12.2.1 2004/11/11 01:18:07 das Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclInt.h"
sl@0: 
sl@0: /*
sl@0:  * Prevent macros from clashing with function definitions.
sl@0:  */
sl@0: 
sl@0: #if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0: #   undef Tcl_FindHashEntry
sl@0: #   undef Tcl_CreateHashEntry
sl@0: #endif
sl@0: 
sl@0: /*
sl@0:  * When there are this many entries per bucket, on average, rebuild
sl@0:  * the hash table to make it larger.
sl@0:  */
sl@0: 
sl@0: #define REBUILD_MULTIPLIER	3
sl@0: 
sl@0: /*
sl@0:  * The following macro takes a preliminary integer hash value and
sl@0:  * produces an index into a hash tables bucket list.  The idea is
sl@0:  * to make it so that preliminary values that are arbitrarily similar
sl@0:  * will end up in different buckets.  The hash function was taken
sl@0:  * from a random-number generator.
sl@0:  */
sl@0: 
sl@0: #define RANDOM_INDEX(tablePtr, i) \
sl@0:     (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
sl@0: 
sl@0: /*
sl@0:  * Prototypes for the array hash key methods.
sl@0:  */
sl@0: 
sl@0: static Tcl_HashEntry *	AllocArrayEntry _ANSI_ARGS_((
sl@0: 			    Tcl_HashTable *tablePtr,
sl@0: 			    VOID *keyPtr));
sl@0: static int		CompareArrayKeys _ANSI_ARGS_((
sl@0: 			    VOID *keyPtr, Tcl_HashEntry *hPtr));
sl@0: static unsigned int	HashArrayKey _ANSI_ARGS_((
sl@0: 			    Tcl_HashTable *tablePtr,
sl@0: 			    VOID *keyPtr));
sl@0: 
sl@0: /*
sl@0:  * Prototypes for the one word hash key methods.
sl@0:  */
sl@0: 
sl@0: #if 0
sl@0: static Tcl_HashEntry *	AllocOneWordEntry _ANSI_ARGS_((
sl@0: 			    Tcl_HashTable *tablePtr,
sl@0: 			    VOID *keyPtr));
sl@0: static int		CompareOneWordKeys _ANSI_ARGS_((
sl@0: 			    VOID *keyPtr, Tcl_HashEntry *hPtr));
sl@0: static unsigned int	HashOneWordKey _ANSI_ARGS_((
sl@0: 			    Tcl_HashTable *tablePtr,
sl@0: 			    VOID *keyPtr));
sl@0: #endif
sl@0: 
sl@0: /*
sl@0:  * Prototypes for the string hash key methods.
sl@0:  */
sl@0: 
sl@0: static Tcl_HashEntry *	AllocStringEntry _ANSI_ARGS_((
sl@0: 			    Tcl_HashTable *tablePtr,
sl@0: 			    VOID *keyPtr));
sl@0: static int		CompareStringKeys _ANSI_ARGS_((
sl@0: 			    VOID *keyPtr, Tcl_HashEntry *hPtr));
sl@0: static unsigned int	HashStringKey _ANSI_ARGS_((
sl@0: 			    Tcl_HashTable *tablePtr,
sl@0: 			    VOID *keyPtr));
sl@0: 
sl@0: /*
sl@0:  * Procedure prototypes for static procedures in this file:
sl@0:  */
sl@0: 
sl@0: #if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0: static Tcl_HashEntry *	BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
sl@0: 			    CONST char *key));
sl@0: static Tcl_HashEntry *	BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
sl@0: 			    CONST char *key, int *newPtr));
sl@0: #endif
sl@0: 
sl@0: static void		RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
sl@0: 
sl@0: Tcl_HashKeyType tclArrayHashKeyType = {
sl@0:     TCL_HASH_KEY_TYPE_VERSION,		/* version */
sl@0:     TCL_HASH_KEY_RANDOMIZE_HASH,	/* flags */
sl@0:     HashArrayKey,			/* hashKeyProc */
sl@0:     CompareArrayKeys,			/* compareKeysProc */
sl@0:     AllocArrayEntry,			/* allocEntryProc */
sl@0:     NULL				/* freeEntryProc */
sl@0: };
sl@0: 
sl@0: Tcl_HashKeyType tclOneWordHashKeyType = {
sl@0:     TCL_HASH_KEY_TYPE_VERSION,		/* version */
sl@0:     0,					/* flags */
sl@0:     NULL, /* HashOneWordKey, */		/* hashProc */
sl@0:     NULL, /* CompareOneWordKey, */	/* compareProc */
sl@0:     NULL, /* AllocOneWordKey, */	/* allocEntryProc */
sl@0:     NULL  /* FreeOneWordKey, */		/* freeEntryProc */
sl@0: };
sl@0: 
sl@0: Tcl_HashKeyType tclStringHashKeyType = {
sl@0:     TCL_HASH_KEY_TYPE_VERSION,		/* version */
sl@0:     0,					/* flags */
sl@0:     HashStringKey,			/* hashKeyProc */
sl@0:     CompareStringKeys,			/* compareKeysProc */
sl@0:     AllocStringEntry,			/* allocEntryProc */
sl@0:     NULL				/* freeEntryProc */
sl@0: };
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_InitHashTable --
sl@0:  *
sl@0:  *	Given storage for a hash table, set up the fields to prepare
sl@0:  *	the hash table for use.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	TablePtr is now ready to be passed to Tcl_FindHashEntry and
sl@0:  *	Tcl_CreateHashEntry.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: #undef Tcl_InitHashTable
sl@0: EXPORT_C void
sl@0: Tcl_InitHashTable(tablePtr, keyType)
sl@0:     register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
sl@0: 					 * is supplied by the caller. */
sl@0:     int keyType;			/* Type of keys to use in table:
sl@0: 					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
sl@0: 					 * or an integer >= 2. */
sl@0: {
sl@0:     /*
sl@0:      * Use a special value to inform the extended version that it must
sl@0:      * not access any of the new fields in the Tcl_HashTable. If an
sl@0:      * extension is rebuilt then any calls to this function will be
sl@0:      * redirected to the extended version by a macro.
sl@0:      */
sl@0:     Tcl_InitCustomHashTable(tablePtr, keyType, (Tcl_HashKeyType *) -1);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_InitCustomHashTable --
sl@0:  *
sl@0:  *	Given storage for a hash table, set up the fields to prepare
sl@0:  *	the hash table for use. This is an extended version of
sl@0:  *	Tcl_InitHashTable which supports user defined keys.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	TablePtr is now ready to be passed to Tcl_FindHashEntry and
sl@0:  *	Tcl_CreateHashEntry.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
sl@0:     register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
sl@0: 					 * is supplied by the caller. */
sl@0:     int keyType;			/* Type of keys to use in table:
sl@0: 					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
sl@0: 					 * TCL_CUSTOM_TYPE_KEYS,
sl@0: 					 * TCL_CUSTOM_PTR_KEYS,  or an
sl@0: 					 * integer >= 2. */
sl@0:     Tcl_HashKeyType *typePtr;		/* Pointer to structure which defines
sl@0: 					 * the behaviour of this table. */
sl@0: {
sl@0: #if (TCL_SMALL_HASH_TABLE != 4) 
sl@0:     panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
sl@0: 	    TCL_SMALL_HASH_TABLE);
sl@0: #endif
sl@0:     
sl@0:     tablePtr->buckets = tablePtr->staticBuckets;
sl@0:     tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
sl@0:     tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
sl@0:     tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
sl@0:     tablePtr->numEntries = 0;
sl@0:     tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
sl@0:     tablePtr->downShift = 28;
sl@0:     tablePtr->mask = 3;
sl@0:     tablePtr->keyType = keyType;
sl@0: #if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0:     tablePtr->findProc = Tcl_FindHashEntry;
sl@0:     tablePtr->createProc = Tcl_CreateHashEntry;
sl@0: 
sl@0:     if (typePtr == NULL) {
sl@0: 	/*
sl@0: 	 * The caller has been rebuilt so the hash table is an extended
sl@0: 	 * version.
sl@0: 	 */
sl@0:     } else if (typePtr != (Tcl_HashKeyType *) -1) {
sl@0: 	/*
sl@0: 	 * The caller is requesting a customized hash table so it must be
sl@0: 	 * an extended version.
sl@0: 	 */
sl@0: 	tablePtr->typePtr = typePtr;
sl@0:     } else {
sl@0: 	/*
sl@0: 	 * The caller has not been rebuilt so the hash table is not
sl@0: 	 * extended.
sl@0: 	 */
sl@0:     }
sl@0: #else
sl@0:     if (typePtr == NULL) {
sl@0: 	/*
sl@0: 	 * Use the key type to decide which key type is needed.
sl@0: 	 */
sl@0: 	if (keyType == TCL_STRING_KEYS) {
sl@0: 	    typePtr = &tclStringHashKeyType;
sl@0: 	} else if (keyType == TCL_ONE_WORD_KEYS) {
sl@0: 	    typePtr = &tclOneWordHashKeyType;
sl@0: 	} else if (keyType == TCL_CUSTOM_TYPE_KEYS) {
sl@0: 	    Tcl_Panic ("No type structure specified for TCL_CUSTOM_TYPE_KEYS");
sl@0: 	} else if (keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0: 	    Tcl_Panic ("No type structure specified for TCL_CUSTOM_PTR_KEYS");
sl@0: 	} else {
sl@0: 	    typePtr = &tclArrayHashKeyType;
sl@0: 	}
sl@0:     } else if (typePtr == (Tcl_HashKeyType *) -1) {
sl@0: 	/*
sl@0: 	 * If the caller has not been rebuilt then we cannot continue as
sl@0: 	 * the hash table is not an extended version.
sl@0: 	 */
sl@0: 	Tcl_Panic ("Hash table is not compatible");
sl@0:     }
sl@0:     tablePtr->typePtr = typePtr;
sl@0: #endif
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_FindHashEntry --
sl@0:  *
sl@0:  *	Given a hash table find the entry with a matching key.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is a token for the matching entry in the
sl@0:  *	hash table, or NULL if there was no matching entry.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C Tcl_HashEntry *
sl@0: Tcl_FindHashEntry(tablePtr, key)
sl@0:     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
sl@0:     CONST char *key;		/* Key to use to find matching entry. */
sl@0: {
sl@0:     register Tcl_HashEntry *hPtr;
sl@0:     Tcl_HashKeyType *typePtr;
sl@0:     unsigned int hash;
sl@0:     int index;
sl@0: 
sl@0: #if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0:     if (tablePtr->keyType == TCL_STRING_KEYS) {
sl@0: 	typePtr = &tclStringHashKeyType;
sl@0:     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
sl@0: 	typePtr = &tclOneWordHashKeyType;
sl@0:     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
sl@0: 	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0: 	typePtr = tablePtr->typePtr;
sl@0:     } else {
sl@0: 	typePtr = &tclArrayHashKeyType;
sl@0:     }
sl@0: #else
sl@0:     typePtr = tablePtr->typePtr;
sl@0:     if (typePtr == NULL) {
sl@0: 	Tcl_Panic("called Tcl_FindHashEntry on deleted table");
sl@0: 	return NULL;
sl@0:     }
sl@0: #endif
sl@0: 
sl@0:     if (typePtr->hashKeyProc) {
sl@0: 	hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
sl@0: 	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
sl@0: 	    index = RANDOM_INDEX (tablePtr, hash);
sl@0: 	} else {
sl@0: 	    index = hash & tablePtr->mask;
sl@0: 	}
sl@0:     } else {
sl@0: 	hash = (unsigned int) key;
sl@0: 	index = RANDOM_INDEX (tablePtr, hash);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Search all of the entries in the appropriate bucket.
sl@0:      */
sl@0: 
sl@0:     if (typePtr->compareKeysProc) {
sl@0: 	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
sl@0: 	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
sl@0: 	        hPtr = hPtr->nextPtr) {
sl@0: #if TCL_HASH_KEY_STORE_HASH
sl@0: 	    if (hash != (unsigned int) hPtr->hash) {
sl@0: 		continue;
sl@0: 	    }
sl@0: #endif
sl@0: 	    if (compareKeysProc ((VOID *) key, hPtr)) {
sl@0: 		return hPtr;
sl@0: 	    }
sl@0: 	}
sl@0:     } else {
sl@0: 	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
sl@0: 	        hPtr = hPtr->nextPtr) {
sl@0: #if TCL_HASH_KEY_STORE_HASH
sl@0: 	    if (hash != (unsigned int) hPtr->hash) {
sl@0: 		continue;
sl@0: 	    }
sl@0: #endif
sl@0: 	    if (key == hPtr->key.oneWordValue) {
sl@0: 		return hPtr;
sl@0: 	    }
sl@0: 	}
sl@0:     }
sl@0:     
sl@0:     return NULL;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_CreateHashEntry --
sl@0:  *
sl@0:  *	Given a hash table with string keys, and a string key, find
sl@0:  *	the entry with a matching key.  If there is no matching entry,
sl@0:  *	then create a new entry that does match.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is a pointer to the matching entry.  If this
sl@0:  *	is a newly-created entry, then *newPtr will be set to a non-zero
sl@0:  *	value;  otherwise *newPtr will be set to 0.  If this is a new
sl@0:  *	entry the value stored in the entry will initially be 0.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	A new entry may be added to the hash table.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C Tcl_HashEntry *
sl@0: Tcl_CreateHashEntry(tablePtr, key, newPtr)
sl@0:     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
sl@0:     CONST char *key;		/* Key to use to find or create matching
sl@0: 				 * entry. */
sl@0:     int *newPtr;		/* Store info here telling whether a new
sl@0: 				 * entry was created. */
sl@0: {
sl@0:     register Tcl_HashEntry *hPtr;
sl@0:     Tcl_HashKeyType *typePtr;
sl@0:     unsigned int hash;
sl@0:     int index;
sl@0: 
sl@0: #if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0:     if (tablePtr->keyType == TCL_STRING_KEYS) {
sl@0: 	typePtr = &tclStringHashKeyType;
sl@0:     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
sl@0: 	typePtr = &tclOneWordHashKeyType;
sl@0:     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
sl@0: 	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0: 	typePtr = tablePtr->typePtr;
sl@0:     } else {
sl@0: 	typePtr = &tclArrayHashKeyType;
sl@0:     }
sl@0: #else
sl@0:     typePtr = tablePtr->typePtr;
sl@0:     if (typePtr == NULL) {
sl@0: 	Tcl_Panic("called Tcl_CreateHashEntry on deleted table");
sl@0: 	return NULL;
sl@0:     }
sl@0: #endif
sl@0: 
sl@0:     if (typePtr->hashKeyProc) {
sl@0: 	hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
sl@0: 	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
sl@0: 	    index = RANDOM_INDEX (tablePtr, hash);
sl@0: 	} else {
sl@0: 	    index = hash & tablePtr->mask;
sl@0: 	}
sl@0:     } else {
sl@0: 	hash = (unsigned int) key;
sl@0: 	index = RANDOM_INDEX (tablePtr, hash);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Search all of the entries in the appropriate bucket.
sl@0:      */
sl@0: 
sl@0:     if (typePtr->compareKeysProc) {
sl@0: 	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
sl@0: 	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
sl@0: 	        hPtr = hPtr->nextPtr) {
sl@0: #if TCL_HASH_KEY_STORE_HASH
sl@0: 	    if (hash != (unsigned int) hPtr->hash) {
sl@0: 		continue;
sl@0: 	    }
sl@0: #endif
sl@0: 	    if (compareKeysProc ((VOID *) key, hPtr)) {
sl@0: 		*newPtr = 0;
sl@0: 		return hPtr;
sl@0: 	    }
sl@0: 	}
sl@0:     } else {
sl@0: 	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
sl@0: 	        hPtr = hPtr->nextPtr) {
sl@0: #if TCL_HASH_KEY_STORE_HASH
sl@0: 	    if (hash != (unsigned int) hPtr->hash) {
sl@0: 		continue;
sl@0: 	    }
sl@0: #endif
sl@0: 	    if (key == hPtr->key.oneWordValue) {
sl@0: 		*newPtr = 0;
sl@0: 		return hPtr;
sl@0: 	    }
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Entry not found.  Add a new one to the bucket.
sl@0:      */
sl@0: 
sl@0:     *newPtr = 1;
sl@0:     if (typePtr->allocEntryProc) {
sl@0: 	hPtr = typePtr->allocEntryProc (tablePtr, (VOID *) key);
sl@0:     } else {
sl@0: 	hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
sl@0: 	hPtr->key.oneWordValue = (char *) key;
sl@0:     }
sl@0: 					 
sl@0:     hPtr->tablePtr = tablePtr;
sl@0: #if TCL_HASH_KEY_STORE_HASH
sl@0: #   if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0:     hPtr->hash = (VOID *) hash;
sl@0: #   else
sl@0:     hPtr->hash = hash;
sl@0: #   endif
sl@0:     hPtr->nextPtr = tablePtr->buckets[index];
sl@0:     tablePtr->buckets[index] = hPtr;
sl@0: #else
sl@0:     hPtr->bucketPtr = &(tablePtr->buckets[index]);
sl@0:     hPtr->nextPtr = *hPtr->bucketPtr;
sl@0:     *hPtr->bucketPtr = hPtr;
sl@0: #endif
sl@0:     hPtr->clientData = 0;
sl@0:     tablePtr->numEntries++;
sl@0: 
sl@0:     /*
sl@0:      * If the table has exceeded a decent size, rebuild it with many
sl@0:      * more buckets.
sl@0:      */
sl@0: 
sl@0:     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
sl@0: 	RebuildTable(tablePtr);
sl@0:     }
sl@0:     return hPtr;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_DeleteHashEntry --
sl@0:  *
sl@0:  *	Remove a single entry from a hash table.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The entry given by entryPtr is deleted from its table and
sl@0:  *	should never again be used by the caller.  It is up to the
sl@0:  *	caller to free the clientData field of the entry, if that
sl@0:  *	is relevant.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_DeleteHashEntry(entryPtr)
sl@0:     Tcl_HashEntry *entryPtr;
sl@0: {
sl@0:     register Tcl_HashEntry *prevPtr;
sl@0:     Tcl_HashKeyType *typePtr;
sl@0:     Tcl_HashTable *tablePtr;
sl@0:     Tcl_HashEntry **bucketPtr;
sl@0: #if TCL_HASH_KEY_STORE_HASH
sl@0:     int index;
sl@0: #endif
sl@0: 
sl@0:     tablePtr = entryPtr->tablePtr;
sl@0: 
sl@0: #if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0:     if (tablePtr->keyType == TCL_STRING_KEYS) {
sl@0: 	typePtr = &tclStringHashKeyType;
sl@0:     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
sl@0: 	typePtr = &tclOneWordHashKeyType;
sl@0:     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
sl@0: 	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0: 	typePtr = tablePtr->typePtr;
sl@0:     } else {
sl@0: 	typePtr = &tclArrayHashKeyType;
sl@0:     }
sl@0: #else
sl@0:     typePtr = tablePtr->typePtr;
sl@0: #endif
sl@0:     
sl@0: #if TCL_HASH_KEY_STORE_HASH
sl@0:     if (typePtr->hashKeyProc == NULL
sl@0: 	|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
sl@0: 	index = RANDOM_INDEX (tablePtr, entryPtr->hash);
sl@0:     } else {
sl@0: 	index = ((unsigned int) entryPtr->hash) & tablePtr->mask;
sl@0:     }
sl@0: 
sl@0:     bucketPtr = &(tablePtr->buckets[index]);
sl@0: #else
sl@0:     bucketPtr = entryPtr->bucketPtr;
sl@0: #endif
sl@0:     
sl@0:     if (*bucketPtr == entryPtr) {
sl@0: 	*bucketPtr = entryPtr->nextPtr;
sl@0:     } else {
sl@0: 	for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) {
sl@0: 	    if (prevPtr == NULL) {
sl@0: 		panic("malformed bucket chain in Tcl_DeleteHashEntry");
sl@0: 	    }
sl@0: 	    if (prevPtr->nextPtr == entryPtr) {
sl@0: 		prevPtr->nextPtr = entryPtr->nextPtr;
sl@0: 		break;
sl@0: 	    }
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     tablePtr->numEntries--;
sl@0:     if (typePtr->freeEntryProc) {
sl@0: 	typePtr->freeEntryProc (entryPtr);
sl@0:     } else {
sl@0: 	ckfree((char *) entryPtr);
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_DeleteHashTable --
sl@0:  *
sl@0:  *	Free up everything associated with a hash table except for
sl@0:  *	the record for the table itself.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The hash table is no longer useable.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C void
sl@0: Tcl_DeleteHashTable(tablePtr)
sl@0:     register Tcl_HashTable *tablePtr;		/* Table to delete. */
sl@0: {
sl@0:     register Tcl_HashEntry *hPtr, *nextPtr;
sl@0:     Tcl_HashKeyType *typePtr;
sl@0:     int i;
sl@0: 
sl@0: #if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0:     if (tablePtr->keyType == TCL_STRING_KEYS) {
sl@0: 	typePtr = &tclStringHashKeyType;
sl@0:     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
sl@0: 	typePtr = &tclOneWordHashKeyType;
sl@0:     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
sl@0: 	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0: 	typePtr = tablePtr->typePtr;
sl@0:     } else {
sl@0: 	typePtr = &tclArrayHashKeyType;
sl@0:     }
sl@0: #else
sl@0:     typePtr = tablePtr->typePtr;
sl@0: #endif
sl@0: 
sl@0:     /*
sl@0:      * Free up all the entries in the table.
sl@0:      */
sl@0: 
sl@0:     for (i = 0; i < tablePtr->numBuckets; i++) {
sl@0: 	hPtr = tablePtr->buckets[i];
sl@0: 	while (hPtr != NULL) {
sl@0: 	    nextPtr = hPtr->nextPtr;
sl@0: 	    if (typePtr->freeEntryProc) {
sl@0: 		typePtr->freeEntryProc (hPtr);
sl@0: 	    } else {
sl@0: 		ckfree((char *) hPtr);
sl@0: 	    }
sl@0: 	    hPtr = nextPtr;
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Free up the bucket array, if it was dynamically allocated.
sl@0:      */
sl@0: 
sl@0:     if (tablePtr->buckets != tablePtr->staticBuckets) {
sl@0: 	ckfree((char *) tablePtr->buckets);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Arrange for panics if the table is used again without
sl@0:      * re-initialization.
sl@0:      */
sl@0: 
sl@0: #if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0:     tablePtr->findProc = BogusFind;
sl@0:     tablePtr->createProc = BogusCreate;
sl@0: #else
sl@0:     tablePtr->typePtr = NULL;
sl@0: #endif
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_FirstHashEntry --
sl@0:  *
sl@0:  *	Locate the first entry in a hash table and set up a record
sl@0:  *	that can be used to step through all the remaining entries
sl@0:  *	of the table.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is a pointer to the first entry in tablePtr,
sl@0:  *	or NULL if tablePtr has no entries in it.  The memory at
sl@0:  *	*searchPtr is initialized so that subsequent calls to
sl@0:  *	Tcl_NextHashEntry will return all of the entries in the table,
sl@0:  *	one at a time.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C Tcl_HashEntry *
sl@0: Tcl_FirstHashEntry(tablePtr, searchPtr)
sl@0:     Tcl_HashTable *tablePtr;		/* Table to search. */
sl@0:     Tcl_HashSearch *searchPtr;		/* Place to store information about
sl@0: 					 * progress through the table. */
sl@0: {
sl@0:     searchPtr->tablePtr = tablePtr;
sl@0:     searchPtr->nextIndex = 0;
sl@0:     searchPtr->nextEntryPtr = NULL;
sl@0:     return Tcl_NextHashEntry(searchPtr);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_NextHashEntry --
sl@0:  *
sl@0:  *	Once a hash table enumeration has been initiated by calling
sl@0:  *	Tcl_FirstHashEntry, this procedure may be called to return
sl@0:  *	successive elements of the table.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is the next entry in the hash table being
sl@0:  *	enumerated, or NULL if the end of the table is reached.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C Tcl_HashEntry *
sl@0: Tcl_NextHashEntry(searchPtr)
sl@0:     register Tcl_HashSearch *searchPtr;	/* Place to store information about
sl@0: 					 * progress through the table.  Must
sl@0: 					 * have been initialized by calling
sl@0: 					 * Tcl_FirstHashEntry. */
sl@0: {
sl@0:     Tcl_HashEntry *hPtr;
sl@0:     Tcl_HashTable *tablePtr = searchPtr->tablePtr;
sl@0: 
sl@0:     while (searchPtr->nextEntryPtr == NULL) {
sl@0: 	if (searchPtr->nextIndex >= tablePtr->numBuckets) {
sl@0: 	    return NULL;
sl@0: 	}
sl@0: 	searchPtr->nextEntryPtr =
sl@0: 		tablePtr->buckets[searchPtr->nextIndex];
sl@0: 	searchPtr->nextIndex++;
sl@0:     }
sl@0:     hPtr = searchPtr->nextEntryPtr;
sl@0:     searchPtr->nextEntryPtr = hPtr->nextPtr;
sl@0:     return hPtr;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_HashStats --
sl@0:  *
sl@0:  *	Return statistics describing the layout of the hash table
sl@0:  *	in its hash buckets.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is a malloc-ed string containing information
sl@0:  *	about tablePtr.  It is the caller's responsibility to free
sl@0:  *	this string.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: EXPORT_C CONST char *
sl@0: Tcl_HashStats(tablePtr)
sl@0:     Tcl_HashTable *tablePtr;		/* Table for which to produce stats. */
sl@0: {
sl@0: #define NUM_COUNTERS 10
sl@0:     int count[NUM_COUNTERS], overflow, i, j;
sl@0:     double average, tmp;
sl@0:     register Tcl_HashEntry *hPtr;
sl@0:     char *result, *p;
sl@0: 
sl@0:     /*
sl@0:      * Compute a histogram of bucket usage.
sl@0:      */
sl@0: 
sl@0:     for (i = 0; i < NUM_COUNTERS; i++) {
sl@0: 	count[i] = 0;
sl@0:     }
sl@0:     overflow = 0;
sl@0:     average = 0.0;
sl@0:     for (i = 0; i < tablePtr->numBuckets; i++) {
sl@0: 	j = 0;
sl@0: 	for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
sl@0: 	    j++;
sl@0: 	}
sl@0: 	if (j < NUM_COUNTERS) {
sl@0: 	    count[j]++;
sl@0: 	} else {
sl@0: 	    overflow++;
sl@0: 	}
sl@0: 	tmp = j;
sl@0: 	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Print out the histogram and a few other pieces of information.
sl@0:      */
sl@0: 
sl@0:     result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
sl@0:     sprintf(result, "%d entries in table, %d buckets\n",
sl@0: 	    tablePtr->numEntries, tablePtr->numBuckets);
sl@0:     p = result + strlen(result);
sl@0:     for (i = 0; i < NUM_COUNTERS; i++) {
sl@0: 	sprintf(p, "number of buckets with %d entries: %d\n",
sl@0: 		i, count[i]);
sl@0: 	p += strlen(p);
sl@0:     }
sl@0:     sprintf(p, "number of buckets with %d or more entries: %d\n",
sl@0: 	    NUM_COUNTERS, overflow);
sl@0:     p += strlen(p);
sl@0:     sprintf(p, "average search distance for entry: %.1f", average);
sl@0:     return result;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * AllocArrayEntry --
sl@0:  *
sl@0:  *	Allocate space for a Tcl_HashEntry containing the array key.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is a pointer to the created entry.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static Tcl_HashEntry *
sl@0: AllocArrayEntry(tablePtr, keyPtr)
sl@0:     Tcl_HashTable *tablePtr;	/* Hash table. */
sl@0:     VOID *keyPtr;		/* Key to store in the hash table entry. */
sl@0: {
sl@0:     int *array = (int *) keyPtr;
sl@0:     register int *iPtr1, *iPtr2;
sl@0:     Tcl_HashEntry *hPtr;
sl@0:     int count;
sl@0:     unsigned int size;
sl@0: 
sl@0:     count = tablePtr->keyType;
sl@0:     
sl@0:     size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
sl@0:     if (size < sizeof(Tcl_HashEntry))
sl@0: 	size = sizeof(Tcl_HashEntry);
sl@0:     hPtr = (Tcl_HashEntry *) ckalloc(size);
sl@0:     
sl@0:     for (iPtr1 = array, iPtr2 = hPtr->key.words;
sl@0: 	    count > 0; count--, iPtr1++, iPtr2++) {
sl@0: 	*iPtr2 = *iPtr1;
sl@0:     }
sl@0: 
sl@0:     return hPtr;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * CompareArrayKeys --
sl@0:  *
sl@0:  *	Compares two array keys.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is 0 if they are different and 1 if they are
sl@0:  *	the same.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: CompareArrayKeys(keyPtr, hPtr)
sl@0:     VOID *keyPtr;		/* New key to compare. */
sl@0:     Tcl_HashEntry *hPtr;	/* Existing key to compare. */
sl@0: {
sl@0:     register CONST int *iPtr1 = (CONST int *) keyPtr;
sl@0:     register CONST int *iPtr2 = (CONST int *) hPtr->key.words;
sl@0:     Tcl_HashTable *tablePtr = hPtr->tablePtr;
sl@0:     int count;
sl@0: 
sl@0:     for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
sl@0: 	if (count == 0) {
sl@0: 	    return 1;
sl@0: 	}
sl@0: 	if (*iPtr1 != *iPtr2) {
sl@0: 	    break;
sl@0: 	}
sl@0:     }
sl@0:     return 0;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * HashArrayKey --
sl@0:  *
sl@0:  *	Compute a one-word summary of an array, which can be
sl@0:  *	used to generate a hash index.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is a one-word summary of the information in
sl@0:  *	string.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static unsigned int
sl@0: HashArrayKey(tablePtr, keyPtr)
sl@0:     Tcl_HashTable *tablePtr;	/* Hash table. */
sl@0:     VOID *keyPtr;		/* Key from which to compute hash value. */
sl@0: {
sl@0:     register CONST int *array = (CONST int *) keyPtr;
sl@0:     register unsigned int result;
sl@0:     int count;
sl@0: 
sl@0:     for (result = 0, count = tablePtr->keyType; count > 0;
sl@0: 	    count--, array++) {
sl@0: 	result += *array;
sl@0:     }
sl@0:     return result;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * AllocStringEntry --
sl@0:  *
sl@0:  *	Allocate space for a Tcl_HashEntry containing the string key.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is a pointer to the created entry.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static Tcl_HashEntry *
sl@0: AllocStringEntry(tablePtr, keyPtr)
sl@0:     Tcl_HashTable *tablePtr;	/* Hash table. */
sl@0:     VOID *keyPtr;		/* Key to store in the hash table entry. */
sl@0: {
sl@0:     CONST char *string = (CONST char *) keyPtr;
sl@0:     Tcl_HashEntry *hPtr;
sl@0:     unsigned int size;
sl@0: 
sl@0:     size = sizeof(Tcl_HashEntry) + strlen(string) + 1 - sizeof(hPtr->key);
sl@0:     if (size < sizeof(Tcl_HashEntry))
sl@0: 	size = sizeof(Tcl_HashEntry);
sl@0:     hPtr = (Tcl_HashEntry *) ckalloc(size);
sl@0:     strcpy(hPtr->key.string, string);
sl@0: 
sl@0:     return hPtr;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * CompareStringKeys --
sl@0:  *
sl@0:  *	Compares two string keys.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is 0 if they are different and 1 if they are
sl@0:  *	the same.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static int
sl@0: CompareStringKeys(keyPtr, hPtr)
sl@0:     VOID *keyPtr;		/* New key to compare. */
sl@0:     Tcl_HashEntry *hPtr;		/* Existing key to compare. */
sl@0: {
sl@0:     register CONST char *p1 = (CONST char *) keyPtr;
sl@0:     register CONST char *p2 = (CONST char *) hPtr->key.string;
sl@0: 
sl@0:     for (;; p1++, p2++) {
sl@0: 	if (*p1 != *p2) {
sl@0: 	    break;
sl@0: 	}
sl@0: 	if (*p1 == '\0') {
sl@0: 	    return 1;
sl@0: 	}
sl@0:     }
sl@0:     return 0;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * HashStringKey --
sl@0:  *
sl@0:  *	Compute a one-word summary of a text string, which can be
sl@0:  *	used to generate a hash index.
sl@0:  *
sl@0:  * Results:
sl@0:  *	The return value is a one-word summary of the information in
sl@0:  *	string.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static unsigned int
sl@0: HashStringKey(tablePtr, keyPtr)
sl@0:     Tcl_HashTable *tablePtr;	/* Hash table. */
sl@0:     VOID *keyPtr;		/* Key from which to compute hash value. */
sl@0: {
sl@0:     register CONST char *string = (CONST char *) keyPtr;
sl@0:     register unsigned int result;
sl@0:     register int c;
sl@0: 
sl@0:     /*
sl@0:      * I tried a zillion different hash functions and asked many other
sl@0:      * people for advice.  Many people had their own favorite functions,
sl@0:      * all different, but no-one had much idea why they were good ones.
sl@0:      * I chose the one below (multiply by 9 and add new character)
sl@0:      * because of the following reasons:
sl@0:      *
sl@0:      * 1. Multiplying by 10 is perfect for keys that are decimal strings,
sl@0:      *    and multiplying by 9 is just about as good.
sl@0:      * 2. Times-9 is (shift-left-3) plus (old).  This means that each
sl@0:      *    character's bits hang around in the low-order bits of the
sl@0:      *    hash value for ever, plus they spread fairly rapidly up to
sl@0:      *    the high-order bits to fill out the hash value.  This seems
sl@0:      *    works well both for decimal and non-decimal strings.
sl@0:      */
sl@0: 
sl@0:     result = 0;
sl@0:     while (1) {
sl@0: 	c = *string;
sl@0: 	if (c == 0) {
sl@0: 	    break;
sl@0: 	}
sl@0: 	result += (result<<3) + c;
sl@0: 	string++;
sl@0:     }
sl@0:     return result;
sl@0: }
sl@0: 
sl@0: #if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * BogusFind --
sl@0:  *
sl@0:  *	This procedure is invoked when an Tcl_FindHashEntry is called
sl@0:  *	on a table that has been deleted.
sl@0:  *
sl@0:  * Results:
sl@0:  *	If panic returns (which it shouldn't) this procedure returns
sl@0:  *	NULL.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Generates a panic.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: 	/* ARGSUSED */
sl@0: static Tcl_HashEntry *
sl@0: BogusFind(tablePtr, key)
sl@0:     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
sl@0:     CONST char *key;		/* Key to use to find matching entry. */
sl@0: {
sl@0:     panic("called Tcl_FindHashEntry on deleted table");
sl@0:     return NULL;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * BogusCreate --
sl@0:  *
sl@0:  *	This procedure is invoked when an Tcl_CreateHashEntry is called
sl@0:  *	on a table that has been deleted.
sl@0:  *
sl@0:  * Results:
sl@0:  *	If panic returns (which it shouldn't) this procedure returns
sl@0:  *	NULL.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Generates a panic.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: 	/* ARGSUSED */
sl@0: static Tcl_HashEntry *
sl@0: BogusCreate(tablePtr, key, newPtr)
sl@0:     Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
sl@0:     CONST char *key;		/* Key to use to find or create matching
sl@0: 				 * entry. */
sl@0:     int *newPtr;		/* Store info here telling whether a new
sl@0: 				 * entry was created. */
sl@0: {
sl@0:     panic("called Tcl_CreateHashEntry on deleted table");
sl@0:     return NULL;
sl@0: }
sl@0: #endif
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * RebuildTable --
sl@0:  *
sl@0:  *	This procedure is invoked when the ratio of entries to hash
sl@0:  *	buckets becomes too large.  It creates a new table with a
sl@0:  *	larger bucket array and moves all of the entries into the
sl@0:  *	new table.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Memory gets reallocated and entries get re-hashed to new
sl@0:  *	buckets.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: RebuildTable(tablePtr)
sl@0:     register Tcl_HashTable *tablePtr;	/* Table to enlarge. */
sl@0: {
sl@0:     int oldSize, count, index;
sl@0:     Tcl_HashEntry **oldBuckets;
sl@0:     register Tcl_HashEntry **oldChainPtr, **newChainPtr;
sl@0:     register Tcl_HashEntry *hPtr;
sl@0:     Tcl_HashKeyType *typePtr;
sl@0:     VOID *key;
sl@0: 
sl@0:     oldSize = tablePtr->numBuckets;
sl@0:     oldBuckets = tablePtr->buckets;
sl@0: 
sl@0:     /*
sl@0:      * Allocate and initialize the new bucket array, and set up
sl@0:      * hashing constants for new array size.
sl@0:      */
sl@0: 
sl@0:     tablePtr->numBuckets *= 4;
sl@0:     tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
sl@0: 	    (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
sl@0:     for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
sl@0: 	    count > 0; count--, newChainPtr++) {
sl@0: 	*newChainPtr = NULL;
sl@0:     }
sl@0:     tablePtr->rebuildSize *= 4;
sl@0:     tablePtr->downShift -= 2;
sl@0:     tablePtr->mask = (tablePtr->mask << 2) + 3;
sl@0: 
sl@0: #if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0:     if (tablePtr->keyType == TCL_STRING_KEYS) {
sl@0: 	typePtr = &tclStringHashKeyType;
sl@0:     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
sl@0: 	typePtr = &tclOneWordHashKeyType;
sl@0:     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
sl@0: 	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0: 	typePtr = tablePtr->typePtr;
sl@0:     } else {
sl@0: 	typePtr = &tclArrayHashKeyType;
sl@0:     }
sl@0: #else
sl@0:     typePtr = tablePtr->typePtr;
sl@0: #endif
sl@0: 
sl@0:     /*
sl@0:      * Rehash all of the existing entries into the new bucket array.
sl@0:      */
sl@0: 
sl@0:     for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
sl@0: 	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
sl@0: 	    *oldChainPtr = hPtr->nextPtr;
sl@0: 
sl@0: 	    key = (VOID *) Tcl_GetHashKey (tablePtr, hPtr);
sl@0: 
sl@0: #if TCL_HASH_KEY_STORE_HASH
sl@0: 	    if (typePtr->hashKeyProc == NULL
sl@0: 		|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
sl@0: 		index = RANDOM_INDEX (tablePtr, hPtr->hash);
sl@0: 	    } else {
sl@0: 		index = ((unsigned int) hPtr->hash) & tablePtr->mask;
sl@0: 	    }
sl@0: 	    hPtr->nextPtr = tablePtr->buckets[index];
sl@0: 	    tablePtr->buckets[index] = hPtr;
sl@0: #else
sl@0: 	    if (typePtr->hashKeyProc) {
sl@0: 		unsigned int hash;
sl@0: 		hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
sl@0: 		if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
sl@0: 		    index = RANDOM_INDEX (tablePtr, hash);
sl@0: 		} else {
sl@0: 		    index = hash & tablePtr->mask;
sl@0: 		}
sl@0: 	    } else {
sl@0: 		index = RANDOM_INDEX (tablePtr, key);
sl@0: 	    }
sl@0: 
sl@0: 	    hPtr->bucketPtr = &(tablePtr->buckets[index]);
sl@0: 	    hPtr->nextPtr = *hPtr->bucketPtr;
sl@0: 	    *hPtr->bucketPtr = hPtr;
sl@0: #endif
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Free up the old bucket array, if it was dynamically allocated.
sl@0:      */
sl@0: 
sl@0:     if (oldBuckets != tablePtr->staticBuckets) {
sl@0: 	ckfree((char *) oldBuckets);
sl@0:     }
sl@0: }