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