user/tinytcl/tclHash.c

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