os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclHash.c
changeset 0 bde4ae8d615e
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclHash.c	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,1207 @@
     1.4 +/* 
     1.5 + * tclHash.c --
     1.6 + *
     1.7 + *	Implementation of in-memory hash tables for Tcl and Tcl-based
     1.8 + *	applications.
     1.9 + *
    1.10 + * Copyright (c) 1991-1993 The Regents of the University of California.
    1.11 + * Copyright (c) 1994 Sun Microsystems, Inc.
    1.12 + * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  
    1.13 + *
    1.14 + * See the file "license.terms" for information on usage and redistribution
    1.15 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    1.16 + *
    1.17 + * RCS: @(#) $Id: tclHash.c,v 1.12.2.1 2004/11/11 01:18:07 das Exp $
    1.18 + */
    1.19 +
    1.20 +#include "tclInt.h"
    1.21 +
    1.22 +/*
    1.23 + * Prevent macros from clashing with function definitions.
    1.24 + */
    1.25 +
    1.26 +#if TCL_PRESERVE_BINARY_COMPATABILITY
    1.27 +#   undef Tcl_FindHashEntry
    1.28 +#   undef Tcl_CreateHashEntry
    1.29 +#endif
    1.30 +
    1.31 +/*
    1.32 + * When there are this many entries per bucket, on average, rebuild
    1.33 + * the hash table to make it larger.
    1.34 + */
    1.35 +
    1.36 +#define REBUILD_MULTIPLIER	3
    1.37 +
    1.38 +/*
    1.39 + * The following macro takes a preliminary integer hash value and
    1.40 + * produces an index into a hash tables bucket list.  The idea is
    1.41 + * to make it so that preliminary values that are arbitrarily similar
    1.42 + * will end up in different buckets.  The hash function was taken
    1.43 + * from a random-number generator.
    1.44 + */
    1.45 +
    1.46 +#define RANDOM_INDEX(tablePtr, i) \
    1.47 +    (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
    1.48 +
    1.49 +/*
    1.50 + * Prototypes for the array hash key methods.
    1.51 + */
    1.52 +
    1.53 +static Tcl_HashEntry *	AllocArrayEntry _ANSI_ARGS_((
    1.54 +			    Tcl_HashTable *tablePtr,
    1.55 +			    VOID *keyPtr));
    1.56 +static int		CompareArrayKeys _ANSI_ARGS_((
    1.57 +			    VOID *keyPtr, Tcl_HashEntry *hPtr));
    1.58 +static unsigned int	HashArrayKey _ANSI_ARGS_((
    1.59 +			    Tcl_HashTable *tablePtr,
    1.60 +			    VOID *keyPtr));
    1.61 +
    1.62 +/*
    1.63 + * Prototypes for the one word hash key methods.
    1.64 + */
    1.65 +
    1.66 +#if 0
    1.67 +static Tcl_HashEntry *	AllocOneWordEntry _ANSI_ARGS_((
    1.68 +			    Tcl_HashTable *tablePtr,
    1.69 +			    VOID *keyPtr));
    1.70 +static int		CompareOneWordKeys _ANSI_ARGS_((
    1.71 +			    VOID *keyPtr, Tcl_HashEntry *hPtr));
    1.72 +static unsigned int	HashOneWordKey _ANSI_ARGS_((
    1.73 +			    Tcl_HashTable *tablePtr,
    1.74 +			    VOID *keyPtr));
    1.75 +#endif
    1.76 +
    1.77 +/*
    1.78 + * Prototypes for the string hash key methods.
    1.79 + */
    1.80 +
    1.81 +static Tcl_HashEntry *	AllocStringEntry _ANSI_ARGS_((
    1.82 +			    Tcl_HashTable *tablePtr,
    1.83 +			    VOID *keyPtr));
    1.84 +static int		CompareStringKeys _ANSI_ARGS_((
    1.85 +			    VOID *keyPtr, Tcl_HashEntry *hPtr));
    1.86 +static unsigned int	HashStringKey _ANSI_ARGS_((
    1.87 +			    Tcl_HashTable *tablePtr,
    1.88 +			    VOID *keyPtr));
    1.89 +
    1.90 +/*
    1.91 + * Procedure prototypes for static procedures in this file:
    1.92 + */
    1.93 +
    1.94 +#if TCL_PRESERVE_BINARY_COMPATABILITY
    1.95 +static Tcl_HashEntry *	BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
    1.96 +			    CONST char *key));
    1.97 +static Tcl_HashEntry *	BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
    1.98 +			    CONST char *key, int *newPtr));
    1.99 +#endif
   1.100 +
   1.101 +static void		RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
   1.102 +
   1.103 +Tcl_HashKeyType tclArrayHashKeyType = {
   1.104 +    TCL_HASH_KEY_TYPE_VERSION,		/* version */
   1.105 +    TCL_HASH_KEY_RANDOMIZE_HASH,	/* flags */
   1.106 +    HashArrayKey,			/* hashKeyProc */
   1.107 +    CompareArrayKeys,			/* compareKeysProc */
   1.108 +    AllocArrayEntry,			/* allocEntryProc */
   1.109 +    NULL				/* freeEntryProc */
   1.110 +};
   1.111 +
   1.112 +Tcl_HashKeyType tclOneWordHashKeyType = {
   1.113 +    TCL_HASH_KEY_TYPE_VERSION,		/* version */
   1.114 +    0,					/* flags */
   1.115 +    NULL, /* HashOneWordKey, */		/* hashProc */
   1.116 +    NULL, /* CompareOneWordKey, */	/* compareProc */
   1.117 +    NULL, /* AllocOneWordKey, */	/* allocEntryProc */
   1.118 +    NULL  /* FreeOneWordKey, */		/* freeEntryProc */
   1.119 +};
   1.120 +
   1.121 +Tcl_HashKeyType tclStringHashKeyType = {
   1.122 +    TCL_HASH_KEY_TYPE_VERSION,		/* version */
   1.123 +    0,					/* flags */
   1.124 +    HashStringKey,			/* hashKeyProc */
   1.125 +    CompareStringKeys,			/* compareKeysProc */
   1.126 +    AllocStringEntry,			/* allocEntryProc */
   1.127 +    NULL				/* freeEntryProc */
   1.128 +};
   1.129 +
   1.130 +
   1.131 +/*
   1.132 + *----------------------------------------------------------------------
   1.133 + *
   1.134 + * Tcl_InitHashTable --
   1.135 + *
   1.136 + *	Given storage for a hash table, set up the fields to prepare
   1.137 + *	the hash table for use.
   1.138 + *
   1.139 + * Results:
   1.140 + *	None.
   1.141 + *
   1.142 + * Side effects:
   1.143 + *	TablePtr is now ready to be passed to Tcl_FindHashEntry and
   1.144 + *	Tcl_CreateHashEntry.
   1.145 + *
   1.146 + *----------------------------------------------------------------------
   1.147 + */
   1.148 +
   1.149 +#undef Tcl_InitHashTable
   1.150 +EXPORT_C void
   1.151 +Tcl_InitHashTable(tablePtr, keyType)
   1.152 +    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
   1.153 +					 * is supplied by the caller. */
   1.154 +    int keyType;			/* Type of keys to use in table:
   1.155 +					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
   1.156 +					 * or an integer >= 2. */
   1.157 +{
   1.158 +    /*
   1.159 +     * Use a special value to inform the extended version that it must
   1.160 +     * not access any of the new fields in the Tcl_HashTable. If an
   1.161 +     * extension is rebuilt then any calls to this function will be
   1.162 +     * redirected to the extended version by a macro.
   1.163 +     */
   1.164 +    Tcl_InitCustomHashTable(tablePtr, keyType, (Tcl_HashKeyType *) -1);
   1.165 +}
   1.166 +
   1.167 +/*
   1.168 + *----------------------------------------------------------------------
   1.169 + *
   1.170 + * Tcl_InitCustomHashTable --
   1.171 + *
   1.172 + *	Given storage for a hash table, set up the fields to prepare
   1.173 + *	the hash table for use. This is an extended version of
   1.174 + *	Tcl_InitHashTable which supports user defined keys.
   1.175 + *
   1.176 + * Results:
   1.177 + *	None.
   1.178 + *
   1.179 + * Side effects:
   1.180 + *	TablePtr is now ready to be passed to Tcl_FindHashEntry and
   1.181 + *	Tcl_CreateHashEntry.
   1.182 + *
   1.183 + *----------------------------------------------------------------------
   1.184 + */
   1.185 +
   1.186 +EXPORT_C void
   1.187 +Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
   1.188 +    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
   1.189 +					 * is supplied by the caller. */
   1.190 +    int keyType;			/* Type of keys to use in table:
   1.191 +					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
   1.192 +					 * TCL_CUSTOM_TYPE_KEYS,
   1.193 +					 * TCL_CUSTOM_PTR_KEYS,  or an
   1.194 +					 * integer >= 2. */
   1.195 +    Tcl_HashKeyType *typePtr;		/* Pointer to structure which defines
   1.196 +					 * the behaviour of this table. */
   1.197 +{
   1.198 +#if (TCL_SMALL_HASH_TABLE != 4) 
   1.199 +    panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
   1.200 +	    TCL_SMALL_HASH_TABLE);
   1.201 +#endif
   1.202 +    
   1.203 +    tablePtr->buckets = tablePtr->staticBuckets;
   1.204 +    tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
   1.205 +    tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
   1.206 +    tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
   1.207 +    tablePtr->numEntries = 0;
   1.208 +    tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
   1.209 +    tablePtr->downShift = 28;
   1.210 +    tablePtr->mask = 3;
   1.211 +    tablePtr->keyType = keyType;
   1.212 +#if TCL_PRESERVE_BINARY_COMPATABILITY
   1.213 +    tablePtr->findProc = Tcl_FindHashEntry;
   1.214 +    tablePtr->createProc = Tcl_CreateHashEntry;
   1.215 +
   1.216 +    if (typePtr == NULL) {
   1.217 +	/*
   1.218 +	 * The caller has been rebuilt so the hash table is an extended
   1.219 +	 * version.
   1.220 +	 */
   1.221 +    } else if (typePtr != (Tcl_HashKeyType *) -1) {
   1.222 +	/*
   1.223 +	 * The caller is requesting a customized hash table so it must be
   1.224 +	 * an extended version.
   1.225 +	 */
   1.226 +	tablePtr->typePtr = typePtr;
   1.227 +    } else {
   1.228 +	/*
   1.229 +	 * The caller has not been rebuilt so the hash table is not
   1.230 +	 * extended.
   1.231 +	 */
   1.232 +    }
   1.233 +#else
   1.234 +    if (typePtr == NULL) {
   1.235 +	/*
   1.236 +	 * Use the key type to decide which key type is needed.
   1.237 +	 */
   1.238 +	if (keyType == TCL_STRING_KEYS) {
   1.239 +	    typePtr = &tclStringHashKeyType;
   1.240 +	} else if (keyType == TCL_ONE_WORD_KEYS) {
   1.241 +	    typePtr = &tclOneWordHashKeyType;
   1.242 +	} else if (keyType == TCL_CUSTOM_TYPE_KEYS) {
   1.243 +	    Tcl_Panic ("No type structure specified for TCL_CUSTOM_TYPE_KEYS");
   1.244 +	} else if (keyType == TCL_CUSTOM_PTR_KEYS) {
   1.245 +	    Tcl_Panic ("No type structure specified for TCL_CUSTOM_PTR_KEYS");
   1.246 +	} else {
   1.247 +	    typePtr = &tclArrayHashKeyType;
   1.248 +	}
   1.249 +    } else if (typePtr == (Tcl_HashKeyType *) -1) {
   1.250 +	/*
   1.251 +	 * If the caller has not been rebuilt then we cannot continue as
   1.252 +	 * the hash table is not an extended version.
   1.253 +	 */
   1.254 +	Tcl_Panic ("Hash table is not compatible");
   1.255 +    }
   1.256 +    tablePtr->typePtr = typePtr;
   1.257 +#endif
   1.258 +}
   1.259 +
   1.260 +/*
   1.261 + *----------------------------------------------------------------------
   1.262 + *
   1.263 + * Tcl_FindHashEntry --
   1.264 + *
   1.265 + *	Given a hash table find the entry with a matching key.
   1.266 + *
   1.267 + * Results:
   1.268 + *	The return value is a token for the matching entry in the
   1.269 + *	hash table, or NULL if there was no matching entry.
   1.270 + *
   1.271 + * Side effects:
   1.272 + *	None.
   1.273 + *
   1.274 + *----------------------------------------------------------------------
   1.275 + */
   1.276 +
   1.277 +EXPORT_C Tcl_HashEntry *
   1.278 +Tcl_FindHashEntry(tablePtr, key)
   1.279 +    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
   1.280 +    CONST char *key;		/* Key to use to find matching entry. */
   1.281 +{
   1.282 +    register Tcl_HashEntry *hPtr;
   1.283 +    Tcl_HashKeyType *typePtr;
   1.284 +    unsigned int hash;
   1.285 +    int index;
   1.286 +
   1.287 +#if TCL_PRESERVE_BINARY_COMPATABILITY
   1.288 +    if (tablePtr->keyType == TCL_STRING_KEYS) {
   1.289 +	typePtr = &tclStringHashKeyType;
   1.290 +    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
   1.291 +	typePtr = &tclOneWordHashKeyType;
   1.292 +    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
   1.293 +	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
   1.294 +	typePtr = tablePtr->typePtr;
   1.295 +    } else {
   1.296 +	typePtr = &tclArrayHashKeyType;
   1.297 +    }
   1.298 +#else
   1.299 +    typePtr = tablePtr->typePtr;
   1.300 +    if (typePtr == NULL) {
   1.301 +	Tcl_Panic("called Tcl_FindHashEntry on deleted table");
   1.302 +	return NULL;
   1.303 +    }
   1.304 +#endif
   1.305 +
   1.306 +    if (typePtr->hashKeyProc) {
   1.307 +	hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
   1.308 +	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
   1.309 +	    index = RANDOM_INDEX (tablePtr, hash);
   1.310 +	} else {
   1.311 +	    index = hash & tablePtr->mask;
   1.312 +	}
   1.313 +    } else {
   1.314 +	hash = (unsigned int) key;
   1.315 +	index = RANDOM_INDEX (tablePtr, hash);
   1.316 +    }
   1.317 +
   1.318 +    /*
   1.319 +     * Search all of the entries in the appropriate bucket.
   1.320 +     */
   1.321 +
   1.322 +    if (typePtr->compareKeysProc) {
   1.323 +	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
   1.324 +	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
   1.325 +	        hPtr = hPtr->nextPtr) {
   1.326 +#if TCL_HASH_KEY_STORE_HASH
   1.327 +	    if (hash != (unsigned int) hPtr->hash) {
   1.328 +		continue;
   1.329 +	    }
   1.330 +#endif
   1.331 +	    if (compareKeysProc ((VOID *) key, hPtr)) {
   1.332 +		return hPtr;
   1.333 +	    }
   1.334 +	}
   1.335 +    } else {
   1.336 +	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
   1.337 +	        hPtr = hPtr->nextPtr) {
   1.338 +#if TCL_HASH_KEY_STORE_HASH
   1.339 +	    if (hash != (unsigned int) hPtr->hash) {
   1.340 +		continue;
   1.341 +	    }
   1.342 +#endif
   1.343 +	    if (key == hPtr->key.oneWordValue) {
   1.344 +		return hPtr;
   1.345 +	    }
   1.346 +	}
   1.347 +    }
   1.348 +    
   1.349 +    return NULL;
   1.350 +}
   1.351 +
   1.352 +/*
   1.353 + *----------------------------------------------------------------------
   1.354 + *
   1.355 + * Tcl_CreateHashEntry --
   1.356 + *
   1.357 + *	Given a hash table with string keys, and a string key, find
   1.358 + *	the entry with a matching key.  If there is no matching entry,
   1.359 + *	then create a new entry that does match.
   1.360 + *
   1.361 + * Results:
   1.362 + *	The return value is a pointer to the matching entry.  If this
   1.363 + *	is a newly-created entry, then *newPtr will be set to a non-zero
   1.364 + *	value;  otherwise *newPtr will be set to 0.  If this is a new
   1.365 + *	entry the value stored in the entry will initially be 0.
   1.366 + *
   1.367 + * Side effects:
   1.368 + *	A new entry may be added to the hash table.
   1.369 + *
   1.370 + *----------------------------------------------------------------------
   1.371 + */
   1.372 +
   1.373 +EXPORT_C Tcl_HashEntry *
   1.374 +Tcl_CreateHashEntry(tablePtr, key, newPtr)
   1.375 +    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
   1.376 +    CONST char *key;		/* Key to use to find or create matching
   1.377 +				 * entry. */
   1.378 +    int *newPtr;		/* Store info here telling whether a new
   1.379 +				 * entry was created. */
   1.380 +{
   1.381 +    register Tcl_HashEntry *hPtr;
   1.382 +    Tcl_HashKeyType *typePtr;
   1.383 +    unsigned int hash;
   1.384 +    int index;
   1.385 +
   1.386 +#if TCL_PRESERVE_BINARY_COMPATABILITY
   1.387 +    if (tablePtr->keyType == TCL_STRING_KEYS) {
   1.388 +	typePtr = &tclStringHashKeyType;
   1.389 +    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
   1.390 +	typePtr = &tclOneWordHashKeyType;
   1.391 +    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
   1.392 +	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
   1.393 +	typePtr = tablePtr->typePtr;
   1.394 +    } else {
   1.395 +	typePtr = &tclArrayHashKeyType;
   1.396 +    }
   1.397 +#else
   1.398 +    typePtr = tablePtr->typePtr;
   1.399 +    if (typePtr == NULL) {
   1.400 +	Tcl_Panic("called Tcl_CreateHashEntry on deleted table");
   1.401 +	return NULL;
   1.402 +    }
   1.403 +#endif
   1.404 +
   1.405 +    if (typePtr->hashKeyProc) {
   1.406 +	hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
   1.407 +	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
   1.408 +	    index = RANDOM_INDEX (tablePtr, hash);
   1.409 +	} else {
   1.410 +	    index = hash & tablePtr->mask;
   1.411 +	}
   1.412 +    } else {
   1.413 +	hash = (unsigned int) key;
   1.414 +	index = RANDOM_INDEX (tablePtr, hash);
   1.415 +    }
   1.416 +
   1.417 +    /*
   1.418 +     * Search all of the entries in the appropriate bucket.
   1.419 +     */
   1.420 +
   1.421 +    if (typePtr->compareKeysProc) {
   1.422 +	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
   1.423 +	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
   1.424 +	        hPtr = hPtr->nextPtr) {
   1.425 +#if TCL_HASH_KEY_STORE_HASH
   1.426 +	    if (hash != (unsigned int) hPtr->hash) {
   1.427 +		continue;
   1.428 +	    }
   1.429 +#endif
   1.430 +	    if (compareKeysProc ((VOID *) key, hPtr)) {
   1.431 +		*newPtr = 0;
   1.432 +		return hPtr;
   1.433 +	    }
   1.434 +	}
   1.435 +    } else {
   1.436 +	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
   1.437 +	        hPtr = hPtr->nextPtr) {
   1.438 +#if TCL_HASH_KEY_STORE_HASH
   1.439 +	    if (hash != (unsigned int) hPtr->hash) {
   1.440 +		continue;
   1.441 +	    }
   1.442 +#endif
   1.443 +	    if (key == hPtr->key.oneWordValue) {
   1.444 +		*newPtr = 0;
   1.445 +		return hPtr;
   1.446 +	    }
   1.447 +	}
   1.448 +    }
   1.449 +
   1.450 +    /*
   1.451 +     * Entry not found.  Add a new one to the bucket.
   1.452 +     */
   1.453 +
   1.454 +    *newPtr = 1;
   1.455 +    if (typePtr->allocEntryProc) {
   1.456 +	hPtr = typePtr->allocEntryProc (tablePtr, (VOID *) key);
   1.457 +    } else {
   1.458 +	hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
   1.459 +	hPtr->key.oneWordValue = (char *) key;
   1.460 +    }
   1.461 +					 
   1.462 +    hPtr->tablePtr = tablePtr;
   1.463 +#if TCL_HASH_KEY_STORE_HASH
   1.464 +#   if TCL_PRESERVE_BINARY_COMPATABILITY
   1.465 +    hPtr->hash = (VOID *) hash;
   1.466 +#   else
   1.467 +    hPtr->hash = hash;
   1.468 +#   endif
   1.469 +    hPtr->nextPtr = tablePtr->buckets[index];
   1.470 +    tablePtr->buckets[index] = hPtr;
   1.471 +#else
   1.472 +    hPtr->bucketPtr = &(tablePtr->buckets[index]);
   1.473 +    hPtr->nextPtr = *hPtr->bucketPtr;
   1.474 +    *hPtr->bucketPtr = hPtr;
   1.475 +#endif
   1.476 +    hPtr->clientData = 0;
   1.477 +    tablePtr->numEntries++;
   1.478 +
   1.479 +    /*
   1.480 +     * If the table has exceeded a decent size, rebuild it with many
   1.481 +     * more buckets.
   1.482 +     */
   1.483 +
   1.484 +    if (tablePtr->numEntries >= tablePtr->rebuildSize) {
   1.485 +	RebuildTable(tablePtr);
   1.486 +    }
   1.487 +    return hPtr;
   1.488 +}
   1.489 +
   1.490 +/*
   1.491 + *----------------------------------------------------------------------
   1.492 + *
   1.493 + * Tcl_DeleteHashEntry --
   1.494 + *
   1.495 + *	Remove a single entry from a hash table.
   1.496 + *
   1.497 + * Results:
   1.498 + *	None.
   1.499 + *
   1.500 + * Side effects:
   1.501 + *	The entry given by entryPtr is deleted from its table and
   1.502 + *	should never again be used by the caller.  It is up to the
   1.503 + *	caller to free the clientData field of the entry, if that
   1.504 + *	is relevant.
   1.505 + *
   1.506 + *----------------------------------------------------------------------
   1.507 + */
   1.508 +
   1.509 +EXPORT_C void
   1.510 +Tcl_DeleteHashEntry(entryPtr)
   1.511 +    Tcl_HashEntry *entryPtr;
   1.512 +{
   1.513 +    register Tcl_HashEntry *prevPtr;
   1.514 +    Tcl_HashKeyType *typePtr;
   1.515 +    Tcl_HashTable *tablePtr;
   1.516 +    Tcl_HashEntry **bucketPtr;
   1.517 +#if TCL_HASH_KEY_STORE_HASH
   1.518 +    int index;
   1.519 +#endif
   1.520 +
   1.521 +    tablePtr = entryPtr->tablePtr;
   1.522 +
   1.523 +#if TCL_PRESERVE_BINARY_COMPATABILITY
   1.524 +    if (tablePtr->keyType == TCL_STRING_KEYS) {
   1.525 +	typePtr = &tclStringHashKeyType;
   1.526 +    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
   1.527 +	typePtr = &tclOneWordHashKeyType;
   1.528 +    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
   1.529 +	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
   1.530 +	typePtr = tablePtr->typePtr;
   1.531 +    } else {
   1.532 +	typePtr = &tclArrayHashKeyType;
   1.533 +    }
   1.534 +#else
   1.535 +    typePtr = tablePtr->typePtr;
   1.536 +#endif
   1.537 +    
   1.538 +#if TCL_HASH_KEY_STORE_HASH
   1.539 +    if (typePtr->hashKeyProc == NULL
   1.540 +	|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
   1.541 +	index = RANDOM_INDEX (tablePtr, entryPtr->hash);
   1.542 +    } else {
   1.543 +	index = ((unsigned int) entryPtr->hash) & tablePtr->mask;
   1.544 +    }
   1.545 +
   1.546 +    bucketPtr = &(tablePtr->buckets[index]);
   1.547 +#else
   1.548 +    bucketPtr = entryPtr->bucketPtr;
   1.549 +#endif
   1.550 +    
   1.551 +    if (*bucketPtr == entryPtr) {
   1.552 +	*bucketPtr = entryPtr->nextPtr;
   1.553 +    } else {
   1.554 +	for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) {
   1.555 +	    if (prevPtr == NULL) {
   1.556 +		panic("malformed bucket chain in Tcl_DeleteHashEntry");
   1.557 +	    }
   1.558 +	    if (prevPtr->nextPtr == entryPtr) {
   1.559 +		prevPtr->nextPtr = entryPtr->nextPtr;
   1.560 +		break;
   1.561 +	    }
   1.562 +	}
   1.563 +    }
   1.564 +
   1.565 +    tablePtr->numEntries--;
   1.566 +    if (typePtr->freeEntryProc) {
   1.567 +	typePtr->freeEntryProc (entryPtr);
   1.568 +    } else {
   1.569 +	ckfree((char *) entryPtr);
   1.570 +    }
   1.571 +}
   1.572 +
   1.573 +/*
   1.574 + *----------------------------------------------------------------------
   1.575 + *
   1.576 + * Tcl_DeleteHashTable --
   1.577 + *
   1.578 + *	Free up everything associated with a hash table except for
   1.579 + *	the record for the table itself.
   1.580 + *
   1.581 + * Results:
   1.582 + *	None.
   1.583 + *
   1.584 + * Side effects:
   1.585 + *	The hash table is no longer useable.
   1.586 + *
   1.587 + *----------------------------------------------------------------------
   1.588 + */
   1.589 +
   1.590 +EXPORT_C void
   1.591 +Tcl_DeleteHashTable(tablePtr)
   1.592 +    register Tcl_HashTable *tablePtr;		/* Table to delete. */
   1.593 +{
   1.594 +    register Tcl_HashEntry *hPtr, *nextPtr;
   1.595 +    Tcl_HashKeyType *typePtr;
   1.596 +    int i;
   1.597 +
   1.598 +#if TCL_PRESERVE_BINARY_COMPATABILITY
   1.599 +    if (tablePtr->keyType == TCL_STRING_KEYS) {
   1.600 +	typePtr = &tclStringHashKeyType;
   1.601 +    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
   1.602 +	typePtr = &tclOneWordHashKeyType;
   1.603 +    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
   1.604 +	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
   1.605 +	typePtr = tablePtr->typePtr;
   1.606 +    } else {
   1.607 +	typePtr = &tclArrayHashKeyType;
   1.608 +    }
   1.609 +#else
   1.610 +    typePtr = tablePtr->typePtr;
   1.611 +#endif
   1.612 +
   1.613 +    /*
   1.614 +     * Free up all the entries in the table.
   1.615 +     */
   1.616 +
   1.617 +    for (i = 0; i < tablePtr->numBuckets; i++) {
   1.618 +	hPtr = tablePtr->buckets[i];
   1.619 +	while (hPtr != NULL) {
   1.620 +	    nextPtr = hPtr->nextPtr;
   1.621 +	    if (typePtr->freeEntryProc) {
   1.622 +		typePtr->freeEntryProc (hPtr);
   1.623 +	    } else {
   1.624 +		ckfree((char *) hPtr);
   1.625 +	    }
   1.626 +	    hPtr = nextPtr;
   1.627 +	}
   1.628 +    }
   1.629 +
   1.630 +    /*
   1.631 +     * Free up the bucket array, if it was dynamically allocated.
   1.632 +     */
   1.633 +
   1.634 +    if (tablePtr->buckets != tablePtr->staticBuckets) {
   1.635 +	ckfree((char *) tablePtr->buckets);
   1.636 +    }
   1.637 +
   1.638 +    /*
   1.639 +     * Arrange for panics if the table is used again without
   1.640 +     * re-initialization.
   1.641 +     */
   1.642 +
   1.643 +#if TCL_PRESERVE_BINARY_COMPATABILITY
   1.644 +    tablePtr->findProc = BogusFind;
   1.645 +    tablePtr->createProc = BogusCreate;
   1.646 +#else
   1.647 +    tablePtr->typePtr = NULL;
   1.648 +#endif
   1.649 +}
   1.650 +
   1.651 +/*
   1.652 + *----------------------------------------------------------------------
   1.653 + *
   1.654 + * Tcl_FirstHashEntry --
   1.655 + *
   1.656 + *	Locate the first entry in a hash table and set up a record
   1.657 + *	that can be used to step through all the remaining entries
   1.658 + *	of the table.
   1.659 + *
   1.660 + * Results:
   1.661 + *	The return value is a pointer to the first entry in tablePtr,
   1.662 + *	or NULL if tablePtr has no entries in it.  The memory at
   1.663 + *	*searchPtr is initialized so that subsequent calls to
   1.664 + *	Tcl_NextHashEntry will return all of the entries in the table,
   1.665 + *	one at a time.
   1.666 + *
   1.667 + * Side effects:
   1.668 + *	None.
   1.669 + *
   1.670 + *----------------------------------------------------------------------
   1.671 + */
   1.672 +
   1.673 +EXPORT_C Tcl_HashEntry *
   1.674 +Tcl_FirstHashEntry(tablePtr, searchPtr)
   1.675 +    Tcl_HashTable *tablePtr;		/* Table to search. */
   1.676 +    Tcl_HashSearch *searchPtr;		/* Place to store information about
   1.677 +					 * progress through the table. */
   1.678 +{
   1.679 +    searchPtr->tablePtr = tablePtr;
   1.680 +    searchPtr->nextIndex = 0;
   1.681 +    searchPtr->nextEntryPtr = NULL;
   1.682 +    return Tcl_NextHashEntry(searchPtr);
   1.683 +}
   1.684 +
   1.685 +/*
   1.686 + *----------------------------------------------------------------------
   1.687 + *
   1.688 + * Tcl_NextHashEntry --
   1.689 + *
   1.690 + *	Once a hash table enumeration has been initiated by calling
   1.691 + *	Tcl_FirstHashEntry, this procedure may be called to return
   1.692 + *	successive elements of the table.
   1.693 + *
   1.694 + * Results:
   1.695 + *	The return value is the next entry in the hash table being
   1.696 + *	enumerated, or NULL if the end of the table is reached.
   1.697 + *
   1.698 + * Side effects:
   1.699 + *	None.
   1.700 + *
   1.701 + *----------------------------------------------------------------------
   1.702 + */
   1.703 +
   1.704 +EXPORT_C Tcl_HashEntry *
   1.705 +Tcl_NextHashEntry(searchPtr)
   1.706 +    register Tcl_HashSearch *searchPtr;	/* Place to store information about
   1.707 +					 * progress through the table.  Must
   1.708 +					 * have been initialized by calling
   1.709 +					 * Tcl_FirstHashEntry. */
   1.710 +{
   1.711 +    Tcl_HashEntry *hPtr;
   1.712 +    Tcl_HashTable *tablePtr = searchPtr->tablePtr;
   1.713 +
   1.714 +    while (searchPtr->nextEntryPtr == NULL) {
   1.715 +	if (searchPtr->nextIndex >= tablePtr->numBuckets) {
   1.716 +	    return NULL;
   1.717 +	}
   1.718 +	searchPtr->nextEntryPtr =
   1.719 +		tablePtr->buckets[searchPtr->nextIndex];
   1.720 +	searchPtr->nextIndex++;
   1.721 +    }
   1.722 +    hPtr = searchPtr->nextEntryPtr;
   1.723 +    searchPtr->nextEntryPtr = hPtr->nextPtr;
   1.724 +    return hPtr;
   1.725 +}
   1.726 +
   1.727 +/*
   1.728 + *----------------------------------------------------------------------
   1.729 + *
   1.730 + * Tcl_HashStats --
   1.731 + *
   1.732 + *	Return statistics describing the layout of the hash table
   1.733 + *	in its hash buckets.
   1.734 + *
   1.735 + * Results:
   1.736 + *	The return value is a malloc-ed string containing information
   1.737 + *	about tablePtr.  It is the caller's responsibility to free
   1.738 + *	this string.
   1.739 + *
   1.740 + * Side effects:
   1.741 + *	None.
   1.742 + *
   1.743 + *----------------------------------------------------------------------
   1.744 + */
   1.745 +
   1.746 +EXPORT_C CONST char *
   1.747 +Tcl_HashStats(tablePtr)
   1.748 +    Tcl_HashTable *tablePtr;		/* Table for which to produce stats. */
   1.749 +{
   1.750 +#define NUM_COUNTERS 10
   1.751 +    int count[NUM_COUNTERS], overflow, i, j;
   1.752 +    double average, tmp;
   1.753 +    register Tcl_HashEntry *hPtr;
   1.754 +    char *result, *p;
   1.755 +
   1.756 +    /*
   1.757 +     * Compute a histogram of bucket usage.
   1.758 +     */
   1.759 +
   1.760 +    for (i = 0; i < NUM_COUNTERS; i++) {
   1.761 +	count[i] = 0;
   1.762 +    }
   1.763 +    overflow = 0;
   1.764 +    average = 0.0;
   1.765 +    for (i = 0; i < tablePtr->numBuckets; i++) {
   1.766 +	j = 0;
   1.767 +	for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
   1.768 +	    j++;
   1.769 +	}
   1.770 +	if (j < NUM_COUNTERS) {
   1.771 +	    count[j]++;
   1.772 +	} else {
   1.773 +	    overflow++;
   1.774 +	}
   1.775 +	tmp = j;
   1.776 +	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
   1.777 +    }
   1.778 +
   1.779 +    /*
   1.780 +     * Print out the histogram and a few other pieces of information.
   1.781 +     */
   1.782 +
   1.783 +    result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
   1.784 +    sprintf(result, "%d entries in table, %d buckets\n",
   1.785 +	    tablePtr->numEntries, tablePtr->numBuckets);
   1.786 +    p = result + strlen(result);
   1.787 +    for (i = 0; i < NUM_COUNTERS; i++) {
   1.788 +	sprintf(p, "number of buckets with %d entries: %d\n",
   1.789 +		i, count[i]);
   1.790 +	p += strlen(p);
   1.791 +    }
   1.792 +    sprintf(p, "number of buckets with %d or more entries: %d\n",
   1.793 +	    NUM_COUNTERS, overflow);
   1.794 +    p += strlen(p);
   1.795 +    sprintf(p, "average search distance for entry: %.1f", average);
   1.796 +    return result;
   1.797 +}
   1.798 +
   1.799 +/*
   1.800 + *----------------------------------------------------------------------
   1.801 + *
   1.802 + * AllocArrayEntry --
   1.803 + *
   1.804 + *	Allocate space for a Tcl_HashEntry containing the array key.
   1.805 + *
   1.806 + * Results:
   1.807 + *	The return value is a pointer to the created entry.
   1.808 + *
   1.809 + * Side effects:
   1.810 + *	None.
   1.811 + *
   1.812 + *----------------------------------------------------------------------
   1.813 + */
   1.814 +
   1.815 +static Tcl_HashEntry *
   1.816 +AllocArrayEntry(tablePtr, keyPtr)
   1.817 +    Tcl_HashTable *tablePtr;	/* Hash table. */
   1.818 +    VOID *keyPtr;		/* Key to store in the hash table entry. */
   1.819 +{
   1.820 +    int *array = (int *) keyPtr;
   1.821 +    register int *iPtr1, *iPtr2;
   1.822 +    Tcl_HashEntry *hPtr;
   1.823 +    int count;
   1.824 +    unsigned int size;
   1.825 +
   1.826 +    count = tablePtr->keyType;
   1.827 +    
   1.828 +    size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
   1.829 +    if (size < sizeof(Tcl_HashEntry))
   1.830 +	size = sizeof(Tcl_HashEntry);
   1.831 +    hPtr = (Tcl_HashEntry *) ckalloc(size);
   1.832 +    
   1.833 +    for (iPtr1 = array, iPtr2 = hPtr->key.words;
   1.834 +	    count > 0; count--, iPtr1++, iPtr2++) {
   1.835 +	*iPtr2 = *iPtr1;
   1.836 +    }
   1.837 +
   1.838 +    return hPtr;
   1.839 +}
   1.840 +
   1.841 +/*
   1.842 + *----------------------------------------------------------------------
   1.843 + *
   1.844 + * CompareArrayKeys --
   1.845 + *
   1.846 + *	Compares two array keys.
   1.847 + *
   1.848 + * Results:
   1.849 + *	The return value is 0 if they are different and 1 if they are
   1.850 + *	the same.
   1.851 + *
   1.852 + * Side effects:
   1.853 + *	None.
   1.854 + *
   1.855 + *----------------------------------------------------------------------
   1.856 + */
   1.857 +
   1.858 +static int
   1.859 +CompareArrayKeys(keyPtr, hPtr)
   1.860 +    VOID *keyPtr;		/* New key to compare. */
   1.861 +    Tcl_HashEntry *hPtr;	/* Existing key to compare. */
   1.862 +{
   1.863 +    register CONST int *iPtr1 = (CONST int *) keyPtr;
   1.864 +    register CONST int *iPtr2 = (CONST int *) hPtr->key.words;
   1.865 +    Tcl_HashTable *tablePtr = hPtr->tablePtr;
   1.866 +    int count;
   1.867 +
   1.868 +    for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
   1.869 +	if (count == 0) {
   1.870 +	    return 1;
   1.871 +	}
   1.872 +	if (*iPtr1 != *iPtr2) {
   1.873 +	    break;
   1.874 +	}
   1.875 +    }
   1.876 +    return 0;
   1.877 +}
   1.878 +
   1.879 +/*
   1.880 + *----------------------------------------------------------------------
   1.881 + *
   1.882 + * HashArrayKey --
   1.883 + *
   1.884 + *	Compute a one-word summary of an array, which can be
   1.885 + *	used to generate a hash index.
   1.886 + *
   1.887 + * Results:
   1.888 + *	The return value is a one-word summary of the information in
   1.889 + *	string.
   1.890 + *
   1.891 + * Side effects:
   1.892 + *	None.
   1.893 + *
   1.894 + *----------------------------------------------------------------------
   1.895 + */
   1.896 +
   1.897 +static unsigned int
   1.898 +HashArrayKey(tablePtr, keyPtr)
   1.899 +    Tcl_HashTable *tablePtr;	/* Hash table. */
   1.900 +    VOID *keyPtr;		/* Key from which to compute hash value. */
   1.901 +{
   1.902 +    register CONST int *array = (CONST int *) keyPtr;
   1.903 +    register unsigned int result;
   1.904 +    int count;
   1.905 +
   1.906 +    for (result = 0, count = tablePtr->keyType; count > 0;
   1.907 +	    count--, array++) {
   1.908 +	result += *array;
   1.909 +    }
   1.910 +    return result;
   1.911 +}
   1.912 +
   1.913 +/*
   1.914 + *----------------------------------------------------------------------
   1.915 + *
   1.916 + * AllocStringEntry --
   1.917 + *
   1.918 + *	Allocate space for a Tcl_HashEntry containing the string key.
   1.919 + *
   1.920 + * Results:
   1.921 + *	The return value is a pointer to the created entry.
   1.922 + *
   1.923 + * Side effects:
   1.924 + *	None.
   1.925 + *
   1.926 + *----------------------------------------------------------------------
   1.927 + */
   1.928 +
   1.929 +static Tcl_HashEntry *
   1.930 +AllocStringEntry(tablePtr, keyPtr)
   1.931 +    Tcl_HashTable *tablePtr;	/* Hash table. */
   1.932 +    VOID *keyPtr;		/* Key to store in the hash table entry. */
   1.933 +{
   1.934 +    CONST char *string = (CONST char *) keyPtr;
   1.935 +    Tcl_HashEntry *hPtr;
   1.936 +    unsigned int size;
   1.937 +
   1.938 +    size = sizeof(Tcl_HashEntry) + strlen(string) + 1 - sizeof(hPtr->key);
   1.939 +    if (size < sizeof(Tcl_HashEntry))
   1.940 +	size = sizeof(Tcl_HashEntry);
   1.941 +    hPtr = (Tcl_HashEntry *) ckalloc(size);
   1.942 +    strcpy(hPtr->key.string, string);
   1.943 +
   1.944 +    return hPtr;
   1.945 +}
   1.946 +
   1.947 +/*
   1.948 + *----------------------------------------------------------------------
   1.949 + *
   1.950 + * CompareStringKeys --
   1.951 + *
   1.952 + *	Compares two string keys.
   1.953 + *
   1.954 + * Results:
   1.955 + *	The return value is 0 if they are different and 1 if they are
   1.956 + *	the same.
   1.957 + *
   1.958 + * Side effects:
   1.959 + *	None.
   1.960 + *
   1.961 + *----------------------------------------------------------------------
   1.962 + */
   1.963 +
   1.964 +static int
   1.965 +CompareStringKeys(keyPtr, hPtr)
   1.966 +    VOID *keyPtr;		/* New key to compare. */
   1.967 +    Tcl_HashEntry *hPtr;		/* Existing key to compare. */
   1.968 +{
   1.969 +    register CONST char *p1 = (CONST char *) keyPtr;
   1.970 +    register CONST char *p2 = (CONST char *) hPtr->key.string;
   1.971 +
   1.972 +    for (;; p1++, p2++) {
   1.973 +	if (*p1 != *p2) {
   1.974 +	    break;
   1.975 +	}
   1.976 +	if (*p1 == '\0') {
   1.977 +	    return 1;
   1.978 +	}
   1.979 +    }
   1.980 +    return 0;
   1.981 +}
   1.982 +
   1.983 +/*
   1.984 + *----------------------------------------------------------------------
   1.985 + *
   1.986 + * HashStringKey --
   1.987 + *
   1.988 + *	Compute a one-word summary of a text string, which can be
   1.989 + *	used to generate a hash index.
   1.990 + *
   1.991 + * Results:
   1.992 + *	The return value is a one-word summary of the information in
   1.993 + *	string.
   1.994 + *
   1.995 + * Side effects:
   1.996 + *	None.
   1.997 + *
   1.998 + *----------------------------------------------------------------------
   1.999 + */
  1.1000 +
  1.1001 +static unsigned int
  1.1002 +HashStringKey(tablePtr, keyPtr)
  1.1003 +    Tcl_HashTable *tablePtr;	/* Hash table. */
  1.1004 +    VOID *keyPtr;		/* Key from which to compute hash value. */
  1.1005 +{
  1.1006 +    register CONST char *string = (CONST char *) keyPtr;
  1.1007 +    register unsigned int result;
  1.1008 +    register int c;
  1.1009 +
  1.1010 +    /*
  1.1011 +     * I tried a zillion different hash functions and asked many other
  1.1012 +     * people for advice.  Many people had their own favorite functions,
  1.1013 +     * all different, but no-one had much idea why they were good ones.
  1.1014 +     * I chose the one below (multiply by 9 and add new character)
  1.1015 +     * because of the following reasons:
  1.1016 +     *
  1.1017 +     * 1. Multiplying by 10 is perfect for keys that are decimal strings,
  1.1018 +     *    and multiplying by 9 is just about as good.
  1.1019 +     * 2. Times-9 is (shift-left-3) plus (old).  This means that each
  1.1020 +     *    character's bits hang around in the low-order bits of the
  1.1021 +     *    hash value for ever, plus they spread fairly rapidly up to
  1.1022 +     *    the high-order bits to fill out the hash value.  This seems
  1.1023 +     *    works well both for decimal and non-decimal strings.
  1.1024 +     */
  1.1025 +
  1.1026 +    result = 0;
  1.1027 +    while (1) {
  1.1028 +	c = *string;
  1.1029 +	if (c == 0) {
  1.1030 +	    break;
  1.1031 +	}
  1.1032 +	result += (result<<3) + c;
  1.1033 +	string++;
  1.1034 +    }
  1.1035 +    return result;
  1.1036 +}
  1.1037 +
  1.1038 +#if TCL_PRESERVE_BINARY_COMPATABILITY
  1.1039 +/*
  1.1040 + *----------------------------------------------------------------------
  1.1041 + *
  1.1042 + * BogusFind --
  1.1043 + *
  1.1044 + *	This procedure is invoked when an Tcl_FindHashEntry is called
  1.1045 + *	on a table that has been deleted.
  1.1046 + *
  1.1047 + * Results:
  1.1048 + *	If panic returns (which it shouldn't) this procedure returns
  1.1049 + *	NULL.
  1.1050 + *
  1.1051 + * Side effects:
  1.1052 + *	Generates a panic.
  1.1053 + *
  1.1054 + *----------------------------------------------------------------------
  1.1055 + */
  1.1056 +
  1.1057 +	/* ARGSUSED */
  1.1058 +static Tcl_HashEntry *
  1.1059 +BogusFind(tablePtr, key)
  1.1060 +    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
  1.1061 +    CONST char *key;		/* Key to use to find matching entry. */
  1.1062 +{
  1.1063 +    panic("called Tcl_FindHashEntry on deleted table");
  1.1064 +    return NULL;
  1.1065 +}
  1.1066 +
  1.1067 +/*
  1.1068 + *----------------------------------------------------------------------
  1.1069 + *
  1.1070 + * BogusCreate --
  1.1071 + *
  1.1072 + *	This procedure is invoked when an Tcl_CreateHashEntry is called
  1.1073 + *	on a table that has been deleted.
  1.1074 + *
  1.1075 + * Results:
  1.1076 + *	If panic returns (which it shouldn't) this procedure returns
  1.1077 + *	NULL.
  1.1078 + *
  1.1079 + * Side effects:
  1.1080 + *	Generates a panic.
  1.1081 + *
  1.1082 + *----------------------------------------------------------------------
  1.1083 + */
  1.1084 +
  1.1085 +	/* ARGSUSED */
  1.1086 +static Tcl_HashEntry *
  1.1087 +BogusCreate(tablePtr, key, newPtr)
  1.1088 +    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
  1.1089 +    CONST char *key;		/* Key to use to find or create matching
  1.1090 +				 * entry. */
  1.1091 +    int *newPtr;		/* Store info here telling whether a new
  1.1092 +				 * entry was created. */
  1.1093 +{
  1.1094 +    panic("called Tcl_CreateHashEntry on deleted table");
  1.1095 +    return NULL;
  1.1096 +}
  1.1097 +#endif
  1.1098 +
  1.1099 +/*
  1.1100 + *----------------------------------------------------------------------
  1.1101 + *
  1.1102 + * RebuildTable --
  1.1103 + *
  1.1104 + *	This procedure is invoked when the ratio of entries to hash
  1.1105 + *	buckets becomes too large.  It creates a new table with a
  1.1106 + *	larger bucket array and moves all of the entries into the
  1.1107 + *	new table.
  1.1108 + *
  1.1109 + * Results:
  1.1110 + *	None.
  1.1111 + *
  1.1112 + * Side effects:
  1.1113 + *	Memory gets reallocated and entries get re-hashed to new
  1.1114 + *	buckets.
  1.1115 + *
  1.1116 + *----------------------------------------------------------------------
  1.1117 + */
  1.1118 +
  1.1119 +static void
  1.1120 +RebuildTable(tablePtr)
  1.1121 +    register Tcl_HashTable *tablePtr;	/* Table to enlarge. */
  1.1122 +{
  1.1123 +    int oldSize, count, index;
  1.1124 +    Tcl_HashEntry **oldBuckets;
  1.1125 +    register Tcl_HashEntry **oldChainPtr, **newChainPtr;
  1.1126 +    register Tcl_HashEntry *hPtr;
  1.1127 +    Tcl_HashKeyType *typePtr;
  1.1128 +    VOID *key;
  1.1129 +
  1.1130 +    oldSize = tablePtr->numBuckets;
  1.1131 +    oldBuckets = tablePtr->buckets;
  1.1132 +
  1.1133 +    /*
  1.1134 +     * Allocate and initialize the new bucket array, and set up
  1.1135 +     * hashing constants for new array size.
  1.1136 +     */
  1.1137 +
  1.1138 +    tablePtr->numBuckets *= 4;
  1.1139 +    tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
  1.1140 +	    (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
  1.1141 +    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
  1.1142 +	    count > 0; count--, newChainPtr++) {
  1.1143 +	*newChainPtr = NULL;
  1.1144 +    }
  1.1145 +    tablePtr->rebuildSize *= 4;
  1.1146 +    tablePtr->downShift -= 2;
  1.1147 +    tablePtr->mask = (tablePtr->mask << 2) + 3;
  1.1148 +
  1.1149 +#if TCL_PRESERVE_BINARY_COMPATABILITY
  1.1150 +    if (tablePtr->keyType == TCL_STRING_KEYS) {
  1.1151 +	typePtr = &tclStringHashKeyType;
  1.1152 +    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
  1.1153 +	typePtr = &tclOneWordHashKeyType;
  1.1154 +    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
  1.1155 +	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
  1.1156 +	typePtr = tablePtr->typePtr;
  1.1157 +    } else {
  1.1158 +	typePtr = &tclArrayHashKeyType;
  1.1159 +    }
  1.1160 +#else
  1.1161 +    typePtr = tablePtr->typePtr;
  1.1162 +#endif
  1.1163 +
  1.1164 +    /*
  1.1165 +     * Rehash all of the existing entries into the new bucket array.
  1.1166 +     */
  1.1167 +
  1.1168 +    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
  1.1169 +	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
  1.1170 +	    *oldChainPtr = hPtr->nextPtr;
  1.1171 +
  1.1172 +	    key = (VOID *) Tcl_GetHashKey (tablePtr, hPtr);
  1.1173 +
  1.1174 +#if TCL_HASH_KEY_STORE_HASH
  1.1175 +	    if (typePtr->hashKeyProc == NULL
  1.1176 +		|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
  1.1177 +		index = RANDOM_INDEX (tablePtr, hPtr->hash);
  1.1178 +	    } else {
  1.1179 +		index = ((unsigned int) hPtr->hash) & tablePtr->mask;
  1.1180 +	    }
  1.1181 +	    hPtr->nextPtr = tablePtr->buckets[index];
  1.1182 +	    tablePtr->buckets[index] = hPtr;
  1.1183 +#else
  1.1184 +	    if (typePtr->hashKeyProc) {
  1.1185 +		unsigned int hash;
  1.1186 +		hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
  1.1187 +		if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
  1.1188 +		    index = RANDOM_INDEX (tablePtr, hash);
  1.1189 +		} else {
  1.1190 +		    index = hash & tablePtr->mask;
  1.1191 +		}
  1.1192 +	    } else {
  1.1193 +		index = RANDOM_INDEX (tablePtr, key);
  1.1194 +	    }
  1.1195 +
  1.1196 +	    hPtr->bucketPtr = &(tablePtr->buckets[index]);
  1.1197 +	    hPtr->nextPtr = *hPtr->bucketPtr;
  1.1198 +	    *hPtr->bucketPtr = hPtr;
  1.1199 +#endif
  1.1200 +	}
  1.1201 +    }
  1.1202 +
  1.1203 +    /*
  1.1204 +     * Free up the old bucket array, if it was dynamically allocated.
  1.1205 +     */
  1.1206 +
  1.1207 +    if (oldBuckets != tablePtr->staticBuckets) {
  1.1208 +	ckfree((char *) oldBuckets);
  1.1209 +    }
  1.1210 +}