tiny-authorizer renamed authorizer
[catagits/fcgi2.git] / examples / SampleStore / tclHash.c
CommitLineData
8ee4da75 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 *
43 * $Id: tclHash.c,v 1.1 1999/07/28 01:11:47 roberts Exp $
44 *
45 */
46
47#ifndef lint
48static const char rcsid[] = "$Id: tclHash.c,v 1.1 1999/07/28 01:11:47 roberts Exp $";
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(register Tcl_HashTable *tablePtr, int keyType)
115{
116 tablePtr->buckets = tablePtr->staticBuckets;
117 tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
118 tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
119 tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
120 tablePtr->numEntries = 0;
121 tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
122 tablePtr->downShift = 28;
123 tablePtr->mask = 3;
124 tablePtr->keyType = keyType;
125 if (keyType == TCL_STRING_KEYS) {
126 tablePtr->findProc = StringFind;
127 tablePtr->createProc = StringCreate;
128 } else if (keyType == TCL_ONE_WORD_KEYS) {
129 tablePtr->findProc = OneWordFind;
130 tablePtr->createProc = OneWordCreate;
131 } else {
132 tablePtr->findProc = ArrayFind;
133 tablePtr->createProc = ArrayCreate;
134 };
135}
136\f
137/*
138 *----------------------------------------------------------------------
139 *
140 * Tcl_DeleteHashEntry --
141 *
142 * Remove a single entry from a hash table.
143 *
144 * Results:
145 * None.
146 *
147 * Side effects:
148 * The entry given by entryPtr is deleted from its table and
149 * should never again be used by the caller. It is up to the
150 * caller to free the clientData field of the entry, if that
151 * is relevant.
152 *
153 *----------------------------------------------------------------------
154 */
155
156void
157Tcl_DeleteHashEntry(Tcl_HashEntry *entryPtr)
158{
159 register Tcl_HashEntry *prevPtr;
160
161 if (*entryPtr->bucketPtr == entryPtr) {
162 *entryPtr->bucketPtr = entryPtr->nextPtr;
163 } else {
164 for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) {
165 if (prevPtr == NULL) {
166 panic("malformed bucket chain in Tcl_DeleteHashEntry");
167 }
168 if (prevPtr->nextPtr == entryPtr) {
169 prevPtr->nextPtr = entryPtr->nextPtr;
170 break;
171 }
172 }
173 }
174 entryPtr->tablePtr->numEntries--;
175 ckfree((char *) entryPtr);
176}
177\f
178/*
179 *----------------------------------------------------------------------
180 *
181 * Tcl_DeleteHashTable --
182 *
183 * Free up everything associated with a hash table except for
184 * the record for the table itself.
185 *
186 * Results:
187 * None.
188 *
189 * Side effects:
190 * The hash table is no longer useable.
191 *
192 *----------------------------------------------------------------------
193 */
194
195void
196Tcl_DeleteHashTable(register Tcl_HashTable *tablePtr)
197{
198 register Tcl_HashEntry *hPtr, *nextPtr;
199 int i;
200
201 /*
202 * Free up all the entries in the table.
203 */
204
205 for (i = 0; i < tablePtr->numBuckets; i++) {
206 hPtr = tablePtr->buckets[i];
207 while (hPtr != NULL) {
208 nextPtr = hPtr->nextPtr;
209 ckfree((char *) hPtr);
210 hPtr = nextPtr;
211 }
212 }
213
214 /*
215 * Free up the bucket array, if it was dynamically allocated.
216 */
217
218 if (tablePtr->buckets != tablePtr->staticBuckets) {
219 ckfree((char *) tablePtr->buckets);
220 }
221
222 /*
223 * Arrange for panics if the table is used again without
224 * re-initialization.
225 */
226
227 tablePtr->findProc = BogusFind;
228 tablePtr->createProc = BogusCreate;
229}
230\f
231/*
232 *----------------------------------------------------------------------
233 *
234 * Tcl_FirstHashEntry --
235 *
236 * Locate the first entry in a hash table and set up a record
237 * that can be used to step through all the remaining entries
238 * of the table.
239 *
240 * Results:
241 * The return value is a pointer to the first entry in tablePtr,
242 * or NULL if tablePtr has no entries in it. The memory at
243 * *searchPtr is initialized so that subsequent calls to
244 * Tcl_NextHashEntry will return all of the entries in the table,
245 * one at a time.
246 *
247 * Side effects:
248 * None.
249 *
250 *----------------------------------------------------------------------
251 */
252
253Tcl_HashEntry *
254Tcl_FirstHashEntry(Tcl_HashTable *tablePtr, Tcl_HashSearch *searchPtr)
255{
256 searchPtr->tablePtr = tablePtr;
257 searchPtr->nextIndex = 0;
258 searchPtr->nextEntryPtr = NULL;
259 return Tcl_NextHashEntry(searchPtr);
260}
261\f
262/*
263 *----------------------------------------------------------------------
264 *
265 * Tcl_NextHashEntry --
266 *
267 * Once a hash table enumeration has been initiated by calling
268 * Tcl_FirstHashEntry, this procedure may be called to return
269 * successive elements of the table.
270 *
271 * Results:
272 * The return value is the next entry in the hash table being
273 * enumerated, or NULL if the end of the table is reached.
274 *
275 * Side effects:
276 * None.
277 *
278 *----------------------------------------------------------------------
279 */
280
281Tcl_HashEntry *
282Tcl_NextHashEntry(register Tcl_HashSearch *searchPtr)
283{
284 Tcl_HashEntry *hPtr;
285
286 while (searchPtr->nextEntryPtr == NULL) {
287 if (searchPtr->nextIndex >= searchPtr->tablePtr->numBuckets) {
288 return NULL;
289 }
290 searchPtr->nextEntryPtr =
291 searchPtr->tablePtr->buckets[searchPtr->nextIndex];
292 searchPtr->nextIndex++;
293 }
294 hPtr = searchPtr->nextEntryPtr;
295 searchPtr->nextEntryPtr = hPtr->nextPtr;
296 return hPtr;
297}
298\f
299/*
300 *----------------------------------------------------------------------
301 *
302 * Tcl_HashStats --
303 *
304 * Return statistics describing the layout of the hash table
305 * in its hash buckets.
306 *
307 * Results:
308 * The return value is a malloc-ed string containing information
309 * about tablePtr. It is the caller's responsibility to free
310 * this string.
311 *
312 * Side effects:
313 * None.
314 *
315 *----------------------------------------------------------------------
316 */
317char *
318Tcl_HashStats(Tcl_HashTable *tablePtr)
319{
320#define NUM_COUNTERS 10
321 int count[NUM_COUNTERS], overflow, i, j;
322 double average, tmp;
323 register Tcl_HashEntry *hPtr;
324 char *result, *p;
325
326 /*
327 * Compute a histogram of bucket usage.
328 */
329
330 for (i = 0; i < NUM_COUNTERS; i++) {
331 count[i] = 0;
332 }
333 overflow = 0;
334 average = 0.0;
335 for (i = 0; i < tablePtr->numBuckets; i++) {
336 j = 0;
337 for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
338 j++;
339 }
340 if (j < NUM_COUNTERS) {
341 count[j]++;
342 } else {
343 overflow++;
344 }
345 tmp = j;
346 average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
347 }
348
349 /*
350 * Print out the histogram and a few other pieces of information.
351 */
352
353 result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
354 sprintf(result, "%d entries in table, %d buckets\n",
355 tablePtr->numEntries, tablePtr->numBuckets);
356 p = result + strlen(result);
357 for (i = 0; i < NUM_COUNTERS; i++) {
358 sprintf(p, "number of buckets with %d entries: %d\n",
359 i, count[i]);
360 p += strlen(p);
361 }
362 sprintf(p, "number of buckets with %d or more entries: %d\n",
363 NUM_COUNTERS, overflow);
364 p += strlen(p);
365 sprintf(p, "average search distance for entry: %.1f", average);
366 return result;
367}
368\f
369/*
370 *----------------------------------------------------------------------
371 *
372 * HashString --
373 *
374 * Compute a one-word summary of a text string, which can be
375 * used to generate a hash index.
376 *
377 * Results:
378 * The return value is a one-word summary of the information in
379 * string.
380 *
381 * Side effects:
382 * None.
383 *
384 *----------------------------------------------------------------------
385 */
386
387static unsigned int
388HashString(register char *string)
389{
390 register unsigned int result;
391 register int c;
392
393 /*
394 * I tried a zillion different hash functions and asked many other
395 * people for advice. Many people had their own favorite functions,
396 * all different, but no-one had much idea why they were good ones.
397 * I chose the one below (multiply by 9 and add new character)
398 * because of the following reasons:
399 *
400 * 1. Multiplying by 10 is perfect for keys that are decimal strings,
401 * and multiplying by 9 is just about as good.
402 * 2. Times-9 is (shift-left-3) plus (old). This means that each
403 * character's bits hang around in the low-order bits of the
404 * hash value for ever, plus they spread fairly rapidly up to
405 * the high-order bits to fill out the hash value. This seems
406 * works well both for decimal and non-decimal strings.
407 */
408
409 result = 0;
410 while (1) {
411 c = *string;
412 string++;
413 if (c == 0) {
414 break;
415 }
416 result += (result<<3) + c;
417 }
418 return result;
419}
420\f
421/*
422 *----------------------------------------------------------------------
423 *
424 * StringFind --
425 *
426 * Given a hash table with string keys, and a string key, find
427 * the entry with a matching key.
428 *
429 * Results:
430 * The return value is a token for the matching entry in the
431 * hash table, or NULL if there was no matching entry.
432 *
433 * Side effects:
434 * None.
435 *
436 *----------------------------------------------------------------------
437 */
438
439static Tcl_HashEntry *
440StringFind(Tcl_HashTable *tablePtr, char *key)
441{
442 register Tcl_HashEntry *hPtr;
443 register char *p1, *p2;
444 int index;
445
446 index = HashString(key) & tablePtr->mask;
447
448 /*
449 * Search all of the entries in the appropriate bucket.
450 */
451
452 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
453 hPtr = hPtr->nextPtr) {
454 for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
455 if (*p1 != *p2) {
456 break;
457 }
458 if (*p1 == '\0') {
459 return hPtr;
460 }
461 }
462 }
463 return NULL;
464}
465\f
466/*
467 *----------------------------------------------------------------------
468 *
469 * StringCreate --
470 *
471 * Given a hash table with string keys, and a string key, find
472 * the entry with a matching key. If there is no matching entry,
473 * then create a new entry that does match.
474 *
475 * Results:
476 * The return value is a pointer to the matching entry. If this
477 * is a newly-created entry, then *newPtr will be set to a non-zero
478 * value; otherwise *newPtr will be set to 0. If this is a new
479 * entry the value stored in the entry will initially be 0.
480 *
481 * Side effects:
482 * A new entry may be added to the hash table.
483 *
484 *----------------------------------------------------------------------
485 */
486
487static Tcl_HashEntry *
488StringCreate(Tcl_HashTable *tablePtr, char *key, int *newPtr)
489{
490 register Tcl_HashEntry *hPtr;
491 register char *p1, *p2;
492 int index;
493
494 index = HashString(key) & tablePtr->mask;
495
496 /*
497 * Search all of the entries in this bucket.
498 */
499
500 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
501 hPtr = hPtr->nextPtr) {
502 for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
503 if (*p1 != *p2) {
504 break;
505 }
506 if (*p1 == '\0') {
507 *newPtr = 0;
508 return hPtr;
509 }
510 }
511 }
512
513 /*
514 * Entry not found. Add a new one to the bucket.
515 */
516
517 *newPtr = 1;
518 hPtr = (Tcl_HashEntry *) ckalloc((unsigned)
519 (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1)));
520 hPtr->tablePtr = tablePtr;
521 hPtr->bucketPtr = &(tablePtr->buckets[index]);
522 hPtr->nextPtr = *hPtr->bucketPtr;
523 hPtr->clientData = 0;
524 strcpy(hPtr->key.string, key);
525 *hPtr->bucketPtr = hPtr;
526 tablePtr->numEntries++;
527
528 /*
529 * If the table has exceeded a decent size, rebuild it with many
530 * more buckets.
531 */
532
533 if (tablePtr->numEntries >= tablePtr->rebuildSize) {
534 RebuildTable(tablePtr);
535 }
536 return hPtr;
537}
538\f
539/*
540 *----------------------------------------------------------------------
541 *
542 * OneWordFind --
543 *
544 * Given a hash table with one-word keys, and a one-word key, find
545 * the entry with a matching key.
546 *
547 * Results:
548 * The return value is a token for the matching entry in the
549 * hash table, or NULL if there was no matching entry.
550 *
551 * Side effects:
552 * None.
553 *
554 *----------------------------------------------------------------------
555 */
556
557static Tcl_HashEntry *
558OneWordFind(Tcl_HashTable *tablePtr, register char *key)
559{
560 register Tcl_HashEntry *hPtr;
561 int index;
562
563 index = RANDOM_INDEX(tablePtr, key);
564
565 /*
566 * Search all of the entries in the appropriate bucket.
567 */
568
569 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
570 hPtr = hPtr->nextPtr) {
571 if (hPtr->key.oneWordValue == key) {
572 return hPtr;
573 }
574 }
575 return NULL;
576}
577\f
578/*
579 *----------------------------------------------------------------------
580 *
581 * OneWordCreate --
582 *
583 * Given a hash table with one-word keys, and a one-word key, find
584 * the entry with a matching key. If there is no matching entry,
585 * then create a new entry that does match.
586 *
587 * Results:
588 * The return value is a pointer to the matching entry. If this
589 * is a newly-created entry, then *newPtr will be set to a non-zero
590 * value; otherwise *newPtr will be set to 0. If this is a new
591 * entry the value stored in the entry will initially be 0.
592 *
593 * Side effects:
594 * A new entry may be added to the hash table.
595 *
596 *----------------------------------------------------------------------
597 */
598
599static Tcl_HashEntry *
600OneWordCreate(Tcl_HashTable *tablePtr, register char *key, int *newPtr)
601{
602 register Tcl_HashEntry *hPtr;
603 int index;
604
605 index = RANDOM_INDEX(tablePtr, key);
606
607 /*
608 * Search all of the entries in this bucket.
609 */
610
611 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
612 hPtr = hPtr->nextPtr) {
613 if (hPtr->key.oneWordValue == key) {
614 *newPtr = 0;
615 return hPtr;
616 }
617 }
618
619 /*
620 * Entry not found. Add a new one to the bucket.
621 */
622
623 *newPtr = 1;
624 hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry));
625 hPtr->tablePtr = tablePtr;
626 hPtr->bucketPtr = &(tablePtr->buckets[index]);
627 hPtr->nextPtr = *hPtr->bucketPtr;
628 hPtr->clientData = 0;
629 hPtr->key.oneWordValue = key;
630 *hPtr->bucketPtr = hPtr;
631 tablePtr->numEntries++;
632
633 /*
634 * If the table has exceeded a decent size, rebuild it with many
635 * more buckets.
636 */
637
638 if (tablePtr->numEntries >= tablePtr->rebuildSize) {
639 RebuildTable(tablePtr);
640 }
641 return hPtr;
642}
643\f
644/*
645 *----------------------------------------------------------------------
646 *
647 * ArrayFind --
648 *
649 * Given a hash table with array-of-int keys, and a key, find
650 * the entry with a matching key.
651 *
652 * Results:
653 * The return value is a token for the matching entry in the
654 * hash table, or NULL if there was no matching entry.
655 *
656 * Side effects:
657 * None.
658 *
659 *----------------------------------------------------------------------
660 */
661
662static Tcl_HashEntry *
663ArrayFind(Tcl_HashTable *tablePtr, char *key)
664{
665 register Tcl_HashEntry *hPtr;
666 int *arrayPtr = (int *) key;
667 register int *iPtr1, *iPtr2;
668 int index, count;
669
670 for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
671 count > 0; count--, iPtr1++) {
672 index += *iPtr1;
673 }
674 index = RANDOM_INDEX(tablePtr, index);
675
676 /*
677 * Search all of the entries in the appropriate bucket.
678 */
679
680 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
681 hPtr = hPtr->nextPtr) {
682 for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
683 count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
684 if (count == 0) {
685 return hPtr;
686 }
687 if (*iPtr1 != *iPtr2) {
688 break;
689 }
690 }
691 }
692 return NULL;
693}
694\f
695/*
696 *----------------------------------------------------------------------
697 *
698 * ArrayCreate --
699 *
700 * Given a hash table with one-word keys, and a one-word key, find
701 * the entry with a matching key. If there is no matching entry,
702 * then create a new entry that does match.
703 *
704 * Results:
705 * The return value is a pointer to the matching entry. If this
706 * is a newly-created entry, then *newPtr will be set to a non-zero
707 * value; otherwise *newPtr will be set to 0. If this is a new
708 * entry the value stored in the entry will initially be 0.
709 *
710 * Side effects:
711 * A new entry may be added to the hash table.
712 *
713 *----------------------------------------------------------------------
714 */
715
716static Tcl_HashEntry *
717ArrayCreate(Tcl_HashTable *tablePtr, register char *key, int *newPtr)
718{
719 register Tcl_HashEntry *hPtr;
720 int *arrayPtr = (int *) key;
721 register int *iPtr1, *iPtr2;
722 int index, count;
723
724 for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
725 count > 0; count--, iPtr1++) {
726 index += *iPtr1;
727 }
728 index = RANDOM_INDEX(tablePtr, index);
729
730 /*
731 * Search all of the entries in the appropriate bucket.
732 */
733
734 for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
735 hPtr = hPtr->nextPtr) {
736 for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
737 count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
738 if (count == 0) {
739 *newPtr = 0;
740 return hPtr;
741 }
742 if (*iPtr1 != *iPtr2) {
743 break;
744 }
745 }
746 }
747
748 /*
749 * Entry not found. Add a new one to the bucket.
750 */
751
752 *newPtr = 1;
753 hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)
754 + (tablePtr->keyType*sizeof(int)) - 4));
755 hPtr->tablePtr = tablePtr;
756 hPtr->bucketPtr = &(tablePtr->buckets[index]);
757 hPtr->nextPtr = *hPtr->bucketPtr;
758 hPtr->clientData = 0;
759 for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType;
760 count > 0; count--, iPtr1++, iPtr2++) {
761 *iPtr2 = *iPtr1;
762 }
763 *hPtr->bucketPtr = hPtr;
764 tablePtr->numEntries++;
765
766 /*
767 * If the table has exceeded a decent size, rebuild it with many
768 * more buckets.
769 */
770
771 if (tablePtr->numEntries >= tablePtr->rebuildSize) {
772 RebuildTable(tablePtr);
773 }
774 return hPtr;
775}
776\f
777/*
778 *----------------------------------------------------------------------
779 *
780 * BogusFind --
781 *
782 * This procedure is invoked when an Tcl_FindHashEntry is called
783 * on a table that has been deleted.
784 *
785 * Results:
786 * If panic returns (which it shouldn't) this procedure returns
787 * NULL.
788 *
789 * Side effects:
790 * Generates a panic.
791 *
792 *----------------------------------------------------------------------
793 */
794
795 /* ARGSUSED */
796static Tcl_HashEntry *
797BogusFind(Tcl_HashTable *tablePtr, char *key)
798{
799 panic("called Tcl_FindHashEntry on deleted table");
800 return NULL;
801}
802\f
803/*
804 *----------------------------------------------------------------------
805 *
806 * BogusCreate --
807 *
808 * This procedure is invoked when an Tcl_CreateHashEntry is called
809 * on a table that has been deleted.
810 *
811 * Results:
812 * If panic returns (which it shouldn't) this procedure returns
813 * NULL.
814 *
815 * Side effects:
816 * Generates a panic.
817 *
818 *----------------------------------------------------------------------
819 */
820
821 /* ARGSUSED */
822static Tcl_HashEntry *
823BogusCreate(Tcl_HashTable *tablePtr, char *key, int *newPtr)
824{
825 panic("called Tcl_CreateHashEntry on deleted table");
826 return NULL;
827}
828\f
829/*
830 *----------------------------------------------------------------------
831 *
832 * RebuildTable --
833 *
834 * This procedure is invoked when the ratio of entries to hash
835 * buckets becomes too large. It creates a new table with a
836 * larger bucket array and moves all of the entries into the
837 * new table.
838 *
839 * Results:
840 * None.
841 *
842 * Side effects:
843 * Memory gets reallocated and entries get re-hashed to new
844 * buckets.
845 *
846 *----------------------------------------------------------------------
847 */
848
849static void
850RebuildTable(register Tcl_HashTable *tablePtr)
851{
852 int oldSize, count, index;
853 Tcl_HashEntry **oldBuckets;
854 register Tcl_HashEntry **oldChainPtr, **newChainPtr;
855 register Tcl_HashEntry *hPtr;
856
857 oldSize = tablePtr->numBuckets;
858 oldBuckets = tablePtr->buckets;
859
860 /*
861 * Allocate and initialize the new bucket array, and set up
862 * hashing constants for new array size.
863 */
864
865 tablePtr->numBuckets *= 4;
866 tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
867 (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
868 for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
869 count > 0; count--, newChainPtr++) {
870 *newChainPtr = NULL;
871 }
872 tablePtr->rebuildSize *= 4;
873 tablePtr->downShift -= 2;
874 tablePtr->mask = (tablePtr->mask << 2) + 3;
875
876 /*
877 * Rehash all of the existing entries into the new bucket array.
878 */
879
880 for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
881 for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
882 *oldChainPtr = hPtr->nextPtr;
883 if (tablePtr->keyType == TCL_STRING_KEYS) {
884 index = HashString(hPtr->key.string) & tablePtr->mask;
885 } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
886 index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
887 } else {
888 register int *iPtr;
889 int count;
890
891 for (index = 0, count = tablePtr->keyType,
892 iPtr = hPtr->key.words; count > 0; count--, iPtr++) {
893 index += *iPtr;
894 }
895 index = RANDOM_INDEX(tablePtr, index);
896 }
897 hPtr->bucketPtr = &(tablePtr->buckets[index]);
898 hPtr->nextPtr = *hPtr->bucketPtr;
899 *hPtr->bucketPtr = hPtr;
900 }
901 }
902
903 /*
904 * Free up the old bucket array, if it was dynamically allocated.
905 */
906
907 if (oldBuckets != tablePtr->staticBuckets) {
908 ckfree((char *) oldBuckets);
909 }
910}