1 #include "ficl.h" 2 3 #define FICL_ASSERT_PHASH(hash, expression) FICL_ASSERT(NULL, expression) 4 5 /* 6 * h a s h F o r g e t 7 * Unlink all words in the hash that have addresses greater than or 8 * equal to the address supplied. Implementation factor for FORGET 9 * and MARKER. 10 */ 11 void 12 ficlHashForget(ficlHash *hash, void *where) 13 { 14 ficlWord *pWord; 15 unsigned i; 16 17 FICL_ASSERT_PHASH(hash, hash); 18 FICL_ASSERT_PHASH(hash, where); 19 20 for (i = 0; i < hash->size; i++) { 21 pWord = hash->table[i]; 22 23 while ((void *)pWord >= where) { 24 pWord = pWord->link; 25 } 26 27 hash->table[i] = pWord; 28 } 29 } 30 31 /* 32 * h a s h H a s h C o d e 33 * 34 * Generate a 16 bit hashcode from a character string using a rolling 35 * shift and add stolen from PJ Weinberger of Bell Labs fame. Case folds 36 * the name before hashing it... 37 * N O T E : If string has zero length, returns zero. 38 */ 39 ficlUnsigned16 40 ficlHashCode(ficlString s) 41 { 42 /* hashPJW */ 43 ficlUnsigned8 *trace; 44 ficlUnsigned16 code = (ficlUnsigned16)s.length; 45 ficlUnsigned16 shift = 0; 46 47 if (s.length == 0) 48 return (0); 49 50 /* changed to run without errors under Purify -- lch */ 51 for (trace = (ficlUnsigned8 *)s.text; 52 s.length && *trace; trace++, s.length--) { 53 code = (ficlUnsigned16)((code << 4) + tolower(*trace)); 54 shift = (ficlUnsigned16)(code & 0xf000); 55 if (shift) { 56 code ^= (ficlUnsigned16)(shift >> 8); 57 code ^= (ficlUnsigned16)shift; 58 } 59 } 60 61 return ((ficlUnsigned16)code); 62 } 63 64 /* 65 * h a s h I n s e r t W o r d 66 * Put a word into the hash table using the word's hashcode as 67 * an index (modulo the table size). 68 */ 69 void 70 ficlHashInsertWord(ficlHash *hash, ficlWord *word) 71 { 72 ficlWord **pList; 73 74 FICL_ASSERT_PHASH(hash, hash); 75 FICL_ASSERT_PHASH(hash, word); 76 77 if (hash->size == 1) { 78 pList = hash->table; 79 } else { 80 pList = hash->table + (word->hash % hash->size); 81 } 82 83 word->link = *pList; 84 *pList = word; 85 } 86 87 /* 88 * h a s h L o o k u p 89 * Find a name in the hash table given the hashcode and text of the name. 90 * Returns the address of the corresponding ficlWord if found, 91 * otherwise NULL. 92 * Note: outer loop on link field supports inheritance in wordlists. 93 * It's not part of ANS Forth - Ficl only. hashReset creates wordlists 94 * with NULL link fields. 95 */ 96 ficlWord * 97 ficlHashLookup(ficlHash *hash, ficlString name, ficlUnsigned16 hashCode) 98 { 99 ficlUnsigned nCmp = name.length; 100 ficlWord *word; 101 ficlUnsigned16 hashIdx; 102 103 if (nCmp > FICL_NAME_LENGTH) 104 nCmp = FICL_NAME_LENGTH; 105 106 for (; hash != NULL; hash = hash->link) { 107 if (hash->size > 1) 108 hashIdx = (ficlUnsigned16)(hashCode % hash->size); 109 else /* avoid the modulo op for single threaded lists */ 110 hashIdx = 0; 111 112 for (word = hash->table[hashIdx]; word; word = word->link) { 113 if ((word->length == name.length) && 114 (!ficlStrincmp(name.text, word->name, nCmp))) 115 return (word); 116 #if FICL_ROBUST 117 FICL_ASSERT_PHASH(hash, word != word->link); 118 #endif 119 } 120 } 121 122 return (NULL); 123 } 124 125 /* 126 * h a s h R e s e t 127 * Initialize a ficlHash to empty state. 128 */ 129 void 130 ficlHashReset(ficlHash *hash) 131 { 132 unsigned i; 133 134 FICL_ASSERT_PHASH(hash, hash); 135 136 for (i = 0; i < hash->size; i++) { 137 hash->table[i] = NULL; 138 } 139 140 hash->link = NULL; 141 hash->name = NULL; 142 } 143