cde/programs/dtdocbook/tcl/tclHash.c

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