os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/generic/tclHash.c
author sl@SLION-WIN7.fritz.box
Fri, 15 Jun 2012 03:10:57 +0200
changeset 0 bde4ae8d615e
permissions -rw-r--r--
First public contribution.
sl@0
     1
/* 
sl@0
     2
 * tclHash.c --
sl@0
     3
 *
sl@0
     4
 *	Implementation of in-memory hash tables for Tcl and Tcl-based
sl@0
     5
 *	applications.
sl@0
     6
 *
sl@0
     7
 * Copyright (c) 1991-1993 The Regents of the University of California.
sl@0
     8
 * Copyright (c) 1994 Sun Microsystems, Inc.
sl@0
     9
 * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  
sl@0
    10
 *
sl@0
    11
 * See the file "license.terms" for information on usage and redistribution
sl@0
    12
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0
    13
 *
sl@0
    14
 * RCS: @(#) $Id: tclHash.c,v 1.12.2.1 2004/11/11 01:18:07 das Exp $
sl@0
    15
 */
sl@0
    16
sl@0
    17
#include "tclInt.h"
sl@0
    18
sl@0
    19
/*
sl@0
    20
 * Prevent macros from clashing with function definitions.
sl@0
    21
 */
sl@0
    22
sl@0
    23
#if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0
    24
#   undef Tcl_FindHashEntry
sl@0
    25
#   undef Tcl_CreateHashEntry
sl@0
    26
#endif
sl@0
    27
sl@0
    28
/*
sl@0
    29
 * When there are this many entries per bucket, on average, rebuild
sl@0
    30
 * the hash table to make it larger.
sl@0
    31
 */
sl@0
    32
sl@0
    33
#define REBUILD_MULTIPLIER	3
sl@0
    34
sl@0
    35
/*
sl@0
    36
 * The following macro takes a preliminary integer hash value and
sl@0
    37
 * produces an index into a hash tables bucket list.  The idea is
sl@0
    38
 * to make it so that preliminary values that are arbitrarily similar
sl@0
    39
 * will end up in different buckets.  The hash function was taken
sl@0
    40
 * from a random-number generator.
sl@0
    41
 */
sl@0
    42
sl@0
    43
#define RANDOM_INDEX(tablePtr, i) \
sl@0
    44
    (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
sl@0
    45
sl@0
    46
/*
sl@0
    47
 * Prototypes for the array hash key methods.
sl@0
    48
 */
sl@0
    49
sl@0
    50
static Tcl_HashEntry *	AllocArrayEntry _ANSI_ARGS_((
sl@0
    51
			    Tcl_HashTable *tablePtr,
sl@0
    52
			    VOID *keyPtr));
sl@0
    53
static int		CompareArrayKeys _ANSI_ARGS_((
sl@0
    54
			    VOID *keyPtr, Tcl_HashEntry *hPtr));
sl@0
    55
static unsigned int	HashArrayKey _ANSI_ARGS_((
sl@0
    56
			    Tcl_HashTable *tablePtr,
sl@0
    57
			    VOID *keyPtr));
sl@0
    58
sl@0
    59
/*
sl@0
    60
 * Prototypes for the one word hash key methods.
sl@0
    61
 */
sl@0
    62
sl@0
    63
#if 0
sl@0
    64
static Tcl_HashEntry *	AllocOneWordEntry _ANSI_ARGS_((
sl@0
    65
			    Tcl_HashTable *tablePtr,
sl@0
    66
			    VOID *keyPtr));
sl@0
    67
static int		CompareOneWordKeys _ANSI_ARGS_((
sl@0
    68
			    VOID *keyPtr, Tcl_HashEntry *hPtr));
sl@0
    69
static unsigned int	HashOneWordKey _ANSI_ARGS_((
sl@0
    70
			    Tcl_HashTable *tablePtr,
sl@0
    71
			    VOID *keyPtr));
sl@0
    72
#endif
sl@0
    73
sl@0
    74
/*
sl@0
    75
 * Prototypes for the string hash key methods.
sl@0
    76
 */
sl@0
    77
sl@0
    78
static Tcl_HashEntry *	AllocStringEntry _ANSI_ARGS_((
sl@0
    79
			    Tcl_HashTable *tablePtr,
sl@0
    80
			    VOID *keyPtr));
sl@0
    81
static int		CompareStringKeys _ANSI_ARGS_((
sl@0
    82
			    VOID *keyPtr, Tcl_HashEntry *hPtr));
sl@0
    83
static unsigned int	HashStringKey _ANSI_ARGS_((
sl@0
    84
			    Tcl_HashTable *tablePtr,
sl@0
    85
			    VOID *keyPtr));
sl@0
    86
sl@0
    87
/*
sl@0
    88
 * Procedure prototypes for static procedures in this file:
sl@0
    89
 */
sl@0
    90
sl@0
    91
#if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0
    92
static Tcl_HashEntry *	BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
sl@0
    93
			    CONST char *key));
sl@0
    94
static Tcl_HashEntry *	BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
sl@0
    95
			    CONST char *key, int *newPtr));
sl@0
    96
#endif
sl@0
    97
sl@0
    98
static void		RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
sl@0
    99
sl@0
   100
Tcl_HashKeyType tclArrayHashKeyType = {
sl@0
   101
    TCL_HASH_KEY_TYPE_VERSION,		/* version */
sl@0
   102
    TCL_HASH_KEY_RANDOMIZE_HASH,	/* flags */
sl@0
   103
    HashArrayKey,			/* hashKeyProc */
sl@0
   104
    CompareArrayKeys,			/* compareKeysProc */
sl@0
   105
    AllocArrayEntry,			/* allocEntryProc */
sl@0
   106
    NULL				/* freeEntryProc */
sl@0
   107
};
sl@0
   108
sl@0
   109
Tcl_HashKeyType tclOneWordHashKeyType = {
sl@0
   110
    TCL_HASH_KEY_TYPE_VERSION,		/* version */
sl@0
   111
    0,					/* flags */
sl@0
   112
    NULL, /* HashOneWordKey, */		/* hashProc */
sl@0
   113
    NULL, /* CompareOneWordKey, */	/* compareProc */
sl@0
   114
    NULL, /* AllocOneWordKey, */	/* allocEntryProc */
sl@0
   115
    NULL  /* FreeOneWordKey, */		/* freeEntryProc */
sl@0
   116
};
sl@0
   117
sl@0
   118
Tcl_HashKeyType tclStringHashKeyType = {
sl@0
   119
    TCL_HASH_KEY_TYPE_VERSION,		/* version */
sl@0
   120
    0,					/* flags */
sl@0
   121
    HashStringKey,			/* hashKeyProc */
sl@0
   122
    CompareStringKeys,			/* compareKeysProc */
sl@0
   123
    AllocStringEntry,			/* allocEntryProc */
sl@0
   124
    NULL				/* freeEntryProc */
sl@0
   125
};
sl@0
   126
sl@0
   127

sl@0
   128
/*
sl@0
   129
 *----------------------------------------------------------------------
sl@0
   130
 *
sl@0
   131
 * Tcl_InitHashTable --
sl@0
   132
 *
sl@0
   133
 *	Given storage for a hash table, set up the fields to prepare
sl@0
   134
 *	the hash table for use.
sl@0
   135
 *
sl@0
   136
 * Results:
sl@0
   137
 *	None.
sl@0
   138
 *
sl@0
   139
 * Side effects:
sl@0
   140
 *	TablePtr is now ready to be passed to Tcl_FindHashEntry and
sl@0
   141
 *	Tcl_CreateHashEntry.
sl@0
   142
 *
sl@0
   143
 *----------------------------------------------------------------------
sl@0
   144
 */
sl@0
   145
sl@0
   146
#undef Tcl_InitHashTable
sl@0
   147
EXPORT_C void
sl@0
   148
Tcl_InitHashTable(tablePtr, keyType)
sl@0
   149
    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
sl@0
   150
					 * is supplied by the caller. */
sl@0
   151
    int keyType;			/* Type of keys to use in table:
sl@0
   152
					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
sl@0
   153
					 * or an integer >= 2. */
sl@0
   154
{
sl@0
   155
    /*
sl@0
   156
     * Use a special value to inform the extended version that it must
sl@0
   157
     * not access any of the new fields in the Tcl_HashTable. If an
sl@0
   158
     * extension is rebuilt then any calls to this function will be
sl@0
   159
     * redirected to the extended version by a macro.
sl@0
   160
     */
sl@0
   161
    Tcl_InitCustomHashTable(tablePtr, keyType, (Tcl_HashKeyType *) -1);
sl@0
   162
}
sl@0
   163

sl@0
   164
/*
sl@0
   165
 *----------------------------------------------------------------------
sl@0
   166
 *
sl@0
   167
 * Tcl_InitCustomHashTable --
sl@0
   168
 *
sl@0
   169
 *	Given storage for a hash table, set up the fields to prepare
sl@0
   170
 *	the hash table for use. This is an extended version of
sl@0
   171
 *	Tcl_InitHashTable which supports user defined keys.
sl@0
   172
 *
sl@0
   173
 * Results:
sl@0
   174
 *	None.
sl@0
   175
 *
sl@0
   176
 * Side effects:
sl@0
   177
 *	TablePtr is now ready to be passed to Tcl_FindHashEntry and
sl@0
   178
 *	Tcl_CreateHashEntry.
sl@0
   179
 *
sl@0
   180
 *----------------------------------------------------------------------
sl@0
   181
 */
sl@0
   182
sl@0
   183
EXPORT_C void
sl@0
   184
Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)
sl@0
   185
    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which
sl@0
   186
					 * is supplied by the caller. */
sl@0
   187
    int keyType;			/* Type of keys to use in table:
sl@0
   188
					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
sl@0
   189
					 * TCL_CUSTOM_TYPE_KEYS,
sl@0
   190
					 * TCL_CUSTOM_PTR_KEYS,  or an
sl@0
   191
					 * integer >= 2. */
sl@0
   192
    Tcl_HashKeyType *typePtr;		/* Pointer to structure which defines
sl@0
   193
					 * the behaviour of this table. */
sl@0
   194
{
sl@0
   195
#if (TCL_SMALL_HASH_TABLE != 4) 
sl@0
   196
    panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",
sl@0
   197
	    TCL_SMALL_HASH_TABLE);
sl@0
   198
#endif
sl@0
   199
    
sl@0
   200
    tablePtr->buckets = tablePtr->staticBuckets;
sl@0
   201
    tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
sl@0
   202
    tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
sl@0
   203
    tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
sl@0
   204
    tablePtr->numEntries = 0;
sl@0
   205
    tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
sl@0
   206
    tablePtr->downShift = 28;
sl@0
   207
    tablePtr->mask = 3;
sl@0
   208
    tablePtr->keyType = keyType;
sl@0
   209
#if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0
   210
    tablePtr->findProc = Tcl_FindHashEntry;
sl@0
   211
    tablePtr->createProc = Tcl_CreateHashEntry;
sl@0
   212
sl@0
   213
    if (typePtr == NULL) {
sl@0
   214
	/*
sl@0
   215
	 * The caller has been rebuilt so the hash table is an extended
sl@0
   216
	 * version.
sl@0
   217
	 */
sl@0
   218
    } else if (typePtr != (Tcl_HashKeyType *) -1) {
sl@0
   219
	/*
sl@0
   220
	 * The caller is requesting a customized hash table so it must be
sl@0
   221
	 * an extended version.
sl@0
   222
	 */
sl@0
   223
	tablePtr->typePtr = typePtr;
sl@0
   224
    } else {
sl@0
   225
	/*
sl@0
   226
	 * The caller has not been rebuilt so the hash table is not
sl@0
   227
	 * extended.
sl@0
   228
	 */
sl@0
   229
    }
sl@0
   230
#else
sl@0
   231
    if (typePtr == NULL) {
sl@0
   232
	/*
sl@0
   233
	 * Use the key type to decide which key type is needed.
sl@0
   234
	 */
sl@0
   235
	if (keyType == TCL_STRING_KEYS) {
sl@0
   236
	    typePtr = &tclStringHashKeyType;
sl@0
   237
	} else if (keyType == TCL_ONE_WORD_KEYS) {
sl@0
   238
	    typePtr = &tclOneWordHashKeyType;
sl@0
   239
	} else if (keyType == TCL_CUSTOM_TYPE_KEYS) {
sl@0
   240
	    Tcl_Panic ("No type structure specified for TCL_CUSTOM_TYPE_KEYS");
sl@0
   241
	} else if (keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0
   242
	    Tcl_Panic ("No type structure specified for TCL_CUSTOM_PTR_KEYS");
sl@0
   243
	} else {
sl@0
   244
	    typePtr = &tclArrayHashKeyType;
sl@0
   245
	}
sl@0
   246
    } else if (typePtr == (Tcl_HashKeyType *) -1) {
sl@0
   247
	/*
sl@0
   248
	 * If the caller has not been rebuilt then we cannot continue as
sl@0
   249
	 * the hash table is not an extended version.
sl@0
   250
	 */
sl@0
   251
	Tcl_Panic ("Hash table is not compatible");
sl@0
   252
    }
sl@0
   253
    tablePtr->typePtr = typePtr;
sl@0
   254
#endif
sl@0
   255
}
sl@0
   256

sl@0
   257
/*
sl@0
   258
 *----------------------------------------------------------------------
sl@0
   259
 *
sl@0
   260
 * Tcl_FindHashEntry --
sl@0
   261
 *
sl@0
   262
 *	Given a hash table find the entry with a matching key.
sl@0
   263
 *
sl@0
   264
 * Results:
sl@0
   265
 *	The return value is a token for the matching entry in the
sl@0
   266
 *	hash table, or NULL if there was no matching entry.
sl@0
   267
 *
sl@0
   268
 * Side effects:
sl@0
   269
 *	None.
sl@0
   270
 *
sl@0
   271
 *----------------------------------------------------------------------
sl@0
   272
 */
sl@0
   273
sl@0
   274
EXPORT_C Tcl_HashEntry *
sl@0
   275
Tcl_FindHashEntry(tablePtr, key)
sl@0
   276
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
sl@0
   277
    CONST char *key;		/* Key to use to find matching entry. */
sl@0
   278
{
sl@0
   279
    register Tcl_HashEntry *hPtr;
sl@0
   280
    Tcl_HashKeyType *typePtr;
sl@0
   281
    unsigned int hash;
sl@0
   282
    int index;
sl@0
   283
sl@0
   284
#if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0
   285
    if (tablePtr->keyType == TCL_STRING_KEYS) {
sl@0
   286
	typePtr = &tclStringHashKeyType;
sl@0
   287
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
sl@0
   288
	typePtr = &tclOneWordHashKeyType;
sl@0
   289
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
sl@0
   290
	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0
   291
	typePtr = tablePtr->typePtr;
sl@0
   292
    } else {
sl@0
   293
	typePtr = &tclArrayHashKeyType;
sl@0
   294
    }
sl@0
   295
#else
sl@0
   296
    typePtr = tablePtr->typePtr;
sl@0
   297
    if (typePtr == NULL) {
sl@0
   298
	Tcl_Panic("called Tcl_FindHashEntry on deleted table");
sl@0
   299
	return NULL;
sl@0
   300
    }
sl@0
   301
#endif
sl@0
   302
sl@0
   303
    if (typePtr->hashKeyProc) {
sl@0
   304
	hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
sl@0
   305
	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
sl@0
   306
	    index = RANDOM_INDEX (tablePtr, hash);
sl@0
   307
	} else {
sl@0
   308
	    index = hash & tablePtr->mask;
sl@0
   309
	}
sl@0
   310
    } else {
sl@0
   311
	hash = (unsigned int) key;
sl@0
   312
	index = RANDOM_INDEX (tablePtr, hash);
sl@0
   313
    }
sl@0
   314
sl@0
   315
    /*
sl@0
   316
     * Search all of the entries in the appropriate bucket.
sl@0
   317
     */
sl@0
   318
sl@0
   319
    if (typePtr->compareKeysProc) {
sl@0
   320
	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
sl@0
   321
	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
sl@0
   322
	        hPtr = hPtr->nextPtr) {
sl@0
   323
#if TCL_HASH_KEY_STORE_HASH
sl@0
   324
	    if (hash != (unsigned int) hPtr->hash) {
sl@0
   325
		continue;
sl@0
   326
	    }
sl@0
   327
#endif
sl@0
   328
	    if (compareKeysProc ((VOID *) key, hPtr)) {
sl@0
   329
		return hPtr;
sl@0
   330
	    }
sl@0
   331
	}
sl@0
   332
    } else {
sl@0
   333
	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
sl@0
   334
	        hPtr = hPtr->nextPtr) {
sl@0
   335
#if TCL_HASH_KEY_STORE_HASH
sl@0
   336
	    if (hash != (unsigned int) hPtr->hash) {
sl@0
   337
		continue;
sl@0
   338
	    }
sl@0
   339
#endif
sl@0
   340
	    if (key == hPtr->key.oneWordValue) {
sl@0
   341
		return hPtr;
sl@0
   342
	    }
sl@0
   343
	}
sl@0
   344
    }
sl@0
   345
    
sl@0
   346
    return NULL;
sl@0
   347
}
sl@0
   348

sl@0
   349
/*
sl@0
   350
 *----------------------------------------------------------------------
sl@0
   351
 *
sl@0
   352
 * Tcl_CreateHashEntry --
sl@0
   353
 *
sl@0
   354
 *	Given a hash table with string keys, and a string key, find
sl@0
   355
 *	the entry with a matching key.  If there is no matching entry,
sl@0
   356
 *	then create a new entry that does match.
sl@0
   357
 *
sl@0
   358
 * Results:
sl@0
   359
 *	The return value is a pointer to the matching entry.  If this
sl@0
   360
 *	is a newly-created entry, then *newPtr will be set to a non-zero
sl@0
   361
 *	value;  otherwise *newPtr will be set to 0.  If this is a new
sl@0
   362
 *	entry the value stored in the entry will initially be 0.
sl@0
   363
 *
sl@0
   364
 * Side effects:
sl@0
   365
 *	A new entry may be added to the hash table.
sl@0
   366
 *
sl@0
   367
 *----------------------------------------------------------------------
sl@0
   368
 */
sl@0
   369
sl@0
   370
EXPORT_C Tcl_HashEntry *
sl@0
   371
Tcl_CreateHashEntry(tablePtr, key, newPtr)
sl@0
   372
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
sl@0
   373
    CONST char *key;		/* Key to use to find or create matching
sl@0
   374
				 * entry. */
sl@0
   375
    int *newPtr;		/* Store info here telling whether a new
sl@0
   376
				 * entry was created. */
sl@0
   377
{
sl@0
   378
    register Tcl_HashEntry *hPtr;
sl@0
   379
    Tcl_HashKeyType *typePtr;
sl@0
   380
    unsigned int hash;
sl@0
   381
    int index;
sl@0
   382
sl@0
   383
#if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0
   384
    if (tablePtr->keyType == TCL_STRING_KEYS) {
sl@0
   385
	typePtr = &tclStringHashKeyType;
sl@0
   386
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
sl@0
   387
	typePtr = &tclOneWordHashKeyType;
sl@0
   388
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
sl@0
   389
	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0
   390
	typePtr = tablePtr->typePtr;
sl@0
   391
    } else {
sl@0
   392
	typePtr = &tclArrayHashKeyType;
sl@0
   393
    }
sl@0
   394
#else
sl@0
   395
    typePtr = tablePtr->typePtr;
sl@0
   396
    if (typePtr == NULL) {
sl@0
   397
	Tcl_Panic("called Tcl_CreateHashEntry on deleted table");
sl@0
   398
	return NULL;
sl@0
   399
    }
sl@0
   400
#endif
sl@0
   401
sl@0
   402
    if (typePtr->hashKeyProc) {
sl@0
   403
	hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
sl@0
   404
	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
sl@0
   405
	    index = RANDOM_INDEX (tablePtr, hash);
sl@0
   406
	} else {
sl@0
   407
	    index = hash & tablePtr->mask;
sl@0
   408
	}
sl@0
   409
    } else {
sl@0
   410
	hash = (unsigned int) key;
sl@0
   411
	index = RANDOM_INDEX (tablePtr, hash);
sl@0
   412
    }
sl@0
   413
sl@0
   414
    /*
sl@0
   415
     * Search all of the entries in the appropriate bucket.
sl@0
   416
     */
sl@0
   417
sl@0
   418
    if (typePtr->compareKeysProc) {
sl@0
   419
	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
sl@0
   420
	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
sl@0
   421
	        hPtr = hPtr->nextPtr) {
sl@0
   422
#if TCL_HASH_KEY_STORE_HASH
sl@0
   423
	    if (hash != (unsigned int) hPtr->hash) {
sl@0
   424
		continue;
sl@0
   425
	    }
sl@0
   426
#endif
sl@0
   427
	    if (compareKeysProc ((VOID *) key, hPtr)) {
sl@0
   428
		*newPtr = 0;
sl@0
   429
		return hPtr;
sl@0
   430
	    }
sl@0
   431
	}
sl@0
   432
    } else {
sl@0
   433
	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
sl@0
   434
	        hPtr = hPtr->nextPtr) {
sl@0
   435
#if TCL_HASH_KEY_STORE_HASH
sl@0
   436
	    if (hash != (unsigned int) hPtr->hash) {
sl@0
   437
		continue;
sl@0
   438
	    }
sl@0
   439
#endif
sl@0
   440
	    if (key == hPtr->key.oneWordValue) {
sl@0
   441
		*newPtr = 0;
sl@0
   442
		return hPtr;
sl@0
   443
	    }
sl@0
   444
	}
sl@0
   445
    }
sl@0
   446
sl@0
   447
    /*
sl@0
   448
     * Entry not found.  Add a new one to the bucket.
sl@0
   449
     */
sl@0
   450
sl@0
   451
    *newPtr = 1;
sl@0
   452
    if (typePtr->allocEntryProc) {
sl@0
   453
	hPtr = typePtr->allocEntryProc (tablePtr, (VOID *) key);
sl@0
   454
    } else {
sl@0
   455
	hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));
sl@0
   456
	hPtr->key.oneWordValue = (char *) key;
sl@0
   457
    }
sl@0
   458
					 
sl@0
   459
    hPtr->tablePtr = tablePtr;
sl@0
   460
#if TCL_HASH_KEY_STORE_HASH
sl@0
   461
#   if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0
   462
    hPtr->hash = (VOID *) hash;
sl@0
   463
#   else
sl@0
   464
    hPtr->hash = hash;
sl@0
   465
#   endif
sl@0
   466
    hPtr->nextPtr = tablePtr->buckets[index];
sl@0
   467
    tablePtr->buckets[index] = hPtr;
sl@0
   468
#else
sl@0
   469
    hPtr->bucketPtr = &(tablePtr->buckets[index]);
sl@0
   470
    hPtr->nextPtr = *hPtr->bucketPtr;
sl@0
   471
    *hPtr->bucketPtr = hPtr;
sl@0
   472
#endif
sl@0
   473
    hPtr->clientData = 0;
sl@0
   474
    tablePtr->numEntries++;
sl@0
   475
sl@0
   476
    /*
sl@0
   477
     * If the table has exceeded a decent size, rebuild it with many
sl@0
   478
     * more buckets.
sl@0
   479
     */
sl@0
   480
sl@0
   481
    if (tablePtr->numEntries >= tablePtr->rebuildSize) {
sl@0
   482
	RebuildTable(tablePtr);
sl@0
   483
    }
sl@0
   484
    return hPtr;
sl@0
   485
}
sl@0
   486

sl@0
   487
/*
sl@0
   488
 *----------------------------------------------------------------------
sl@0
   489
 *
sl@0
   490
 * Tcl_DeleteHashEntry --
sl@0
   491
 *
sl@0
   492
 *	Remove a single entry from a hash table.
sl@0
   493
 *
sl@0
   494
 * Results:
sl@0
   495
 *	None.
sl@0
   496
 *
sl@0
   497
 * Side effects:
sl@0
   498
 *	The entry given by entryPtr is deleted from its table and
sl@0
   499
 *	should never again be used by the caller.  It is up to the
sl@0
   500
 *	caller to free the clientData field of the entry, if that
sl@0
   501
 *	is relevant.
sl@0
   502
 *
sl@0
   503
 *----------------------------------------------------------------------
sl@0
   504
 */
sl@0
   505
sl@0
   506
EXPORT_C void
sl@0
   507
Tcl_DeleteHashEntry(entryPtr)
sl@0
   508
    Tcl_HashEntry *entryPtr;
sl@0
   509
{
sl@0
   510
    register Tcl_HashEntry *prevPtr;
sl@0
   511
    Tcl_HashKeyType *typePtr;
sl@0
   512
    Tcl_HashTable *tablePtr;
sl@0
   513
    Tcl_HashEntry **bucketPtr;
sl@0
   514
#if TCL_HASH_KEY_STORE_HASH
sl@0
   515
    int index;
sl@0
   516
#endif
sl@0
   517
sl@0
   518
    tablePtr = entryPtr->tablePtr;
sl@0
   519
sl@0
   520
#if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0
   521
    if (tablePtr->keyType == TCL_STRING_KEYS) {
sl@0
   522
	typePtr = &tclStringHashKeyType;
sl@0
   523
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
sl@0
   524
	typePtr = &tclOneWordHashKeyType;
sl@0
   525
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
sl@0
   526
	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0
   527
	typePtr = tablePtr->typePtr;
sl@0
   528
    } else {
sl@0
   529
	typePtr = &tclArrayHashKeyType;
sl@0
   530
    }
sl@0
   531
#else
sl@0
   532
    typePtr = tablePtr->typePtr;
sl@0
   533
#endif
sl@0
   534
    
sl@0
   535
#if TCL_HASH_KEY_STORE_HASH
sl@0
   536
    if (typePtr->hashKeyProc == NULL
sl@0
   537
	|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
sl@0
   538
	index = RANDOM_INDEX (tablePtr, entryPtr->hash);
sl@0
   539
    } else {
sl@0
   540
	index = ((unsigned int) entryPtr->hash) & tablePtr->mask;
sl@0
   541
    }
sl@0
   542
sl@0
   543
    bucketPtr = &(tablePtr->buckets[index]);
sl@0
   544
#else
sl@0
   545
    bucketPtr = entryPtr->bucketPtr;
sl@0
   546
#endif
sl@0
   547
    
sl@0
   548
    if (*bucketPtr == entryPtr) {
sl@0
   549
	*bucketPtr = entryPtr->nextPtr;
sl@0
   550
    } else {
sl@0
   551
	for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) {
sl@0
   552
	    if (prevPtr == NULL) {
sl@0
   553
		panic("malformed bucket chain in Tcl_DeleteHashEntry");
sl@0
   554
	    }
sl@0
   555
	    if (prevPtr->nextPtr == entryPtr) {
sl@0
   556
		prevPtr->nextPtr = entryPtr->nextPtr;
sl@0
   557
		break;
sl@0
   558
	    }
sl@0
   559
	}
sl@0
   560
    }
sl@0
   561
sl@0
   562
    tablePtr->numEntries--;
sl@0
   563
    if (typePtr->freeEntryProc) {
sl@0
   564
	typePtr->freeEntryProc (entryPtr);
sl@0
   565
    } else {
sl@0
   566
	ckfree((char *) entryPtr);
sl@0
   567
    }
sl@0
   568
}
sl@0
   569

sl@0
   570
/*
sl@0
   571
 *----------------------------------------------------------------------
sl@0
   572
 *
sl@0
   573
 * Tcl_DeleteHashTable --
sl@0
   574
 *
sl@0
   575
 *	Free up everything associated with a hash table except for
sl@0
   576
 *	the record for the table itself.
sl@0
   577
 *
sl@0
   578
 * Results:
sl@0
   579
 *	None.
sl@0
   580
 *
sl@0
   581
 * Side effects:
sl@0
   582
 *	The hash table is no longer useable.
sl@0
   583
 *
sl@0
   584
 *----------------------------------------------------------------------
sl@0
   585
 */
sl@0
   586
sl@0
   587
EXPORT_C void
sl@0
   588
Tcl_DeleteHashTable(tablePtr)
sl@0
   589
    register Tcl_HashTable *tablePtr;		/* Table to delete. */
sl@0
   590
{
sl@0
   591
    register Tcl_HashEntry *hPtr, *nextPtr;
sl@0
   592
    Tcl_HashKeyType *typePtr;
sl@0
   593
    int i;
sl@0
   594
sl@0
   595
#if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0
   596
    if (tablePtr->keyType == TCL_STRING_KEYS) {
sl@0
   597
	typePtr = &tclStringHashKeyType;
sl@0
   598
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
sl@0
   599
	typePtr = &tclOneWordHashKeyType;
sl@0
   600
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
sl@0
   601
	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0
   602
	typePtr = tablePtr->typePtr;
sl@0
   603
    } else {
sl@0
   604
	typePtr = &tclArrayHashKeyType;
sl@0
   605
    }
sl@0
   606
#else
sl@0
   607
    typePtr = tablePtr->typePtr;
sl@0
   608
#endif
sl@0
   609
sl@0
   610
    /*
sl@0
   611
     * Free up all the entries in the table.
sl@0
   612
     */
sl@0
   613
sl@0
   614
    for (i = 0; i < tablePtr->numBuckets; i++) {
sl@0
   615
	hPtr = tablePtr->buckets[i];
sl@0
   616
	while (hPtr != NULL) {
sl@0
   617
	    nextPtr = hPtr->nextPtr;
sl@0
   618
	    if (typePtr->freeEntryProc) {
sl@0
   619
		typePtr->freeEntryProc (hPtr);
sl@0
   620
	    } else {
sl@0
   621
		ckfree((char *) hPtr);
sl@0
   622
	    }
sl@0
   623
	    hPtr = nextPtr;
sl@0
   624
	}
sl@0
   625
    }
sl@0
   626
sl@0
   627
    /*
sl@0
   628
     * Free up the bucket array, if it was dynamically allocated.
sl@0
   629
     */
sl@0
   630
sl@0
   631
    if (tablePtr->buckets != tablePtr->staticBuckets) {
sl@0
   632
	ckfree((char *) tablePtr->buckets);
sl@0
   633
    }
sl@0
   634
sl@0
   635
    /*
sl@0
   636
     * Arrange for panics if the table is used again without
sl@0
   637
     * re-initialization.
sl@0
   638
     */
sl@0
   639
sl@0
   640
#if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0
   641
    tablePtr->findProc = BogusFind;
sl@0
   642
    tablePtr->createProc = BogusCreate;
sl@0
   643
#else
sl@0
   644
    tablePtr->typePtr = NULL;
sl@0
   645
#endif
sl@0
   646
}
sl@0
   647

sl@0
   648
/*
sl@0
   649
 *----------------------------------------------------------------------
sl@0
   650
 *
sl@0
   651
 * Tcl_FirstHashEntry --
sl@0
   652
 *
sl@0
   653
 *	Locate the first entry in a hash table and set up a record
sl@0
   654
 *	that can be used to step through all the remaining entries
sl@0
   655
 *	of the table.
sl@0
   656
 *
sl@0
   657
 * Results:
sl@0
   658
 *	The return value is a pointer to the first entry in tablePtr,
sl@0
   659
 *	or NULL if tablePtr has no entries in it.  The memory at
sl@0
   660
 *	*searchPtr is initialized so that subsequent calls to
sl@0
   661
 *	Tcl_NextHashEntry will return all of the entries in the table,
sl@0
   662
 *	one at a time.
sl@0
   663
 *
sl@0
   664
 * Side effects:
sl@0
   665
 *	None.
sl@0
   666
 *
sl@0
   667
 *----------------------------------------------------------------------
sl@0
   668
 */
sl@0
   669
sl@0
   670
EXPORT_C Tcl_HashEntry *
sl@0
   671
Tcl_FirstHashEntry(tablePtr, searchPtr)
sl@0
   672
    Tcl_HashTable *tablePtr;		/* Table to search. */
sl@0
   673
    Tcl_HashSearch *searchPtr;		/* Place to store information about
sl@0
   674
					 * progress through the table. */
sl@0
   675
{
sl@0
   676
    searchPtr->tablePtr = tablePtr;
sl@0
   677
    searchPtr->nextIndex = 0;
sl@0
   678
    searchPtr->nextEntryPtr = NULL;
sl@0
   679
    return Tcl_NextHashEntry(searchPtr);
sl@0
   680
}
sl@0
   681

sl@0
   682
/*
sl@0
   683
 *----------------------------------------------------------------------
sl@0
   684
 *
sl@0
   685
 * Tcl_NextHashEntry --
sl@0
   686
 *
sl@0
   687
 *	Once a hash table enumeration has been initiated by calling
sl@0
   688
 *	Tcl_FirstHashEntry, this procedure may be called to return
sl@0
   689
 *	successive elements of the table.
sl@0
   690
 *
sl@0
   691
 * Results:
sl@0
   692
 *	The return value is the next entry in the hash table being
sl@0
   693
 *	enumerated, or NULL if the end of the table is reached.
sl@0
   694
 *
sl@0
   695
 * Side effects:
sl@0
   696
 *	None.
sl@0
   697
 *
sl@0
   698
 *----------------------------------------------------------------------
sl@0
   699
 */
sl@0
   700
sl@0
   701
EXPORT_C Tcl_HashEntry *
sl@0
   702
Tcl_NextHashEntry(searchPtr)
sl@0
   703
    register Tcl_HashSearch *searchPtr;	/* Place to store information about
sl@0
   704
					 * progress through the table.  Must
sl@0
   705
					 * have been initialized by calling
sl@0
   706
					 * Tcl_FirstHashEntry. */
sl@0
   707
{
sl@0
   708
    Tcl_HashEntry *hPtr;
sl@0
   709
    Tcl_HashTable *tablePtr = searchPtr->tablePtr;
sl@0
   710
sl@0
   711
    while (searchPtr->nextEntryPtr == NULL) {
sl@0
   712
	if (searchPtr->nextIndex >= tablePtr->numBuckets) {
sl@0
   713
	    return NULL;
sl@0
   714
	}
sl@0
   715
	searchPtr->nextEntryPtr =
sl@0
   716
		tablePtr->buckets[searchPtr->nextIndex];
sl@0
   717
	searchPtr->nextIndex++;
sl@0
   718
    }
sl@0
   719
    hPtr = searchPtr->nextEntryPtr;
sl@0
   720
    searchPtr->nextEntryPtr = hPtr->nextPtr;
sl@0
   721
    return hPtr;
sl@0
   722
}
sl@0
   723

sl@0
   724
/*
sl@0
   725
 *----------------------------------------------------------------------
sl@0
   726
 *
sl@0
   727
 * Tcl_HashStats --
sl@0
   728
 *
sl@0
   729
 *	Return statistics describing the layout of the hash table
sl@0
   730
 *	in its hash buckets.
sl@0
   731
 *
sl@0
   732
 * Results:
sl@0
   733
 *	The return value is a malloc-ed string containing information
sl@0
   734
 *	about tablePtr.  It is the caller's responsibility to free
sl@0
   735
 *	this string.
sl@0
   736
 *
sl@0
   737
 * Side effects:
sl@0
   738
 *	None.
sl@0
   739
 *
sl@0
   740
 *----------------------------------------------------------------------
sl@0
   741
 */
sl@0
   742
sl@0
   743
EXPORT_C CONST char *
sl@0
   744
Tcl_HashStats(tablePtr)
sl@0
   745
    Tcl_HashTable *tablePtr;		/* Table for which to produce stats. */
sl@0
   746
{
sl@0
   747
#define NUM_COUNTERS 10
sl@0
   748
    int count[NUM_COUNTERS], overflow, i, j;
sl@0
   749
    double average, tmp;
sl@0
   750
    register Tcl_HashEntry *hPtr;
sl@0
   751
    char *result, *p;
sl@0
   752
sl@0
   753
    /*
sl@0
   754
     * Compute a histogram of bucket usage.
sl@0
   755
     */
sl@0
   756
sl@0
   757
    for (i = 0; i < NUM_COUNTERS; i++) {
sl@0
   758
	count[i] = 0;
sl@0
   759
    }
sl@0
   760
    overflow = 0;
sl@0
   761
    average = 0.0;
sl@0
   762
    for (i = 0; i < tablePtr->numBuckets; i++) {
sl@0
   763
	j = 0;
sl@0
   764
	for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
sl@0
   765
	    j++;
sl@0
   766
	}
sl@0
   767
	if (j < NUM_COUNTERS) {
sl@0
   768
	    count[j]++;
sl@0
   769
	} else {
sl@0
   770
	    overflow++;
sl@0
   771
	}
sl@0
   772
	tmp = j;
sl@0
   773
	average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
sl@0
   774
    }
sl@0
   775
sl@0
   776
    /*
sl@0
   777
     * Print out the histogram and a few other pieces of information.
sl@0
   778
     */
sl@0
   779
sl@0
   780
    result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
sl@0
   781
    sprintf(result, "%d entries in table, %d buckets\n",
sl@0
   782
	    tablePtr->numEntries, tablePtr->numBuckets);
sl@0
   783
    p = result + strlen(result);
sl@0
   784
    for (i = 0; i < NUM_COUNTERS; i++) {
sl@0
   785
	sprintf(p, "number of buckets with %d entries: %d\n",
sl@0
   786
		i, count[i]);
sl@0
   787
	p += strlen(p);
sl@0
   788
    }
sl@0
   789
    sprintf(p, "number of buckets with %d or more entries: %d\n",
sl@0
   790
	    NUM_COUNTERS, overflow);
sl@0
   791
    p += strlen(p);
sl@0
   792
    sprintf(p, "average search distance for entry: %.1f", average);
sl@0
   793
    return result;
sl@0
   794
}
sl@0
   795

sl@0
   796
/*
sl@0
   797
 *----------------------------------------------------------------------
sl@0
   798
 *
sl@0
   799
 * AllocArrayEntry --
sl@0
   800
 *
sl@0
   801
 *	Allocate space for a Tcl_HashEntry containing the array key.
sl@0
   802
 *
sl@0
   803
 * Results:
sl@0
   804
 *	The return value is a pointer to the created entry.
sl@0
   805
 *
sl@0
   806
 * Side effects:
sl@0
   807
 *	None.
sl@0
   808
 *
sl@0
   809
 *----------------------------------------------------------------------
sl@0
   810
 */
sl@0
   811
sl@0
   812
static Tcl_HashEntry *
sl@0
   813
AllocArrayEntry(tablePtr, keyPtr)
sl@0
   814
    Tcl_HashTable *tablePtr;	/* Hash table. */
sl@0
   815
    VOID *keyPtr;		/* Key to store in the hash table entry. */
sl@0
   816
{
sl@0
   817
    int *array = (int *) keyPtr;
sl@0
   818
    register int *iPtr1, *iPtr2;
sl@0
   819
    Tcl_HashEntry *hPtr;
sl@0
   820
    int count;
sl@0
   821
    unsigned int size;
sl@0
   822
sl@0
   823
    count = tablePtr->keyType;
sl@0
   824
    
sl@0
   825
    size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
sl@0
   826
    if (size < sizeof(Tcl_HashEntry))
sl@0
   827
	size = sizeof(Tcl_HashEntry);
sl@0
   828
    hPtr = (Tcl_HashEntry *) ckalloc(size);
sl@0
   829
    
sl@0
   830
    for (iPtr1 = array, iPtr2 = hPtr->key.words;
sl@0
   831
	    count > 0; count--, iPtr1++, iPtr2++) {
sl@0
   832
	*iPtr2 = *iPtr1;
sl@0
   833
    }
sl@0
   834
sl@0
   835
    return hPtr;
sl@0
   836
}
sl@0
   837

sl@0
   838
/*
sl@0
   839
 *----------------------------------------------------------------------
sl@0
   840
 *
sl@0
   841
 * CompareArrayKeys --
sl@0
   842
 *
sl@0
   843
 *	Compares two array keys.
sl@0
   844
 *
sl@0
   845
 * Results:
sl@0
   846
 *	The return value is 0 if they are different and 1 if they are
sl@0
   847
 *	the same.
sl@0
   848
 *
sl@0
   849
 * Side effects:
sl@0
   850
 *	None.
sl@0
   851
 *
sl@0
   852
 *----------------------------------------------------------------------
sl@0
   853
 */
sl@0
   854
sl@0
   855
static int
sl@0
   856
CompareArrayKeys(keyPtr, hPtr)
sl@0
   857
    VOID *keyPtr;		/* New key to compare. */
sl@0
   858
    Tcl_HashEntry *hPtr;	/* Existing key to compare. */
sl@0
   859
{
sl@0
   860
    register CONST int *iPtr1 = (CONST int *) keyPtr;
sl@0
   861
    register CONST int *iPtr2 = (CONST int *) hPtr->key.words;
sl@0
   862
    Tcl_HashTable *tablePtr = hPtr->tablePtr;
sl@0
   863
    int count;
sl@0
   864
sl@0
   865
    for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
sl@0
   866
	if (count == 0) {
sl@0
   867
	    return 1;
sl@0
   868
	}
sl@0
   869
	if (*iPtr1 != *iPtr2) {
sl@0
   870
	    break;
sl@0
   871
	}
sl@0
   872
    }
sl@0
   873
    return 0;
sl@0
   874
}
sl@0
   875

sl@0
   876
/*
sl@0
   877
 *----------------------------------------------------------------------
sl@0
   878
 *
sl@0
   879
 * HashArrayKey --
sl@0
   880
 *
sl@0
   881
 *	Compute a one-word summary of an array, which can be
sl@0
   882
 *	used to generate a hash index.
sl@0
   883
 *
sl@0
   884
 * Results:
sl@0
   885
 *	The return value is a one-word summary of the information in
sl@0
   886
 *	string.
sl@0
   887
 *
sl@0
   888
 * Side effects:
sl@0
   889
 *	None.
sl@0
   890
 *
sl@0
   891
 *----------------------------------------------------------------------
sl@0
   892
 */
sl@0
   893
sl@0
   894
static unsigned int
sl@0
   895
HashArrayKey(tablePtr, keyPtr)
sl@0
   896
    Tcl_HashTable *tablePtr;	/* Hash table. */
sl@0
   897
    VOID *keyPtr;		/* Key from which to compute hash value. */
sl@0
   898
{
sl@0
   899
    register CONST int *array = (CONST int *) keyPtr;
sl@0
   900
    register unsigned int result;
sl@0
   901
    int count;
sl@0
   902
sl@0
   903
    for (result = 0, count = tablePtr->keyType; count > 0;
sl@0
   904
	    count--, array++) {
sl@0
   905
	result += *array;
sl@0
   906
    }
sl@0
   907
    return result;
sl@0
   908
}
sl@0
   909

sl@0
   910
/*
sl@0
   911
 *----------------------------------------------------------------------
sl@0
   912
 *
sl@0
   913
 * AllocStringEntry --
sl@0
   914
 *
sl@0
   915
 *	Allocate space for a Tcl_HashEntry containing the string key.
sl@0
   916
 *
sl@0
   917
 * Results:
sl@0
   918
 *	The return value is a pointer to the created entry.
sl@0
   919
 *
sl@0
   920
 * Side effects:
sl@0
   921
 *	None.
sl@0
   922
 *
sl@0
   923
 *----------------------------------------------------------------------
sl@0
   924
 */
sl@0
   925
sl@0
   926
static Tcl_HashEntry *
sl@0
   927
AllocStringEntry(tablePtr, keyPtr)
sl@0
   928
    Tcl_HashTable *tablePtr;	/* Hash table. */
sl@0
   929
    VOID *keyPtr;		/* Key to store in the hash table entry. */
sl@0
   930
{
sl@0
   931
    CONST char *string = (CONST char *) keyPtr;
sl@0
   932
    Tcl_HashEntry *hPtr;
sl@0
   933
    unsigned int size;
sl@0
   934
sl@0
   935
    size = sizeof(Tcl_HashEntry) + strlen(string) + 1 - sizeof(hPtr->key);
sl@0
   936
    if (size < sizeof(Tcl_HashEntry))
sl@0
   937
	size = sizeof(Tcl_HashEntry);
sl@0
   938
    hPtr = (Tcl_HashEntry *) ckalloc(size);
sl@0
   939
    strcpy(hPtr->key.string, string);
sl@0
   940
sl@0
   941
    return hPtr;
sl@0
   942
}
sl@0
   943

sl@0
   944
/*
sl@0
   945
 *----------------------------------------------------------------------
sl@0
   946
 *
sl@0
   947
 * CompareStringKeys --
sl@0
   948
 *
sl@0
   949
 *	Compares two string keys.
sl@0
   950
 *
sl@0
   951
 * Results:
sl@0
   952
 *	The return value is 0 if they are different and 1 if they are
sl@0
   953
 *	the same.
sl@0
   954
 *
sl@0
   955
 * Side effects:
sl@0
   956
 *	None.
sl@0
   957
 *
sl@0
   958
 *----------------------------------------------------------------------
sl@0
   959
 */
sl@0
   960
sl@0
   961
static int
sl@0
   962
CompareStringKeys(keyPtr, hPtr)
sl@0
   963
    VOID *keyPtr;		/* New key to compare. */
sl@0
   964
    Tcl_HashEntry *hPtr;		/* Existing key to compare. */
sl@0
   965
{
sl@0
   966
    register CONST char *p1 = (CONST char *) keyPtr;
sl@0
   967
    register CONST char *p2 = (CONST char *) hPtr->key.string;
sl@0
   968
sl@0
   969
    for (;; p1++, p2++) {
sl@0
   970
	if (*p1 != *p2) {
sl@0
   971
	    break;
sl@0
   972
	}
sl@0
   973
	if (*p1 == '\0') {
sl@0
   974
	    return 1;
sl@0
   975
	}
sl@0
   976
    }
sl@0
   977
    return 0;
sl@0
   978
}
sl@0
   979

sl@0
   980
/*
sl@0
   981
 *----------------------------------------------------------------------
sl@0
   982
 *
sl@0
   983
 * HashStringKey --
sl@0
   984
 *
sl@0
   985
 *	Compute a one-word summary of a text string, which can be
sl@0
   986
 *	used to generate a hash index.
sl@0
   987
 *
sl@0
   988
 * Results:
sl@0
   989
 *	The return value is a one-word summary of the information in
sl@0
   990
 *	string.
sl@0
   991
 *
sl@0
   992
 * Side effects:
sl@0
   993
 *	None.
sl@0
   994
 *
sl@0
   995
 *----------------------------------------------------------------------
sl@0
   996
 */
sl@0
   997
sl@0
   998
static unsigned int
sl@0
   999
HashStringKey(tablePtr, keyPtr)
sl@0
  1000
    Tcl_HashTable *tablePtr;	/* Hash table. */
sl@0
  1001
    VOID *keyPtr;		/* Key from which to compute hash value. */
sl@0
  1002
{
sl@0
  1003
    register CONST char *string = (CONST char *) keyPtr;
sl@0
  1004
    register unsigned int result;
sl@0
  1005
    register int c;
sl@0
  1006
sl@0
  1007
    /*
sl@0
  1008
     * I tried a zillion different hash functions and asked many other
sl@0
  1009
     * people for advice.  Many people had their own favorite functions,
sl@0
  1010
     * all different, but no-one had much idea why they were good ones.
sl@0
  1011
     * I chose the one below (multiply by 9 and add new character)
sl@0
  1012
     * because of the following reasons:
sl@0
  1013
     *
sl@0
  1014
     * 1. Multiplying by 10 is perfect for keys that are decimal strings,
sl@0
  1015
     *    and multiplying by 9 is just about as good.
sl@0
  1016
     * 2. Times-9 is (shift-left-3) plus (old).  This means that each
sl@0
  1017
     *    character's bits hang around in the low-order bits of the
sl@0
  1018
     *    hash value for ever, plus they spread fairly rapidly up to
sl@0
  1019
     *    the high-order bits to fill out the hash value.  This seems
sl@0
  1020
     *    works well both for decimal and non-decimal strings.
sl@0
  1021
     */
sl@0
  1022
sl@0
  1023
    result = 0;
sl@0
  1024
    while (1) {
sl@0
  1025
	c = *string;
sl@0
  1026
	if (c == 0) {
sl@0
  1027
	    break;
sl@0
  1028
	}
sl@0
  1029
	result += (result<<3) + c;
sl@0
  1030
	string++;
sl@0
  1031
    }
sl@0
  1032
    return result;
sl@0
  1033
}
sl@0
  1034

sl@0
  1035
#if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0
  1036
/*
sl@0
  1037
 *----------------------------------------------------------------------
sl@0
  1038
 *
sl@0
  1039
 * BogusFind --
sl@0
  1040
 *
sl@0
  1041
 *	This procedure is invoked when an Tcl_FindHashEntry is called
sl@0
  1042
 *	on a table that has been deleted.
sl@0
  1043
 *
sl@0
  1044
 * Results:
sl@0
  1045
 *	If panic returns (which it shouldn't) this procedure returns
sl@0
  1046
 *	NULL.
sl@0
  1047
 *
sl@0
  1048
 * Side effects:
sl@0
  1049
 *	Generates a panic.
sl@0
  1050
 *
sl@0
  1051
 *----------------------------------------------------------------------
sl@0
  1052
 */
sl@0
  1053
sl@0
  1054
	/* ARGSUSED */
sl@0
  1055
static Tcl_HashEntry *
sl@0
  1056
BogusFind(tablePtr, key)
sl@0
  1057
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
sl@0
  1058
    CONST char *key;		/* Key to use to find matching entry. */
sl@0
  1059
{
sl@0
  1060
    panic("called Tcl_FindHashEntry on deleted table");
sl@0
  1061
    return NULL;
sl@0
  1062
}
sl@0
  1063

sl@0
  1064
/*
sl@0
  1065
 *----------------------------------------------------------------------
sl@0
  1066
 *
sl@0
  1067
 * BogusCreate --
sl@0
  1068
 *
sl@0
  1069
 *	This procedure is invoked when an Tcl_CreateHashEntry is called
sl@0
  1070
 *	on a table that has been deleted.
sl@0
  1071
 *
sl@0
  1072
 * Results:
sl@0
  1073
 *	If panic returns (which it shouldn't) this procedure returns
sl@0
  1074
 *	NULL.
sl@0
  1075
 *
sl@0
  1076
 * Side effects:
sl@0
  1077
 *	Generates a panic.
sl@0
  1078
 *
sl@0
  1079
 *----------------------------------------------------------------------
sl@0
  1080
 */
sl@0
  1081
sl@0
  1082
	/* ARGSUSED */
sl@0
  1083
static Tcl_HashEntry *
sl@0
  1084
BogusCreate(tablePtr, key, newPtr)
sl@0
  1085
    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */
sl@0
  1086
    CONST char *key;		/* Key to use to find or create matching
sl@0
  1087
				 * entry. */
sl@0
  1088
    int *newPtr;		/* Store info here telling whether a new
sl@0
  1089
				 * entry was created. */
sl@0
  1090
{
sl@0
  1091
    panic("called Tcl_CreateHashEntry on deleted table");
sl@0
  1092
    return NULL;
sl@0
  1093
}
sl@0
  1094
#endif
sl@0
  1095

sl@0
  1096
/*
sl@0
  1097
 *----------------------------------------------------------------------
sl@0
  1098
 *
sl@0
  1099
 * RebuildTable --
sl@0
  1100
 *
sl@0
  1101
 *	This procedure is invoked when the ratio of entries to hash
sl@0
  1102
 *	buckets becomes too large.  It creates a new table with a
sl@0
  1103
 *	larger bucket array and moves all of the entries into the
sl@0
  1104
 *	new table.
sl@0
  1105
 *
sl@0
  1106
 * Results:
sl@0
  1107
 *	None.
sl@0
  1108
 *
sl@0
  1109
 * Side effects:
sl@0
  1110
 *	Memory gets reallocated and entries get re-hashed to new
sl@0
  1111
 *	buckets.
sl@0
  1112
 *
sl@0
  1113
 *----------------------------------------------------------------------
sl@0
  1114
 */
sl@0
  1115
sl@0
  1116
static void
sl@0
  1117
RebuildTable(tablePtr)
sl@0
  1118
    register Tcl_HashTable *tablePtr;	/* Table to enlarge. */
sl@0
  1119
{
sl@0
  1120
    int oldSize, count, index;
sl@0
  1121
    Tcl_HashEntry **oldBuckets;
sl@0
  1122
    register Tcl_HashEntry **oldChainPtr, **newChainPtr;
sl@0
  1123
    register Tcl_HashEntry *hPtr;
sl@0
  1124
    Tcl_HashKeyType *typePtr;
sl@0
  1125
    VOID *key;
sl@0
  1126
sl@0
  1127
    oldSize = tablePtr->numBuckets;
sl@0
  1128
    oldBuckets = tablePtr->buckets;
sl@0
  1129
sl@0
  1130
    /*
sl@0
  1131
     * Allocate and initialize the new bucket array, and set up
sl@0
  1132
     * hashing constants for new array size.
sl@0
  1133
     */
sl@0
  1134
sl@0
  1135
    tablePtr->numBuckets *= 4;
sl@0
  1136
    tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
sl@0
  1137
	    (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
sl@0
  1138
    for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
sl@0
  1139
	    count > 0; count--, newChainPtr++) {
sl@0
  1140
	*newChainPtr = NULL;
sl@0
  1141
    }
sl@0
  1142
    tablePtr->rebuildSize *= 4;
sl@0
  1143
    tablePtr->downShift -= 2;
sl@0
  1144
    tablePtr->mask = (tablePtr->mask << 2) + 3;
sl@0
  1145
sl@0
  1146
#if TCL_PRESERVE_BINARY_COMPATABILITY
sl@0
  1147
    if (tablePtr->keyType == TCL_STRING_KEYS) {
sl@0
  1148
	typePtr = &tclStringHashKeyType;
sl@0
  1149
    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
sl@0
  1150
	typePtr = &tclOneWordHashKeyType;
sl@0
  1151
    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
sl@0
  1152
	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
sl@0
  1153
	typePtr = tablePtr->typePtr;
sl@0
  1154
    } else {
sl@0
  1155
	typePtr = &tclArrayHashKeyType;
sl@0
  1156
    }
sl@0
  1157
#else
sl@0
  1158
    typePtr = tablePtr->typePtr;
sl@0
  1159
#endif
sl@0
  1160
sl@0
  1161
    /*
sl@0
  1162
     * Rehash all of the existing entries into the new bucket array.
sl@0
  1163
     */
sl@0
  1164
sl@0
  1165
    for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
sl@0
  1166
	for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
sl@0
  1167
	    *oldChainPtr = hPtr->nextPtr;
sl@0
  1168
sl@0
  1169
	    key = (VOID *) Tcl_GetHashKey (tablePtr, hPtr);
sl@0
  1170
sl@0
  1171
#if TCL_HASH_KEY_STORE_HASH
sl@0
  1172
	    if (typePtr->hashKeyProc == NULL
sl@0
  1173
		|| typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
sl@0
  1174
		index = RANDOM_INDEX (tablePtr, hPtr->hash);
sl@0
  1175
	    } else {
sl@0
  1176
		index = ((unsigned int) hPtr->hash) & tablePtr->mask;
sl@0
  1177
	    }
sl@0
  1178
	    hPtr->nextPtr = tablePtr->buckets[index];
sl@0
  1179
	    tablePtr->buckets[index] = hPtr;
sl@0
  1180
#else
sl@0
  1181
	    if (typePtr->hashKeyProc) {
sl@0
  1182
		unsigned int hash;
sl@0
  1183
		hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);
sl@0
  1184
		if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
sl@0
  1185
		    index = RANDOM_INDEX (tablePtr, hash);
sl@0
  1186
		} else {
sl@0
  1187
		    index = hash & tablePtr->mask;
sl@0
  1188
		}
sl@0
  1189
	    } else {
sl@0
  1190
		index = RANDOM_INDEX (tablePtr, key);
sl@0
  1191
	    }
sl@0
  1192
sl@0
  1193
	    hPtr->bucketPtr = &(tablePtr->buckets[index]);
sl@0
  1194
	    hPtr->nextPtr = *hPtr->bucketPtr;
sl@0
  1195
	    *hPtr->bucketPtr = hPtr;
sl@0
  1196
#endif
sl@0
  1197
	}
sl@0
  1198
    }
sl@0
  1199
sl@0
  1200
    /*
sl@0
  1201
     * Free up the old bucket array, if it was dynamically allocated.
sl@0
  1202
     */
sl@0
  1203
sl@0
  1204
    if (oldBuckets != tablePtr->staticBuckets) {
sl@0
  1205
	ckfree((char *) oldBuckets);
sl@0
  1206
    }
sl@0
  1207
}