cde/programs/dtdocbook/tcl/tclHash.c

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