Misc. updates to get a clean make on Linux. A bit of
[catagits/fcgi2.git] / examples / tclHash.c
CommitLineData
0198fd3c 1/*
2 * tclHash.c --
3 *
4 * Implementation of in-memory hash tables for Tcl and Tcl-based
5 * applications.
6 *
7 * Copyright (c) 1991-1993 The Regents of the University of California.
8 * Copyright (c) 1994 Sun Microsystems, Inc.
9 *
10 * This software is copyrighted by the Regents of the University of
11 * California, Sun Microsystems, Inc., and other parties. The following
12 * terms apply to all files associated with the software unless explicitly
13 * disclaimed in individual files.
14 *
15 * The authors hereby grant permission to use, copy, modify, distribute,
16 * and license this software and its documentation for any purpose, provided
17 * that existing copyright notices are retained in all copies and that this
18 * notice is included verbatim in any distributions. No written agreement,
19 * license, or royalty fee is required for any of the authorized uses.
20 * Modifications to this software may be copyrighted by their authors
21 * and need not follow the licensing terms described here, provided that
22 * the new terms are clearly indicated on the first page of each file where
23 * they apply.
24 *
25 * IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY
26 * FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
27 * ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
28 * DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
29 * POSSIBILITY OF SUCH DAMAGE.
30 *
31 * THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES,
32 * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
33 * FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE
34 * IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE
35 * NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
36 * MODIFICATIONS.
37 *
38 * RESTRICTED RIGHTS: Use, duplication or disclosure by the government
39 * is subject to the restrictions as set forth in subparagraph (c) (1) (ii)
40 * of the Rights in Technical Data and Computer Software Clause as DFARS
41 * 252.227-7013 and FAR 52.227-19.
42 *
2fd179ab 43 * $Id: tclHash.c,v 1.2 1999/01/30 22:27:35 roberts Exp $
0198fd3c 44 *
45 */
46
47#ifndef lint
2fd179ab 48static const char rcsid[] = "$Id: tclHash.c,v 1.2 1999/01/30 22:27:35 roberts Exp $";
0198fd3c 49#endif /* not lint */
50
51#include "tclInt.h"
52
53/*
54 * When there are this many entries per bucket, on average, rebuild
55 * the hash table to make it larger.
56 */
57
58#define REBUILD_MULTIPLIER 3
59
60
61/*
62 * The following macro takes a preliminary integer hash value and
63 * produces an index into a hash tables bucket list. The idea is
64 * to make it so that preliminary values that are arbitrarily similar
65 * will end up in different buckets. The hash function was taken
66 * from a random-number generator.
67 */
68
69#define RANDOM_INDEX(tablePtr, i) \
70 (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
71
72/*
73 * Procedure prototypes for static procedures in this file:
74 */
75
76static Tcl_HashEntry * ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
77 char *key));
78static Tcl_HashEntry * ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
79 char *key, int *newPtr));
80static Tcl_HashEntry * BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
81 char *key));
82static Tcl_HashEntry * BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
83 char *key, int *newPtr));
84static unsigned int HashString _ANSI_ARGS_((char *string));
85static void RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
86static Tcl_HashEntry * StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
87 char *key));
88static Tcl_HashEntry * StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
89 char *key, int *newPtr));
90static Tcl_HashEntry * OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
91 char *key));
92static Tcl_HashEntry * OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
93 char *key, int *newPtr));
94\f
95/*
96 *----------------------------------------------------------------------
97 *
98 * Tcl_InitHashTable --
99 *
100 * Given storage for a hash table, set up the fields to prepare
101 * the hash table for use.
102 *
103 * Results:
104 * None.
105 *
106 * Side effects:
107 * TablePtr is now ready to be passed to Tcl_FindHashEntry and
108 * Tcl_CreateHashEntry.
109 *
110 *----------------------------------------------------------------------
111 */
112
113void
114Tcl_InitHashTable(tablePtr, keyType)
115 register Tcl_HashTable *tablePtr; /* Pointer to table record, which
116 * is supplied by the caller. */
117 int keyType; /* Type of keys to use in table:
118 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
119 * or an integer >= 2. */
120{
121 tablePtr->buckets = tablePtr->staticBuckets;
122 tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
123 tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
124 tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
125 tablePtr->numEntries = 0;
126 tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
127 tablePtr->downShift = 28;
128 tablePtr->mask = 3;
129 tablePtr->keyType = keyType;
130 if (keyType == TCL_STRING_KEYS) {
131 tablePtr->findProc = StringFind;
132 tablePtr->createProc = StringCreate;
133 } else if (keyType == TCL_ONE_WORD_KEYS) {
134 tablePtr->findProc = OneWordFind;
135 tablePtr->createProc = OneWordCreate;
136 } else {
137 tablePtr->findProc = ArrayFind;
138 tablePtr->createProc = ArrayCreate;
139 };
140}
141\f
142/*
143 *----------------------------------------------------------------------
144 *
145 * Tcl_DeleteHashEntry --
146 *
147 * Remove a single entry from a hash table.
148 *
149 * Results:
150 * None.
151 *
152 * Side effects:
153 * The entry given by entryPtr is deleted from its table and
154 * should never again be used by the caller. It is up to the
155 * caller to free the clientData field of the entry, if that
156 * is relevant.
157 *
158 *----------------------------------------------------------------------
159 */
160
161void
162Tcl_DeleteHashEntry(entryPtr)
163 Tcl_HashEntry *entryPtr;
164{
165 register Tcl_HashEntry *prevPtr;
166
167 if (*entryPtr->bucketPtr == entryPtr) {
168 *entryPtr->bucketPtr = entryPtr->nextPtr;
169 } else {
170 for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) {
171 if (prevPtr == NULL) {
172 panic("malformed bucket chain in Tcl_DeleteHashEntry");
173 }
174 if (prevPtr->nextPtr == entryPtr) {
175 prevPtr->nextPtr = entryPtr->nextPtr;
176 break;
177 }
178 }
179 }
180 entryPtr->tablePtr->numEntries--;
181 ckfree((char *) entryPtr);
182}
183\f
184/*
185 *----------------------------------------------------------------------
186 *
187 * Tcl_DeleteHashTable --
188 *
189 * Free up everything associated with a hash table except for
190 * the record for the table itself.
191 *
192 * Results:
193 * None.
194 *
195 * Side effects:
196 * The hash table is no longer useable.
197 *
198 *----------------------------------------------------------------------
199 */
200
201void
202Tcl_DeleteHashTable(tablePtr)
203 register Tcl_HashTable *tablePtr; /* Table to delete. */
204{
205 register Tcl_HashEntry *hPtr, *nextPtr;
206 int i;
207
208 /*
209 * Free up all the entries in the table.
210 */
211
212 for (i = 0; i < tablePtr->numBuckets; i++) {
213 hPtr = tablePtr->buckets[i];
214 while (hPtr != NULL) {
215 nextPtr = hPtr->nextPtr;
216 ckfree((char *) hPtr);
217 hPtr = nextPtr;
218 }
219 }
220
221 /*
222 * Free up the bucket array, if it was dynamically allocated.
223 */
224
225 if (tablePtr->buckets != tablePtr->staticBuckets) {
226 ckfree((char *) tablePtr->buckets);
227 }
228
229 /*
230 * Arrange for panics if the table is used again without
231 * re-initialization.
232 */
233
234 tablePtr->findProc = BogusFind;
235 tablePtr->createProc = BogusCreate;
236}
237\f
238/*
239 *----------------------------------------------------------------------
240 *
241 * Tcl_FirstHashEntry --
242 *
243 * Locate the first entry in a hash table and set up a record
244 * that can be used to step through all the remaining entries
245 * of the table.
246 *
247 * Results:
248 * The return value is a pointer to the first entry in tablePtr,
249 * or NULL if tablePtr has no entries in it. The memory at
250 * *searchPtr is initialized so that subsequent calls to
251 * Tcl_NextHashEntry will return all of the entries in the table,
252 * one at a time.
253 *
254 * Side effects:
255 * None.
256 *
257 *----------------------------------------------------------------------
258 */
259
260Tcl_HashEntry *
261Tcl_FirstHashEntry(tablePtr, searchPtr)
262 Tcl_HashTable *tablePtr; /* Table to search. */
263 Tcl_HashSearch *searchPtr; /* Place to store information about
264 * progress through the table. */
265{
266 searchPtr->tablePtr = tablePtr;
267 searchPtr->nextIndex = 0;
268 searchPtr->nextEntryPtr = NULL;
269 return Tcl_NextHashEntry(searchPtr);
270}
271\f
272/*
273 *----------------------------------------------------------------------
274 *
275 * Tcl_NextHashEntry --
276 *
277 * Once a hash table enumeration has been initiated by calling
278 * Tcl_FirstHashEntry, this procedure may be called to return
279 * successive elements of the table.
280 *
281 * Results:
282 * The return value is the next entry in the hash table being
283 * enumerated, or NULL if the end of the table is reached.
284 *
285 * Side effects:
286 * None.
287 *
288 *----------------------------------------------------------------------
289 */
290
291Tcl_HashEntry *
292Tcl_NextHashEntry(searchPtr)
293 register Tcl_HashSearch *searchPtr; /* Place to store information about
294 * progress through the table. Must
295 * have been initialized by calling
296 * Tcl_FirstHashEntry. */
297{
298 Tcl_HashEntry *hPtr;
299
300 while (searchPtr->nextEntryPtr == NULL) {
301 if (searchPtr->nextIndex >= searchPtr->tablePtr->numBuckets) {
302 return NULL;
303 }
304 searchPtr->nextEntryPtr =
305 searchPtr->tablePtr->buckets[searchPtr->nextIndex];
306 searchPtr->nextIndex++;
307 }
308 hPtr = searchPtr->nextEntryPtr;
309 searchPtr->nextEntryPtr = hPtr->nextPtr;
310 return hPtr;
311}
312\f
313/*
314 *----------------------------------------------------------------------
315 *
316 * Tcl_HashStats --
317 *
318 * Return statistics describing the layout of the hash table
319 * in its hash buckets.
320 *
321 * Results:
322 * The return value is a malloc-ed string containing information
323 * about tablePtr. It is the caller's responsibility to free
324 * this string.
325 *
326 * Side effects:
327 * None.
328 *
329 *----------------------------------------------------------------------
330 */
331
332char *
333Tcl_HashStats(tablePtr)
334 Tcl_HashTable *tablePtr; /* Table for which to produce stats. */
335{
336#define NUM_COUNTERS 10
337 int count[NUM_COUNTERS], overflow, i, j;
338 double average, tmp;
339 register Tcl_HashEntry *hPtr;
340 char *result, *p;
341
342 /*
343 * Compute a histogram of bucket usage.
344 */
345
346 for (i = 0; i < NUM_COUNTERS; i++) {
347 count[i] = 0;
348 }
349 overflow = 0;
350 average = 0.0;
351 for (i = 0; i < tablePtr->numBuckets; i++) {
352 j = 0;
353 for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
354 j++;
355 }
356 if (j < NUM_COUNTERS) {
357 count[j]++;
358 } else {
359 overflow++;
360 }
361 tmp = j;
362 average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
363 }
364
365 /*
366 * Print out the histogram and a few other pieces of information.
367 */
368
369 result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
370 sprintf(result, "%d entries in table, %d buckets\n",
371 tablePtr->numEntries, tablePtr->numBuckets);
372 p = result + strlen(result);
373 for (i = 0; i < NUM_COUNTERS; i++) {
374 sprintf(p, "number of buckets with %d entries: %d\n",
375 i, count[i]);
376 p += strlen(p);
377 }
378 sprintf(p, "number of buckets with %d or more entries: %d\n",
379 NUM_COUNTERS, overflow);
380 p += strlen(p);
381 sprintf(p, "average search distance for entry: %.1f", average);
382 return result;
383}
384\f
385/*
386 *----------------------------------------------------------------------
387 *
388 * HashString --
389 *
390 * Compute a one-word summary of a text string, which can be
391 * used to generate a hash index.
392 *
393 * Results:
394 * The return value is a one-word summary of the information in
395 * string.
396 *
397 * Side effects:
398 * None.
399 *
400 *----------------------------------------------------------------------
401 */
402
403static unsigned int
404HashString(string)
405 register char *string; /* String from which to compute hash value. */
406{
407 register unsigned int result;
408 register int c;
409
410 /*
411 * I tried a zillion different hash functions and asked many other
412 * people for advice. Many people had their own favorite functions,
413 * all different, but no-one had much idea why they were good ones.
414 * I chose the one below (multiply by 9 and add new character)
415 * because of the following reasons:
416 *
417 * 1. Multiplying by 10 is perfect for keys that are decimal strings,
418 * and multiplying by 9 is just about as good.
419 * 2. Times-9 is (shift-left-3) plus (old). This means that each
420 * character's bits hang around in the low-order bits of the
421 * hash value for ever, plus they spread fairly rapidly up to
422 * the high-order bits to fill out the hash value. This seems
423 * works well both for decimal and non-decimal strings.
424 */
425
426 result = 0;
427 while (1) {
428 c = *string;
429 string++;
430 if (c == 0) {
431 break;
432 }
433 result += (result<<3) + c;
434 }
435 return result;
436}
437\f
438/*
439 *----------------------------------------------------------------------
440 *
441 * StringFind --
442 *
443 * Given a hash table with string keys, and a string key, find
444 * the entry with a matching key.
445 *
446 * Results:
447 * The return value is a token for the matching entry in the
448 * hash table, or NULL if there was no matching entry.
449 *
450 * Side effects:
451 * None.
452 *
453 *----------------------------------------------------------------------
454 */
455
456static Tcl_HashEntry *
457StringFind(tablePtr, key)
458 Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
459 char *key; /* Key to use to find matching entry. */
460{
461 register Tcl_HashEntry *hPtr;
462 register char *p1, *p2;
463 int index;
464
465 index = HashString(key) & tablePtr->mask;
466
467 /*
468 * Search all of the entries in the appropriate bucket.
469 */
470
471 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
472 hPtr = hPtr->nextPtr) {
473 for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
474 if (*p1 != *p2) {
475 break;
476 }
477 if (*p1 == '\0') {
478 return hPtr;
479 }
480 }
481 }
482 return NULL;
483}
484\f
485/*
486 *----------------------------------------------------------------------
487 *
488 * StringCreate --
489 *
490 * Given a hash table with string keys, and a string key, find
491 * the entry with a matching key. If there is no matching entry,
492 * then create a new entry that does match.
493 *
494 * Results:
495 * The return value is a pointer to the matching entry. If this
496 * is a newly-created entry, then *newPtr will be set to a non-zero
497 * value; otherwise *newPtr will be set to 0. If this is a new
498 * entry the value stored in the entry will initially be 0.
499 *
500 * Side effects:
501 * A new entry may be added to the hash table.
502 *
503 *----------------------------------------------------------------------
504 */
505
506static Tcl_HashEntry *
507StringCreate(tablePtr, key, newPtr)
508 Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
509 char *key; /* Key to use to find or create matching
510 * entry. */
511 int *newPtr; /* Store info here telling whether a new
512 * entry was created. */
513{
514 register Tcl_HashEntry *hPtr;
515 register char *p1, *p2;
516 int index;
517
518 index = HashString(key) & tablePtr->mask;
519
520 /*
521 * Search all of the entries in this bucket.
522 */
523
524 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
525 hPtr = hPtr->nextPtr) {
526 for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
527 if (*p1 != *p2) {
528 break;
529 }
530 if (*p1 == '\0') {
531 *newPtr = 0;
532 return hPtr;
533 }
534 }
535 }
536
537 /*
538 * Entry not found. Add a new one to the bucket.
539 */
540
541 *newPtr = 1;
542 hPtr = (Tcl_HashEntry *) ckalloc((unsigned)
543 (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1)));
544 hPtr->tablePtr = tablePtr;
545 hPtr->bucketPtr = &(tablePtr->buckets[index]);
546 hPtr->nextPtr = *hPtr->bucketPtr;
547 hPtr->clientData = 0;
548 strcpy(hPtr->key.string, key);
549 *hPtr->bucketPtr = hPtr;
550 tablePtr->numEntries++;
551
552 /*
553 * If the table has exceeded a decent size, rebuild it with many
554 * more buckets.
555 */
556
557 if (tablePtr->numEntries >= tablePtr->rebuildSize) {
558 RebuildTable(tablePtr);
559 }
560 return hPtr;
561}
562\f
563/*
564 *----------------------------------------------------------------------
565 *
566 * OneWordFind --
567 *
568 * Given a hash table with one-word keys, and a one-word key, find
569 * the entry with a matching key.
570 *
571 * Results:
572 * The return value is a token for the matching entry in the
573 * hash table, or NULL if there was no matching entry.
574 *
575 * Side effects:
576 * None.
577 *
578 *----------------------------------------------------------------------
579 */
580
581static Tcl_HashEntry *
582OneWordFind(tablePtr, key)
583 Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
584 register char *key; /* Key to use to find matching entry. */
585{
586 register Tcl_HashEntry *hPtr;
587 int index;
588
589 index = RANDOM_INDEX(tablePtr, key);
590
591 /*
592 * Search all of the entries in the appropriate bucket.
593 */
594
595 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
596 hPtr = hPtr->nextPtr) {
597 if (hPtr->key.oneWordValue == key) {
598 return hPtr;
599 }
600 }
601 return NULL;
602}
603\f
604/*
605 *----------------------------------------------------------------------
606 *
607 * OneWordCreate --
608 *
609 * Given a hash table with one-word keys, and a one-word key, find
610 * the entry with a matching key. If there is no matching entry,
611 * then create a new entry that does match.
612 *
613 * Results:
614 * The return value is a pointer to the matching entry. If this
615 * is a newly-created entry, then *newPtr will be set to a non-zero
616 * value; otherwise *newPtr will be set to 0. If this is a new
617 * entry the value stored in the entry will initially be 0.
618 *
619 * Side effects:
620 * A new entry may be added to the hash table.
621 *
622 *----------------------------------------------------------------------
623 */
624
625static Tcl_HashEntry *
626OneWordCreate(tablePtr, key, newPtr)
627 Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
628 register char *key; /* Key to use to find or create matching
629 * entry. */
630 int *newPtr; /* Store info here telling whether a new
631 * entry was created. */
632{
633 register Tcl_HashEntry *hPtr;
634 int index;
635
636 index = RANDOM_INDEX(tablePtr, key);
637
638 /*
639 * Search all of the entries in this bucket.
640 */
641
642 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
643 hPtr = hPtr->nextPtr) {
644 if (hPtr->key.oneWordValue == key) {
645 *newPtr = 0;
646 return hPtr;
647 }
648 }
649
650 /*
651 * Entry not found. Add a new one to the bucket.
652 */
653
654 *newPtr = 1;
655 hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry));
656 hPtr->tablePtr = tablePtr;
657 hPtr->bucketPtr = &(tablePtr->buckets[index]);
658 hPtr->nextPtr = *hPtr->bucketPtr;
659 hPtr->clientData = 0;
660 hPtr->key.oneWordValue = key;
661 *hPtr->bucketPtr = hPtr;
662 tablePtr->numEntries++;
663
664 /*
665 * If the table has exceeded a decent size, rebuild it with many
666 * more buckets.
667 */
668
669 if (tablePtr->numEntries >= tablePtr->rebuildSize) {
670 RebuildTable(tablePtr);
671 }
672 return hPtr;
673}
674\f
675/*
676 *----------------------------------------------------------------------
677 *
678 * ArrayFind --
679 *
680 * Given a hash table with array-of-int keys, and a key, find
681 * the entry with a matching key.
682 *
683 * Results:
684 * The return value is a token for the matching entry in the
685 * hash table, or NULL if there was no matching entry.
686 *
687 * Side effects:
688 * None.
689 *
690 *----------------------------------------------------------------------
691 */
692
693static Tcl_HashEntry *
694ArrayFind(tablePtr, key)
695 Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
696 char *key; /* Key to use to find matching entry. */
697{
698 register Tcl_HashEntry *hPtr;
699 int *arrayPtr = (int *) key;
700 register int *iPtr1, *iPtr2;
701 int index, count;
702
703 for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
704 count > 0; count--, iPtr1++) {
705 index += *iPtr1;
706 }
707 index = RANDOM_INDEX(tablePtr, index);
708
709 /*
710 * Search all of the entries in the appropriate bucket.
711 */
712
713 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
714 hPtr = hPtr->nextPtr) {
715 for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
716 count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
717 if (count == 0) {
718 return hPtr;
719 }
720 if (*iPtr1 != *iPtr2) {
721 break;
722 }
723 }
724 }
725 return NULL;
726}
727\f
728/*
729 *----------------------------------------------------------------------
730 *
731 * ArrayCreate --
732 *
733 * Given a hash table with one-word keys, and a one-word key, find
734 * the entry with a matching key. If there is no matching entry,
735 * then create a new entry that does match.
736 *
737 * Results:
738 * The return value is a pointer to the matching entry. If this
739 * is a newly-created entry, then *newPtr will be set to a non-zero
740 * value; otherwise *newPtr will be set to 0. If this is a new
741 * entry the value stored in the entry will initially be 0.
742 *
743 * Side effects:
744 * A new entry may be added to the hash table.
745 *
746 *----------------------------------------------------------------------
747 */
748
749static Tcl_HashEntry *
750ArrayCreate(tablePtr, key, newPtr)
751 Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
752 register char *key; /* Key to use to find or create matching
753 * entry. */
754 int *newPtr; /* Store info here telling whether a new
755 * entry was created. */
756{
757 register Tcl_HashEntry *hPtr;
758 int *arrayPtr = (int *) key;
759 register int *iPtr1, *iPtr2;
760 int index, count;
761
762 for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
763 count > 0; count--, iPtr1++) {
764 index += *iPtr1;
765 }
766 index = RANDOM_INDEX(tablePtr, index);
767
768 /*
769 * Search all of the entries in the appropriate bucket.
770 */
771
772 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
773 hPtr = hPtr->nextPtr) {
774 for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
775 count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
776 if (count == 0) {
777 *newPtr = 0;
778 return hPtr;
779 }
780 if (*iPtr1 != *iPtr2) {
781 break;
782 }
783 }
784 }
785
786 /*
787 * Entry not found. Add a new one to the bucket.
788 */
789
790 *newPtr = 1;
791 hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)
792 + (tablePtr->keyType*sizeof(int)) - 4));
793 hPtr->tablePtr = tablePtr;
794 hPtr->bucketPtr = &(tablePtr->buckets[index]);
795 hPtr->nextPtr = *hPtr->bucketPtr;
796 hPtr->clientData = 0;
797 for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType;
798 count > 0; count--, iPtr1++, iPtr2++) {
799 *iPtr2 = *iPtr1;
800 }
801 *hPtr->bucketPtr = hPtr;
802 tablePtr->numEntries++;
803
804 /*
805 * If the table has exceeded a decent size, rebuild it with many
806 * more buckets.
807 */
808
809 if (tablePtr->numEntries >= tablePtr->rebuildSize) {
810 RebuildTable(tablePtr);
811 }
812 return hPtr;
813}
814\f
815/*
816 *----------------------------------------------------------------------
817 *
818 * BogusFind --
819 *
820 * This procedure is invoked when an Tcl_FindHashEntry is called
821 * on a table that has been deleted.
822 *
823 * Results:
824 * If panic returns (which it shouldn't) this procedure returns
825 * NULL.
826 *
827 * Side effects:
828 * Generates a panic.
829 *
830 *----------------------------------------------------------------------
831 */
832
833 /* ARGSUSED */
834static Tcl_HashEntry *
835BogusFind(tablePtr, key)
836 Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
837 char *key; /* Key to use to find matching entry. */
838{
839 panic("called Tcl_FindHashEntry on deleted table");
840 return NULL;
841}
842\f
843/*
844 *----------------------------------------------------------------------
845 *
846 * BogusCreate --
847 *
848 * This procedure is invoked when an Tcl_CreateHashEntry is called
849 * on a table that has been deleted.
850 *
851 * Results:
852 * If panic returns (which it shouldn't) this procedure returns
853 * NULL.
854 *
855 * Side effects:
856 * Generates a panic.
857 *
858 *----------------------------------------------------------------------
859 */
860
861 /* ARGSUSED */
862static Tcl_HashEntry *
863BogusCreate(tablePtr, key, newPtr)
864 Tcl_HashTable *tablePtr; /* Table in which to lookup entry. */
865 char *key; /* Key to use to find or create matching
866 * entry. */
867 int *newPtr; /* Store info here telling whether a new
868 * entry was created. */
869{
870 panic("called Tcl_CreateHashEntry on deleted table");
871 return NULL;
872}
873\f
874/*
875 *----------------------------------------------------------------------
876 *
877 * RebuildTable --
878 *
879 * This procedure is invoked when the ratio of entries to hash
880 * buckets becomes too large. It creates a new table with a
881 * larger bucket array and moves all of the entries into the
882 * new table.
883 *
884 * Results:
885 * None.
886 *
887 * Side effects:
888 * Memory gets reallocated and entries get re-hashed to new
889 * buckets.
890 *
891 *----------------------------------------------------------------------
892 */
893
894static void
895RebuildTable(tablePtr)
896 register Tcl_HashTable *tablePtr; /* Table to enlarge. */
897{
898 int oldSize, count, index;
899 Tcl_HashEntry **oldBuckets;
900 register Tcl_HashEntry **oldChainPtr, **newChainPtr;
901 register Tcl_HashEntry *hPtr;
902
903 oldSize = tablePtr->numBuckets;
904 oldBuckets = tablePtr->buckets;
905
906 /*
907 * Allocate and initialize the new bucket array, and set up
908 * hashing constants for new array size.
909 */
910
911 tablePtr->numBuckets *= 4;
912 tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
913 (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
914 for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
915 count > 0; count--, newChainPtr++) {
916 *newChainPtr = NULL;
917 }
918 tablePtr->rebuildSize *= 4;
919 tablePtr->downShift -= 2;
920 tablePtr->mask = (tablePtr->mask << 2) + 3;
921
922 /*
923 * Rehash all of the existing entries into the new bucket array.
924 */
925
926 for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
927 for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
928 *oldChainPtr = hPtr->nextPtr;
929 if (tablePtr->keyType == TCL_STRING_KEYS) {
930 index = HashString(hPtr->key.string) & tablePtr->mask;
931 } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
932 index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
933 } else {
934 register int *iPtr;
935 int count;
936
937 for (index = 0, count = tablePtr->keyType,
938 iPtr = hPtr->key.words; count > 0; count--, iPtr++) {
939 index += *iPtr;
940 }
941 index = RANDOM_INDEX(tablePtr, index);
942 }
943 hPtr->bucketPtr = &(tablePtr->buckets[index]);
944 hPtr->nextPtr = *hPtr->bucketPtr;
945 *hPtr->bucketPtr = hPtr;
946 }
947 }
948
949 /*
950 * Free up the old bucket array, if it was dynamically allocated.
951 */
952
953 if (oldBuckets != tablePtr->staticBuckets) {
954 ckfree((char *) oldBuckets);
955 }
956}