util/src/TclTk/tcl8.6.12/generic/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  * See the file "license.terms" for information on usage and redistribution of
  11  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  12  */
  13
  14 #include "tclInt.h"
  15
  16 /*
  17  * Prevent macros from clashing with function definitions.
  18  */
  19
  20 #undef Tcl_FindHashEntry
  21 #undef Tcl_CreateHashEntry
  22
  23 /*
  24  * When there are this many entries per bucket, on average, rebuild the hash
  25  * table to make it larger.
  26  */
  27
  28 #define REBUILD_MULTIPLIER      3
  29
  30 /*
  31  * The following macro takes a preliminary integer hash value and produces an
  32  * index into a hash tables bucket list. The idea is to make it so that
  33  * preliminary values that are arbitrarily similar will end up in different
  34  * buckets. The hash function was taken from a random-number generator.
  35  */
  36
  37 #define RANDOM_INDEX(tablePtr, i) \
  38     ((((i)*1103515245L) >> (tablePtr)->downShift) & (tablePtr)->mask)
  39
  40 /*
  41  * Prototypes for the array hash key methods.
  42  */
  43
  44 static Tcl_HashEntry *  AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
  45 static int              CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
  46 static unsigned int     HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);
  47
  48 /*
  49  * Prototypes for the one word hash key methods. Not actually declared because
  50  * this is a critical path that is implemented in the core hash table access
  51  * function.
  52  */
  53
  54 #if 0
  55 static Tcl_HashEntry *  AllocOneWordEntry(Tcl_HashTable *tablePtr,
  56                             void *keyPtr);
  57 static int              CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr);
  58 static unsigned int     HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr);
  59 #endif
  60
  61 /*
  62  * Prototypes for the string hash key methods.
  63  */
  64
  65 static Tcl_HashEntry *  AllocStringEntry(Tcl_HashTable *tablePtr,
  66                             void *keyPtr);
  67 static int              CompareStringKeys(void *keyPtr, Tcl_HashEntry *hPtr);
  68 static unsigned int     HashStringKey(Tcl_HashTable *tablePtr, void *keyPtr);
  69
  70 /*
  71  * Function prototypes for static functions in this file:
  72  */
  73
  74 static Tcl_HashEntry *  BogusFind(Tcl_HashTable *tablePtr, const char *key);
  75 static Tcl_HashEntry *  BogusCreate(Tcl_HashTable *tablePtr, const char *key,
  76                             int *newPtr);
  77 static Tcl_HashEntry *  CreateHashEntry(Tcl_HashTable *tablePtr, const char *key,
  78                             int *newPtr);
  79 static Tcl_HashEntry *  FindHashEntry(Tcl_HashTable *tablePtr, const char *key);
  80 static void             RebuildTable(Tcl_HashTable *tablePtr);
  81
  82 const Tcl_HashKeyType tclArrayHashKeyType = {
  83     TCL_HASH_KEY_TYPE_VERSION,          /* version */
  84     TCL_HASH_KEY_RANDOMIZE_HASH,        /* flags */
  85     HashArrayKey,                       /* hashKeyProc */
  86     CompareArrayKeys,                   /* compareKeysProc */
  87     AllocArrayEntry,                    /* allocEntryProc */
  88     NULL                                /* freeEntryProc */
  89 };
  90
  91 const Tcl_HashKeyType tclOneWordHashKeyType = {
  92     TCL_HASH_KEY_TYPE_VERSION,          /* version */
  93     0,                                  /* flags */
  94     NULL, /* HashOneWordKey, */         /* hashProc */
  95     NULL, /* CompareOneWordKey, */      /* compareProc */
  96     NULL, /* AllocOneWordKey, */        /* allocEntryProc */
  97     NULL  /* FreeOneWordKey, */         /* freeEntryProc */
  98 };
  99
 100 const Tcl_HashKeyType tclStringHashKeyType = {
 101     TCL_HASH_KEY_TYPE_VERSION,          /* version */
 102     0,                                  /* flags */
 103     HashStringKey,                      /* hashKeyProc */
 104     CompareStringKeys,                  /* compareKeysProc */
 105     AllocStringEntry,                   /* allocEntryProc */
 106     NULL                                /* freeEntryProc */
 107 };
 108 \f
 109 /*
 110  *----------------------------------------------------------------------
 111  *
 112  * Tcl_InitHashTable --
 113  *
 114  *      Given storage for a hash table, set up the fields to prepare the hash
 115  *      table for use.
 116  *
 117  * Results:
 118  *      None.
 119  *
 120  * Side effects:
 121  *      TablePtr is now ready to be passed to Tcl_FindHashEntry and
 122  *      Tcl_CreateHashEntry.
 123  *
 124  *----------------------------------------------------------------------
 125  */
 126
 127 void
 128 Tcl_InitHashTable(
 129     Tcl_HashTable *tablePtr,
 130                                 /* Pointer to table record, which is supplied
 131                                  * by the caller. */
 132     int keyType)                /* Type of keys to use in table:
 133                                  * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS, or an
 134                                  * integer >= 2. */
 135 {
 136     /*
 137      * Use a special value to inform the extended version that it must not
 138      * access any of the new fields in the Tcl_HashTable. If an extension is
 139      * rebuilt then any calls to this function will be redirected to the
 140      * extended version by a macro.
 141      */
 142
 143     Tcl_InitCustomHashTable(tablePtr, keyType, (const Tcl_HashKeyType *) -1);
 144 }
 145 \f
 146 /*
 147  *----------------------------------------------------------------------
 148  *
 149  * Tcl_InitCustomHashTable --
 150  *
 151  *      Given storage for a hash table, set up the fields to prepare the hash
 152  *      table for use. This is an extended version of Tcl_InitHashTable which
 153  *      supports user defined keys.
 154  *
 155  * Results:
 156  *      None.
 157  *
 158  * Side effects:
 159  *      TablePtr is now ready to be passed to Tcl_FindHashEntry and
 160  *      Tcl_CreateHashEntry.
 161  *
 162  *----------------------------------------------------------------------
 163  */
 164
 165 void
 166 Tcl_InitCustomHashTable(
 167     Tcl_HashTable *tablePtr,
 168                                 /* Pointer to table record, which is supplied
 169                                  * by the caller. */
 170     int keyType,                /* Type of keys to use in table:
 171                                  * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
 172                                  * TCL_CUSTOM_TYPE_KEYS, TCL_CUSTOM_PTR_KEYS,
 173                                  * or an integer >= 2. */
 174     const Tcl_HashKeyType *typePtr) /* Pointer to structure which defines the
 175                                  * behaviour of this table. */
 176 {
 177 #if (TCL_SMALL_HASH_TABLE != 4)
 178     Tcl_Panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4",
 179             TCL_SMALL_HASH_TABLE);
 180 #endif
 181
 182     tablePtr->buckets = tablePtr->staticBuckets;
 183     tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
 184     tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
 185     tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
 186     tablePtr->numEntries = 0;
 187     tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
 188     tablePtr->downShift = 28;
 189     tablePtr->mask = 3;
 190     tablePtr->keyType = keyType;
 191     tablePtr->findProc = FindHashEntry;
 192     tablePtr->createProc = CreateHashEntry;
 193
 194     if (typePtr == NULL) {
 195         /*
 196          * The caller has been rebuilt so the hash table is an extended
 197          * version.
 198          */
 199     } else if (typePtr != (Tcl_HashKeyType *) -1) {
 200         /*
 201          * The caller is requesting a customized hash table so it must be an
 202          * extended version.
 203          */
 204
 205         tablePtr->typePtr = typePtr;
 206     } else {
 207         /*
 208          * The caller has not been rebuilt so the hash table is not extended.
 209          */
 210     }
 211 }
 212 \f
 213 /*
 214  *----------------------------------------------------------------------
 215  *
 216  * Tcl_FindHashEntry --
 217  *
 218  *      Given a hash table find the entry with a matching key.
 219  *
 220  * Results:
 221  *      The return value is a token for the matching entry in the hash table,
 222  *      or NULL if there was no matching entry.
 223  *
 224  * Side effects:
 225  *      None.
 226  *
 227  *----------------------------------------------------------------------
 228  */
 229
 230 Tcl_HashEntry *
 231 Tcl_FindHashEntry(
 232     Tcl_HashTable *tablePtr,    /* Table in which to lookup entry. */
 233     const void *key)            /* Key to use to find matching entry. */
 234 {
 235     return (*((tablePtr)->findProc))(tablePtr, key);
 236 }
 237
 238 static Tcl_HashEntry *
 239 FindHashEntry(
 240     Tcl_HashTable *tablePtr,    /* Table in which to lookup entry. */
 241     const char *key)            /* Key to use to find matching entry. */
 242 {
 243     return CreateHashEntry(tablePtr, key, NULL);
 244 }
 245
 246 \f
 247 /*
 248  *----------------------------------------------------------------------
 249  *
 250  * Tcl_CreateHashEntry --
 251  *
 252  *      Given a hash table with string keys, and a string key, find the entry
 253  *      with a matching key. If there is no matching entry, then create a new
 254  *      entry that does match.
 255  *
 256  * Results:
 257  *      The return value is a pointer to the matching entry. If this is a
 258  *      newly-created entry, then *newPtr will be set to a non-zero value;
 259  *      otherwise *newPtr will be set to 0. If this is a new entry the value
 260  *      stored in the entry will initially be 0.
 261  *
 262  * Side effects:
 263  *      A new entry may be added to the hash table.
 264  *
 265  *----------------------------------------------------------------------
 266  */
 267
 268 Tcl_HashEntry *
 269 Tcl_CreateHashEntry(
 270     Tcl_HashTable *tablePtr,    /* Table in which to lookup entry. */
 271     const void *key,            /* Key to use to find or create matching
 272                                  * entry. */
 273     int *newPtr)                /* Store info here telling whether a new entry
 274                                  * was created. */
 275 {
 276     return (*((tablePtr)->createProc))(tablePtr, key, newPtr);
 277 }
 278
 279 static Tcl_HashEntry *
 280 CreateHashEntry(
 281     Tcl_HashTable *tablePtr,    /* Table in which to lookup entry. */
 282     const char *key,            /* Key to use to find or create matching
 283                                  * entry. */
 284     int *newPtr)                /* Store info here telling whether a new entry
 285                                  * was created. */
 286 {
 287     Tcl_HashEntry *hPtr;
 288     const Tcl_HashKeyType *typePtr;
 289     unsigned int hash;
 290     int index;
 291
 292     if (tablePtr->keyType == TCL_STRING_KEYS) {
 293         typePtr = &tclStringHashKeyType;
 294     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
 295         typePtr = &tclOneWordHashKeyType;
 296     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
 297             || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
 298         typePtr = tablePtr->typePtr;
 299     } else {
 300         typePtr = &tclArrayHashKeyType;
 301     }
 302
 303     if (typePtr->hashKeyProc) {
 304         hash = typePtr->hashKeyProc(tablePtr, (void *) key);
 305         if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
 306             index = RANDOM_INDEX(tablePtr, hash);
 307         } else {
 308             index = hash & tablePtr->mask;
 309         }
 310     } else {
 311         hash = PTR2UINT(key);
 312         index = RANDOM_INDEX(tablePtr, hash);
 313     }
 314
 315     /*
 316      * Search all of the entries in the appropriate bucket.
 317      */
 318
 319     if (typePtr->compareKeysProc) {
 320         Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;
 321
 322         for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
 323                 hPtr = hPtr->nextPtr) {
 324 #if TCL_HASH_KEY_STORE_HASH
 325             if (hash != PTR2UINT(hPtr->hash)) {
 326                 continue;
 327             }
 328 #endif
 329             /* if keys pointers or values are equal */
 330             if ((key == hPtr->key.oneWordValue)
 331                 || compareKeysProc((void *) key, hPtr)
 332             ) {
 333                 if (newPtr) {
 334                     *newPtr = 0;
 335                 }
 336                 return hPtr;
 337             }
 338         }
 339     } else {
 340         for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
 341                 hPtr = hPtr->nextPtr) {
 342 #if TCL_HASH_KEY_STORE_HASH
 343             if (hash != PTR2UINT(hPtr->hash)) {
 344                 continue;
 345             }
 346 #endif
 347             if (key == hPtr->key.oneWordValue) {
 348                 if (newPtr) {
 349                     *newPtr = 0;
 350                 }
 351                 return hPtr;
 352             }
 353         }
 354     }
 355
 356     if (!newPtr) {
 357         return NULL;
 358     }
 359
 360     /*
 361      * Entry not found. Add a new one to the bucket.
 362      */
 363
 364     *newPtr = 1;
 365     if (typePtr->allocEntryProc) {
 366         hPtr = typePtr->allocEntryProc(tablePtr, (void *) key);
 367     } else {
 368         hPtr = ckalloc(sizeof(Tcl_HashEntry));
 369         hPtr->key.oneWordValue = (char *) key;
 370         hPtr->clientData = 0;
 371     }
 372
 373     hPtr->tablePtr = tablePtr;
 374 #if TCL_HASH_KEY_STORE_HASH
 375     hPtr->hash = UINT2PTR(hash);
 376     hPtr->nextPtr = tablePtr->buckets[index];
 377     tablePtr->buckets[index] = hPtr;
 378 #else
 379     hPtr->bucketPtr = &tablePtr->buckets[index];
 380     hPtr->nextPtr = *hPtr->bucketPtr;
 381     *hPtr->bucketPtr = hPtr;
 382 #endif
 383     tablePtr->numEntries++;
 384
 385     /*
 386      * If the table has exceeded a decent size, rebuild it with many more
 387      * buckets.
 388      */
 389
 390     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
 391         RebuildTable(tablePtr);
 392     }
 393     return hPtr;
 394 }
 395 \f
 396 /*
 397  *----------------------------------------------------------------------
 398  *
 399  * Tcl_DeleteHashEntry --
 400  *
 401  *      Remove a single entry from a hash table.
 402  *
 403  * Results:
 404  *      None.
 405  *
 406  * Side effects:
 407  *      The entry given by entryPtr is deleted from its table and should never
 408  *      again be used by the caller. It is up to the caller to free the
 409  *      clientData field of the entry, if that is relevant.
 410  *
 411  *----------------------------------------------------------------------
 412  */
 413
 414 void
 415 Tcl_DeleteHashEntry(
 416     Tcl_HashEntry *entryPtr)
 417 {
 418     Tcl_HashEntry *prevPtr;
 419     const Tcl_HashKeyType *typePtr;
 420     Tcl_HashTable *tablePtr;
 421     Tcl_HashEntry **bucketPtr;
 422 #if TCL_HASH_KEY_STORE_HASH
 423     int index;
 424 #endif
 425
 426     tablePtr = entryPtr->tablePtr;
 427
 428     if (tablePtr->keyType == TCL_STRING_KEYS) {
 429         typePtr = &tclStringHashKeyType;
 430     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
 431         typePtr = &tclOneWordHashKeyType;
 432     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
 433             || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
 434         typePtr = tablePtr->typePtr;
 435     } else {
 436         typePtr = &tclArrayHashKeyType;
 437     }
 438
 439 #if TCL_HASH_KEY_STORE_HASH
 440     if (typePtr->hashKeyProc == NULL
 441             || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
 442         index = RANDOM_INDEX(tablePtr, PTR2INT(entryPtr->hash));
 443     } else {
 444         index = PTR2UINT(entryPtr->hash) & tablePtr->mask;
 445     }
 446
 447     bucketPtr = &tablePtr->buckets[index];
 448 #else
 449     bucketPtr = entryPtr->bucketPtr;
 450 #endif
 451
 452     if (*bucketPtr == entryPtr) {
 453         *bucketPtr = entryPtr->nextPtr;
 454     } else {
 455         for (prevPtr = *bucketPtr; ; prevPtr = prevPtr->nextPtr) {
 456             if (prevPtr == NULL) {
 457                 Tcl_Panic("malformed bucket chain in Tcl_DeleteHashEntry");
 458             }
 459             if (prevPtr->nextPtr == entryPtr) {
 460                 prevPtr->nextPtr = entryPtr->nextPtr;
 461                 break;
 462             }
 463         }
 464     }
 465
 466     tablePtr->numEntries--;
 467     if (typePtr->freeEntryProc) {
 468         typePtr->freeEntryProc(entryPtr);
 469     } else {
 470         ckfree(entryPtr);
 471     }
 472 }
 473 \f
 474 /*
 475  *----------------------------------------------------------------------
 476  *
 477  * Tcl_DeleteHashTable --
 478  *
 479  *      Free up everything associated with a hash table except for the record
 480  *      for the table itself.
 481  *
 482  * Results:
 483  *      None.
 484  *
 485  * Side effects:
 486  *      The hash table is no longer useable.
 487  *
 488  *----------------------------------------------------------------------
 489  */
 490
 491 void
 492 Tcl_DeleteHashTable(
 493     Tcl_HashTable *tablePtr)    /* Table to delete. */
 494 {
 495     Tcl_HashEntry *hPtr, *nextPtr;
 496     const Tcl_HashKeyType *typePtr;
 497     int i;
 498
 499     if (tablePtr->keyType == TCL_STRING_KEYS) {
 500         typePtr = &tclStringHashKeyType;
 501     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
 502         typePtr = &tclOneWordHashKeyType;
 503     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
 504             || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
 505         typePtr = tablePtr->typePtr;
 506     } else {
 507         typePtr = &tclArrayHashKeyType;
 508     }
 509
 510     /*
 511      * Free up all the entries in the table.
 512      */
 513
 514     for (i = 0; i < tablePtr->numBuckets; i++) {
 515         hPtr = tablePtr->buckets[i];
 516         while (hPtr != NULL) {
 517             nextPtr = hPtr->nextPtr;
 518             if (typePtr->freeEntryProc) {
 519                 typePtr->freeEntryProc(hPtr);
 520             } else {
 521                 ckfree(hPtr);
 522             }
 523             hPtr = nextPtr;
 524         }
 525     }
 526
 527     /*
 528      * Free up the bucket array, if it was dynamically allocated.
 529      */
 530
 531     if (tablePtr->buckets != tablePtr->staticBuckets) {
 532         if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
 533             TclpSysFree((char *) tablePtr->buckets);
 534         } else {
 535             ckfree(tablePtr->buckets);
 536         }
 537     }
 538
 539     /*
 540      * Arrange for panics if the table is used again without
 541      * re-initialization.
 542      */
 543
 544     tablePtr->findProc = BogusFind;
 545     tablePtr->createProc = BogusCreate;
 546 }
 547 \f
 548 /*
 549  *----------------------------------------------------------------------
 550  *
 551  * Tcl_FirstHashEntry --
 552  *
 553  *      Locate the first entry in a hash table and set up a record that can be
 554  *      used to step through all the remaining entries of the table.
 555  *
 556  * Results:
 557  *      The return value is a pointer to the first entry in tablePtr, or NULL
 558  *      if tablePtr has no entries in it. The memory at *searchPtr is
 559  *      initialized so that subsequent calls to Tcl_NextHashEntry will return
 560  *      all of the entries in the table, one at a time.
 561  *
 562  * Side effects:
 563  *      None.
 564  *
 565  *----------------------------------------------------------------------
 566  */
 567
 568 Tcl_HashEntry *
 569 Tcl_FirstHashEntry(
 570     Tcl_HashTable *tablePtr,    /* Table to search. */
 571     Tcl_HashSearch *searchPtr)  /* Place to store information about progress
 572                                  * through the table. */
 573 {
 574     searchPtr->tablePtr = tablePtr;
 575     searchPtr->nextIndex = 0;
 576     searchPtr->nextEntryPtr = NULL;
 577     return Tcl_NextHashEntry(searchPtr);
 578 }
 579 \f
 580 /*
 581  *----------------------------------------------------------------------
 582  *
 583  * Tcl_NextHashEntry --
 584  *
 585  *      Once a hash table enumeration has been initiated by calling
 586  *      Tcl_FirstHashEntry, this function may be called to return successive
 587  *      elements of the table.
 588  *
 589  * Results:
 590  *      The return value is the next entry in the hash table being enumerated,
 591  *      or NULL if the end of the table is reached.
 592  *
 593  * Side effects:
 594  *      None.
 595  *
 596  *----------------------------------------------------------------------
 597  */
 598
 599 Tcl_HashEntry *
 600 Tcl_NextHashEntry(
 601     Tcl_HashSearch *searchPtr)
 602                                 /* Place to store information about progress
 603                                  * through the table. Must have been
 604                                  * initialized by calling
 605                                  * Tcl_FirstHashEntry. */
 606 {
 607     Tcl_HashEntry *hPtr;
 608     Tcl_HashTable *tablePtr = searchPtr->tablePtr;
 609
 610     while (searchPtr->nextEntryPtr == NULL) {
 611         if (searchPtr->nextIndex >= tablePtr->numBuckets) {
 612             return NULL;
 613         }
 614         searchPtr->nextEntryPtr =
 615                 tablePtr->buckets[searchPtr->nextIndex];
 616         searchPtr->nextIndex++;
 617     }
 618     hPtr = searchPtr->nextEntryPtr;
 619     searchPtr->nextEntryPtr = hPtr->nextPtr;
 620     return hPtr;
 621 }
 622 \f
 623 /*
 624  *----------------------------------------------------------------------
 625  *
 626  * Tcl_HashStats --
 627  *
 628  *      Return statistics describing the layout of the hash table in its hash
 629  *      buckets.
 630  *
 631  * Results:
 632  *      The return value is a malloc-ed string containing information about
 633  *      tablePtr. It is the caller's responsibility to free this string.
 634  *
 635  * Side effects:
 636  *      None.
 637  *
 638  *----------------------------------------------------------------------
 639  */
 640
 641 char *
 642 Tcl_HashStats(
 643     Tcl_HashTable *tablePtr)    /* Table for which to produce stats. */
 644 {
 645 #define NUM_COUNTERS 10
 646     int count[NUM_COUNTERS], overflow, i, j;
 647     double average, tmp;
 648     Tcl_HashEntry *hPtr;
 649     char *result, *p;
 650
 651     /*
 652      * Compute a histogram of bucket usage.
 653      */
 654
 655     for (i = 0; i < NUM_COUNTERS; i++) {
 656         count[i] = 0;
 657     }
 658     overflow = 0;
 659     average = 0.0;
 660     for (i = 0; i < tablePtr->numBuckets; i++) {
 661         j = 0;
 662         for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
 663             j++;
 664         }
 665         if (j < NUM_COUNTERS) {
 666             count[j]++;
 667         } else {
 668             overflow++;
 669         }
 670         tmp = j;
 671         if (tablePtr->numEntries != 0) {
 672             average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
 673         }
 674     }
 675
 676     /*
 677      * Print out the histogram and a few other pieces of information.
 678      */
 679
 680     result = ckalloc((NUM_COUNTERS * 60) + 300);
 681     sprintf(result, "%d entries in table, %d buckets\n",
 682             tablePtr->numEntries, tablePtr->numBuckets);
 683     p = result + strlen(result);
 684     for (i = 0; i < NUM_COUNTERS; i++) {
 685         sprintf(p, "number of buckets with %d entries: %d\n",
 686                 i, count[i]);
 687         p += strlen(p);
 688     }
 689     sprintf(p, "number of buckets with %d or more entries: %d\n",
 690             NUM_COUNTERS, overflow);
 691     p += strlen(p);
 692     sprintf(p, "average search distance for entry: %.1f", average);
 693     return result;
 694 }
 695 \f
 696 /*
 697  *----------------------------------------------------------------------
 698  *
 699  * AllocArrayEntry --
 700  *
 701  *      Allocate space for a Tcl_HashEntry containing the array key.
 702  *
 703  * Results:
 704  *      The return value is a pointer to the created entry.
 705  *
 706  * Side effects:
 707  *      None.
 708  *
 709  *----------------------------------------------------------------------
 710  */
 711
 712 static Tcl_HashEntry *
 713 AllocArrayEntry(
 714     Tcl_HashTable *tablePtr,    /* Hash table. */
 715     void *keyPtr)               /* Key to store in the hash table entry. */
 716 {
 717     int *array = (int *) keyPtr;
 718     int *iPtr1, *iPtr2;
 719     Tcl_HashEntry *hPtr;
 720     int count;
 721     unsigned int size;
 722
 723     count = tablePtr->keyType;
 724
 725     size = sizeof(Tcl_HashEntry) + (count*sizeof(int)) - sizeof(hPtr->key);
 726     if (size < sizeof(Tcl_HashEntry)) {
 727         size = sizeof(Tcl_HashEntry);
 728     }
 729     hPtr = ckalloc(size);
 730
 731     for (iPtr1 = array, iPtr2 = hPtr->key.words;
 732             count > 0; count--, iPtr1++, iPtr2++) {
 733         *iPtr2 = *iPtr1;
 734     }
 735     hPtr->clientData = 0;
 736
 737     return hPtr;
 738 }
 739 \f
 740 /*
 741  *----------------------------------------------------------------------
 742  *
 743  * CompareArrayKeys --
 744  *
 745  *      Compares two array keys.
 746  *
 747  * Results:
 748  *      The return value is 0 if they are different and 1 if they are the
 749  *      same.
 750  *
 751  * Side effects:
 752  *      None.
 753  *
 754  *----------------------------------------------------------------------
 755  */
 756
 757 static int
 758 CompareArrayKeys(
 759     void *keyPtr,               /* New key to compare. */
 760     Tcl_HashEntry *hPtr)        /* Existing key to compare. */
 761 {
 762     const int *iPtr1 = (const int *) keyPtr;
 763     const int *iPtr2 = (const int *) hPtr->key.words;
 764     Tcl_HashTable *tablePtr = hPtr->tablePtr;
 765     int count;
 766
 767     for (count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
 768         if (count == 0) {
 769             return 1;
 770         }
 771         if (*iPtr1 != *iPtr2) {
 772             break;
 773         }
 774     }
 775     return 0;
 776 }
 777 \f
 778 /*
 779  *----------------------------------------------------------------------
 780  *
 781  * HashArrayKey --
 782  *
 783  *      Compute a one-word summary of an array, which can be used to generate
 784  *      a hash index.
 785  *
 786  * Results:
 787  *      The return value is a one-word summary of the information in
 788  *      string.
 789  *
 790  * Side effects:
 791  *      None.
 792  *
 793  *----------------------------------------------------------------------
 794  */
 795
 796 static unsigned int
 797 HashArrayKey(
 798     Tcl_HashTable *tablePtr,    /* Hash table. */
 799     void *keyPtr)               /* Key from which to compute hash value. */
 800 {
 801     const int *array = (const int *) keyPtr;
 802     unsigned int result;
 803     int count;
 804
 805     for (result = 0, count = tablePtr->keyType; count > 0;
 806             count--, array++) {
 807         result += *array;
 808     }
 809     return result;
 810 }
 811 \f
 812 /*
 813  *----------------------------------------------------------------------
 814  *
 815  * AllocStringEntry --
 816  *
 817  *      Allocate space for a Tcl_HashEntry containing the string key.
 818  *
 819  * Results:
 820  *      The return value is a pointer to the created entry.
 821  *
 822  * Side effects:
 823  *      None.
 824  *
 825  *----------------------------------------------------------------------
 826  */
 827
 828 static Tcl_HashEntry *
 829 AllocStringEntry(
 830     Tcl_HashTable *tablePtr,    /* Hash table. */
 831     void *keyPtr)               /* Key to store in the hash table entry. */
 832 {
 833     const char *string = (const char *) keyPtr;
 834     Tcl_HashEntry *hPtr;
 835     unsigned int size, allocsize;
 836
 837     allocsize = size = strlen(string) + 1;
 838     if (size < sizeof(hPtr->key)) {
 839         allocsize = sizeof(hPtr->key);
 840     }
 841     hPtr = ckalloc(TclOffset(Tcl_HashEntry, key) + allocsize);
 842     memset(hPtr, 0, sizeof(Tcl_HashEntry) + allocsize - sizeof(hPtr->key));
 843     memcpy(hPtr->key.string, string, size);
 844     hPtr->clientData = 0;
 845     return hPtr;
 846 }
 847 \f
 848 /*
 849  *----------------------------------------------------------------------
 850  *
 851  * CompareStringKeys --
 852  *
 853  *      Compares two string keys.
 854  *
 855  * Results:
 856  *      The return value is 0 if they are different and 1 if they are the
 857  *      same.
 858  *
 859  * Side effects:
 860  *      None.
 861  *
 862  *----------------------------------------------------------------------
 863  */
 864
 865 static int
 866 CompareStringKeys(
 867     void *keyPtr,               /* New key to compare. */
 868     Tcl_HashEntry *hPtr)        /* Existing key to compare. */
 869 {
 870     const char *p1 = (const char *) keyPtr;
 871     const char *p2 = (const char *) hPtr->key.string;
 872
 873     return !strcmp(p1, p2);
 874 }
 875 \f
 876 /*
 877  *----------------------------------------------------------------------
 878  *
 879  * HashStringKey --
 880  *
 881  *      Compute a one-word summary of a text string, which can be used to
 882  *      generate a hash index.
 883  *
 884  * Results:
 885  *      The return value is a one-word summary of the information in string.
 886  *
 887  * Side effects:
 888  *      None.
 889  *
 890  *----------------------------------------------------------------------
 891  */
 892
 893 static unsigned
 894 HashStringKey(
 895     Tcl_HashTable *tablePtr,    /* Hash table. */
 896     void *keyPtr)               /* Key from which to compute hash value. */
 897 {
 898     const char *string = keyPtr;
 899     unsigned int result;
 900     char c;
 901
 902     /*
 903      * I tried a zillion different hash functions and asked many other people
 904      * for advice. Many people had their own favorite functions, all
 905      * different, but no-one had much idea why they were good ones. I chose
 906      * the one below (multiply by 9 and add new character) because of the
 907      * following reasons:
 908      *
 909      * 1. Multiplying by 10 is perfect for keys that are decimal strings, and
 910      *    multiplying by 9 is just about as good.
 911      * 2. Times-9 is (shift-left-3) plus (old). This means that each
 912      *    character's bits hang around in the low-order bits of the hash value
 913      *    for ever, plus they spread fairly rapidly up to the high-order bits
 914      *    to fill out the hash value. This seems works well both for decimal
 915      *    and non-decimal strings, but isn't strong against maliciously-chosen
 916      *    keys.
 917      *
 918      * Note that this function is very weak against malicious strings; it's
 919      * very easy to generate multiple keys that have the same hashcode. On the
 920      * other hand, that hardly ever actually occurs and this function *is*
 921      * very cheap, even by comparison with industry-standard hashes like FNV.
 922      * If real strength of hash is required though, use a custom hash based on
 923      * Bob Jenkins's lookup3(), but be aware that it's significantly slower.
 924      * Since Tcl command and namespace names are usually reasonably-named (the
 925      * main use for string hashes in modern Tcl) speed is far more important
 926      * than strength.
 927      *
 928      * See also HashString in tclLiteral.c.
 929      * See also TclObjHashKey in tclObj.c.
 930      *
 931      * See [tcl-Feature Request #2958832]
 932      */
 933
 934     if ((result = UCHAR(*string)) != 0) {
 935         while ((c = *++string) != 0) {
 936             result += (result << 3) + UCHAR(c);
 937         }
 938     }
 939     return result;
 940 }
 941 \f
 942 /*
 943  *----------------------------------------------------------------------
 944  *
 945  * BogusFind --
 946  *
 947  *      This function is invoked when an Tcl_FindHashEntry is called on a
 948  *      table that has been deleted.
 949  *
 950  * Results:
 951  *      If Tcl_Panic returns (which it shouldn't) this function returns NULL.
 952  *
 953  * Side effects:
 954  *      Generates a panic.
 955  *
 956  *----------------------------------------------------------------------
 957  */
 958
 959         /* ARGSUSED */
 960 static Tcl_HashEntry *
 961 BogusFind(
 962     Tcl_HashTable *tablePtr,    /* Table in which to lookup entry. */
 963     const char *key)            /* Key to use to find matching entry. */
 964 {
 965     Tcl_Panic("called %s on deleted table", "Tcl_FindHashEntry");
 966     return NULL;
 967 }
 968 \f
 969 /*
 970  *----------------------------------------------------------------------
 971  *
 972  * BogusCreate --
 973  *
 974  *      This function is invoked when an Tcl_CreateHashEntry is called on a
 975  *      table that has been deleted.
 976  *
 977  * Results:
 978  *      If panic returns (which it shouldn't) this function returns NULL.
 979  *
 980  * Side effects:
 981  *      Generates a panic.
 982  *
 983  *----------------------------------------------------------------------
 984  */
 985
 986         /* ARGSUSED */
 987 static Tcl_HashEntry *
 988 BogusCreate(
 989     Tcl_HashTable *tablePtr,    /* Table in which to lookup entry. */
 990     const char *key,            /* Key to use to find or create matching
 991                                  * entry. */
 992     int *newPtr)                /* Store info here telling whether a new entry
 993                                  * was created. */
 994 {
 995     Tcl_Panic("called %s on deleted table", "Tcl_CreateHashEntry");
 996     return NULL;
 997 }
 998 \f
 999 /*
1000  *----------------------------------------------------------------------
1001  *
1002  * RebuildTable --
1003  *
1004  *      This function is invoked when the ratio of entries to hash buckets
1005  *      becomes too large. It creates a new table with a larger bucket array
1006  *      and moves all of the entries into the new table.
1007  *
1008  * Results:
1009  *      None.
1010  *
1011  * Side effects:
1012  *      Memory gets reallocated and entries get re-hashed to new buckets.
1013  *
1014  *----------------------------------------------------------------------
1015  */
1016
1017 static void
1018 RebuildTable(
1019     Tcl_HashTable *tablePtr)    /* Table to enlarge. */
1020 {
1021     int count, index, oldSize = tablePtr->numBuckets;
1022     Tcl_HashEntry **oldBuckets = tablePtr->buckets;
1023     Tcl_HashEntry **oldChainPtr, **newChainPtr;
1024     Tcl_HashEntry *hPtr;
1025     const Tcl_HashKeyType *typePtr;
1026
1027     /* Avoid outgrowing capability of the memory allocators */
1028     if (oldSize > (int)(UINT_MAX / (4 * sizeof(Tcl_HashEntry *)))) {
1029         tablePtr->rebuildSize = INT_MAX;
1030         return;
1031     }
1032
1033     if (tablePtr->keyType == TCL_STRING_KEYS) {
1034         typePtr = &tclStringHashKeyType;
1035     } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
1036         typePtr = &tclOneWordHashKeyType;
1037     } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS
1038             || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {
1039         typePtr = tablePtr->typePtr;
1040     } else {
1041         typePtr = &tclArrayHashKeyType;
1042     }
1043
1044     /*
1045      * Allocate and initialize the new bucket array, and set up hashing
1046      * constants for new array size.
1047      */
1048
1049     tablePtr->numBuckets *= 4;
1050     if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
1051         tablePtr->buckets = (Tcl_HashEntry **) TclpSysAlloc((unsigned)
1052                 (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)), 0);
1053     } else {
1054         tablePtr->buckets =
1055                 ckalloc(tablePtr->numBuckets * sizeof(Tcl_HashEntry *));
1056     }
1057     for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
1058             count > 0; count--, newChainPtr++) {
1059         *newChainPtr = NULL;
1060     }
1061     tablePtr->rebuildSize *= 4;
1062     tablePtr->downShift -= 2;
1063     tablePtr->mask = (tablePtr->mask << 2) + 3;
1064
1065     /*
1066      * Rehash all of the existing entries into the new bucket array.
1067      */
1068
1069     for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
1070         for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
1071             *oldChainPtr = hPtr->nextPtr;
1072 #if TCL_HASH_KEY_STORE_HASH
1073             if (typePtr->hashKeyProc == NULL
1074                     || typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
1075                 index = RANDOM_INDEX(tablePtr, PTR2INT(hPtr->hash));
1076             } else {
1077                 index = PTR2UINT(hPtr->hash) & tablePtr->mask;
1078             }
1079             hPtr->nextPtr = tablePtr->buckets[index];
1080             tablePtr->buckets[index] = hPtr;
1081 #else
1082             void *key = Tcl_GetHashKey(tablePtr, hPtr);
1083
1084             if (typePtr->hashKeyProc) {
1085                 unsigned int hash;
1086
1087                 hash = typePtr->hashKeyProc(tablePtr, key);
1088                 if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {
1089                     index = RANDOM_INDEX(tablePtr, hash);
1090                 } else {
1091                     index = hash & tablePtr->mask;
1092                 }
1093             } else {
1094                 index = RANDOM_INDEX(tablePtr, key);
1095             }
1096
1097             hPtr->bucketPtr = &tablePtr->buckets[index];
1098             hPtr->nextPtr = *hPtr->bucketPtr;
1099             *hPtr->bucketPtr = hPtr;
1100 #endif
1101         }
1102     }
1103
1104     /*
1105      * Free up the old bucket array, if it was dynamically allocated.
1106      */
1107
1108     if (oldBuckets != tablePtr->staticBuckets) {
1109         if (typePtr->flags & TCL_HASH_KEY_SYSTEM_HASH) {
1110             TclpSysFree((char *) oldBuckets);
1111         } else {
1112             ckfree(oldBuckets);
1113         }
1114     }
1115 }
1116 \f
1117 /*
1118  * Local Variables:
1119  * mode: c
1120  * c-basic-offset: 4
1121  * fill-column: 78
1122  * End:
1123  */