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