/[dtapublic]/projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclhash.c
ViewVC logotype

Diff of /projs/ets/trunk/src/c_tcl_base_7_5_w_mods/tclhash.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

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