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