common/ficl/hash.c

#include "ficl.h"

#define FICL_ASSERT_PHASH(hash, expression) FICL_ASSERT(NULL, expression)

/*
 * h a s h F o r g e t
 * Unlink all words in the hash that have addresses greater than or
 * equal to the address supplied. Implementation factor for FORGET
 * and MARKER.
 */
void
ficlHashForget(ficlHash *hash, void *where)
{
    ficlWord *pWord;
    unsigned i;

    FICL_ASSERT_PHASH(hash, hash);
    FICL_ASSERT_PHASH(hash, where);

    for (i = 0; i < hash->size; i++) {
        pWord = hash->table[i];

        while ((void *)pWord >= where) {
            pWord = pWord->link;
        }

        hash->table[i] = pWord;
    }
}

/*
 * h a s h H a s h C o d e
 *
 * Generate a 16 bit hashcode from a character string using a rolling
 * shift and add stolen from PJ Weinberger of Bell Labs fame. Case folds
 * the name before hashing it...
 * N O T E : If string has zero length, returns zero.
 */
ficlUnsigned16
ficlHashCode(ficlString s)
{
    /* hashPJW */
    ficlUnsigned8 *trace;
    ficlUnsigned16 code = (ficlUnsigned16)s.length;
    ficlUnsigned16 shift = 0;

    if (s.length == 0)
        return (0);

    /* changed to run without errors under Purify -- lch */
    for (trace = (ficlUnsigned8 *)s.text;
        s.length && *trace; trace++, s.length--) {
        code = (ficlUnsigned16)((code << 4) + tolower(*trace));
        shift = (ficlUnsigned16)(code & 0xf000);
        if (shift) {
            code ^= (ficlUnsigned16)(shift >> 8);
            code ^= (ficlUnsigned16)shift;
        }
    }

    return ((ficlUnsigned16)code);
}

/*
 * h a s h I n s e r t W o r d
 * Put a word into the hash table using the word's hashcode as
 * an index (modulo the table size).
 */
void
ficlHashInsertWord(ficlHash *hash, ficlWord *word)
{
    ficlWord **pList;

    FICL_ASSERT_PHASH(hash, hash);
    FICL_ASSERT_PHASH(hash, word);

    if (hash->size == 1) {
        pList = hash->table;
    } else {
        pList = hash->table + (word->hash % hash->size);
    }

    word->link = *pList;
    *pList = word;
}

/*
 * h a s h L o o k u p
 * Find a name in the hash table given the hashcode and text of the name.
 * Returns the address of the corresponding ficlWord if found,
 * otherwise NULL.
 * Note: outer loop on link field supports inheritance in wordlists.
 * It's not part of ANS Forth - Ficl only. hashReset creates wordlists
 * with NULL link fields.
 */
ficlWord *
ficlHashLookup(ficlHash *hash, ficlString name, ficlUnsigned16 hashCode)
{
    ficlUnsigned nCmp = name.length;
    ficlWord *word;
    ficlUnsigned16 hashIdx;

    if (nCmp > FICL_NAME_LENGTH)
        nCmp = FICL_NAME_LENGTH;

    for (; hash != NULL; hash = hash->link) {
        if (hash->size > 1)
            hashIdx = (ficlUnsigned16)(hashCode % hash->size);
        else /* avoid the modulo op for single threaded lists */
            hashIdx = 0;

        for (word = hash->table[hashIdx]; word; word = word->link) {
            if ((word->length == name.length) &&
                (!ficlStrincmp(name.text, word->name, nCmp)))
                return (word);
#if FICL_ROBUST
            FICL_ASSERT_PHASH(hash, word != word->link);
#endif
        }
    }

    return (NULL);
}

/*
 * h a s h R e s e t
 * Initialize a ficlHash to empty state.
 */
void
ficlHashReset(ficlHash *hash)
{
    unsigned i;

    FICL_ASSERT_PHASH(hash, hash);

    for (i = 0; i < hash->size; i++) {
        hash->table[i] = NULL;
    }

    hash->link = NULL;
    hash->name = NULL;
}