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