examples/tclHash.c

   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.2 1999/01/30 22:27:35 roberts Exp $
  44  *
  45  */
  46
  47 #ifndef lint
  48 static const char rcsid[] = "$Id: tclHash.c,v 1.2 1999/01/30 22:27:35 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
  76 static Tcl_HashEntry *  ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  77                             char *key));
  78 static Tcl_HashEntry *  ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  79                             char *key, int *newPtr));
  80 static Tcl_HashEntry *  BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  81                             char *key));
  82 static Tcl_HashEntry *  BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  83                             char *key, int *newPtr));
  84 static unsigned int     HashString _ANSI_ARGS_((char *string));
  85 static void             RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
  86 static Tcl_HashEntry *  StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  87                             char *key));
  88 static Tcl_HashEntry *  StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  89                             char *key, int *newPtr));
  90 static Tcl_HashEntry *  OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  91                             char *key));
  92 static 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
 113 void
 114 Tcl_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
 161 void
 162 Tcl_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
 201 void
 202 Tcl_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
 260 Tcl_HashEntry *
 261 Tcl_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
 291 Tcl_HashEntry *
 292 Tcl_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
 332 char *
 333 Tcl_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
 403 static unsigned int
 404 HashString(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
 456 static Tcl_HashEntry *
 457 StringFind(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
 506 static Tcl_HashEntry *
 507 StringCreate(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
 581 static Tcl_HashEntry *
 582 OneWordFind(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
 625 static Tcl_HashEntry *
 626 OneWordCreate(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
 693 static Tcl_HashEntry *
 694 ArrayFind(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
 749 static Tcl_HashEntry *
 750 ArrayCreate(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 */
 834 static Tcl_HashEntry *
 835 BogusFind(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 */
 862 static Tcl_HashEntry *
 863 BogusCreate(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
 894 static void
 895 RebuildTable(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 }