/*
 * d i c t . c
 * Forth Inspired Command Language - dictionary methods
 * Author: John Sadler (john_sadler@alum.mit.edu)
 * Created: 19 July 1997
 * $Id: dictionary.c,v 1.2 2010/09/12 15:14:52 asau Exp $
 */
/*
 * This file implements the dictionary -- Ficl's model of
 * memory management. All Ficl words are stored in the
 * dictionary. A word is a named chunk of data with its
 * associated code. Ficl treats all words the same, even
 * precompiled ones, so your words become first-class
 * extensions of the language. You can even define new
 * control structures.
 *
 * 29 jun 1998 (sadler) added variable sized hash table support
 */
/*
 * Copyright (c) 1997-2001 John Sadler (john_sadler@alum.mit.edu)
 * All rights reserved.
 *
 * Get the latest Ficl release at http://ficl.sourceforge.net
 *
 * I am interested in hearing from anyone who uses Ficl. If you have
 * a problem, a success story, a defect, an enhancement request, or
 * if you would like to contribute to the Ficl release, please
 * contact me by email at the address above.
 *
 * L I C E N S E  and  D I S C L A I M E R
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions
 * are met:
 * 1. Redistributions of source code must retain the above copyright
 *    notice, this list of conditions and the following disclaimer.
 * 2. Redistributions in binary form must reproduce the above copyright
 *    notice, this list of conditions and the following disclaimer in the
 *    documentation and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
 * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 * ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
 * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
 * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
 * SUCH DAMAGE.
 */

#include "ficl.h"

#define FICL_SAFE_CALLBACK_FROM_SYSTEM(system)          \
        (((system) != NULL) ? &((system)->callback) : NULL)
#define FICL_SAFE_SYSTEM_FROM_DICTIONARY(dictionary)    \
        (((dictionary) != NULL) ? (dictionary)->system : NULL)
#define FICL_DICTIONARY_ASSERT(dictionary, expression)  \
        FICL_SYSTEM_ASSERT(FICL_SAFE_SYSTEM_FROM_DICTIONARY(dictionary), \
        expression)

/*
 * d i c t A b o r t D e f i n i t i o n
 * Abort a definition in process: reclaim its memory and unlink it
 * from the dictionary list. Assumes that there is a smudged
 * definition in process...otherwise does nothing.
 * NOTE: this function is not smart enough to unlink a word that
 * has been successfully defined (ie linked into a hash). It
 * only works for defs in process. If the def has been unsmudged,
 * nothing happens.
 */
void
ficlDictionaryAbortDefinition(ficlDictionary *dictionary)
{
        ficlWord *word;
        ficlDictionaryLock(dictionary, FICL_TRUE);
        word = dictionary->smudge;

        if (word->flags & FICL_WORD_SMUDGED)
                dictionary->here = (ficlCell *)word->name;

        ficlDictionaryLock(dictionary, FICL_FALSE);
}

/*
 * d i c t A l i g n
 * Align the dictionary's free space pointer
 */
void
ficlDictionaryAlign(ficlDictionary *dictionary)
{
        dictionary->here = ficlAlignPointer(dictionary->here);
}

/*
 * d i c t A l l o t
 * Allocate or remove n chars of dictionary space, with
 * checks for underrun and overrun
 */
void
ficlDictionaryAllot(ficlDictionary *dictionary, int n)
{
        char *here = (char *)dictionary->here;
        here += n;
        dictionary->here = FICL_POINTER_TO_CELL(here);
}

/*
 * d i c t A l l o t C e l l s
 * Reserve space for the requested number of ficlCells in the
 * dictionary. If nficlCells < 0 , removes space from the dictionary.
 */
void
ficlDictionaryAllotCells(ficlDictionary *dictionary, int nficlCells)
{
        dictionary->here += nficlCells;
}

/*
 * d i c t A p p e n d C e l l
 * Append the specified ficlCell to the dictionary
 */
void
ficlDictionaryAppendCell(ficlDictionary *dictionary, ficlCell c)
{
        *dictionary->here++ = c;
}

/*
 * d i c t A p p e n d C h a r
 * Append the specified char to the dictionary
 */
void
ficlDictionaryAppendCharacter(ficlDictionary *dictionary, char c)
{
        char *here = (char *)dictionary->here;
        *here++ = c;
        dictionary->here = FICL_POINTER_TO_CELL(here);
}

/*
 * d i c t A p p e n d U N S
 * Append the specified ficlUnsigned to the dictionary
 */
void
ficlDictionaryAppendUnsigned(ficlDictionary *dictionary, ficlUnsigned u)
{
        ficlCell c;

        c.u = u;
        ficlDictionaryAppendCell(dictionary, c);
}

void *
ficlDictionaryAppendData(ficlDictionary *dictionary, void *data,
    ficlInteger length)
{
        char *here = (char *)dictionary->here;
        char *oldHere = here;
        char *from = (char *)data;

        if (length == 0) {
                ficlDictionaryAlign(dictionary);
                return ((char *)dictionary->here);
        }

        while (length) {
                *here++ = *from++;
                length--;
        }

        *here++ = '\0';

        dictionary->here = FICL_POINTER_TO_CELL(here);
        ficlDictionaryAlign(dictionary);
        return (oldHere);
}

/*
 * d i c t C o p y N a m e
 * Copy up to FICL_NAME_LENGTH characters of the name specified by s into
 * the dictionary starting at "here", then NULL-terminate the name,
 * point "here" to the next available byte, and return the address of
 * the beginning of the name. Used by dictAppendWord.
 * N O T E S :
 * 1. "here" is guaranteed to be aligned after this operation.
 * 2. If the string has zero length, align and return "here"
 */
char *
ficlDictionaryAppendString(ficlDictionary *dictionary, ficlString s)
{
        void *data = FICL_STRING_GET_POINTER(s);
        ficlInteger length = FICL_STRING_GET_LENGTH(s);

        if (length > FICL_NAME_LENGTH)
                length = FICL_NAME_LENGTH;

        return (ficlDictionaryAppendData(dictionary, data, length));
}

ficlWord *
ficlDictionaryAppendConstantInstruction(ficlDictionary *dictionary,
    ficlString name, ficlInstruction instruction, ficlInteger value)
{
        ficlWord *word = ficlDictionaryAppendWord(dictionary, name,
            (ficlPrimitive)instruction, FICL_WORD_DEFAULT);

        if (word != NULL)
                ficlDictionaryAppendUnsigned(dictionary, value);
        return (word);
}

ficlWord *
ficlDictionaryAppend2ConstantInstruction(ficlDictionary *dictionary,
    ficlString name, ficlInstruction instruction, ficl2Integer value)
{
        ficlWord *word = ficlDictionaryAppendWord(dictionary, name,
            (ficlPrimitive)instruction, FICL_WORD_DEFAULT);

        if (word != NULL) {
                ficlDictionaryAppendUnsigned(dictionary,
                    FICL_2UNSIGNED_GET_HIGH(value));
                ficlDictionaryAppendUnsigned(dictionary,
                    FICL_2UNSIGNED_GET_LOW(value));
        }
        return (word);
}

ficlWord *
ficlDictionaryAppendConstant(ficlDictionary *dictionary, char *name,
    ficlInteger value)
{
        ficlString s;
        FICL_STRING_SET_FROM_CSTRING(s, name);
        return (ficlDictionaryAppendConstantInstruction(dictionary, s,
            ficlInstructionConstantParen, value));
}

ficlWord *
ficlDictionaryAppend2Constant(ficlDictionary *dictionary, char *name,
    ficl2Integer value)
{
        ficlString s;
        FICL_STRING_SET_FROM_CSTRING(s, name);
        return (ficlDictionaryAppend2ConstantInstruction(dictionary, s,
            ficlInstruction2ConstantParen, value));
}

ficlWord *
ficlDictionarySetConstantInstruction(ficlDictionary *dictionary,
    ficlString name, ficlInstruction instruction, ficlInteger value)
{
        ficlWord *word = ficlDictionaryLookup(dictionary, name);
        ficlCell c;

        if (word == NULL) {
                word = ficlDictionaryAppendConstantInstruction(dictionary,
                    name, instruction, value);
        } else {
                word->code = (ficlPrimitive)instruction;
                c.i = value;
                word->param[0] = c;
        }
        return (word);
}

ficlWord *
ficlDictionarySetConstant(ficlDictionary *dictionary, char *name,
    ficlInteger value)
{
        ficlString s;
        FICL_STRING_SET_FROM_CSTRING(s, name);
        return (ficlDictionarySetConstantInstruction(dictionary, s,
            ficlInstructionConstantParen, value));
}

ficlWord *
ficlDictionarySet2ConstantInstruction(ficlDictionary *dictionary, ficlString s,
    ficlInstruction instruction, ficl2Integer value)
{
        ficlWord *word;
        word = ficlDictionaryLookup(dictionary, s);

        /*
         * only reuse the existing word if we're sure it has space for a
         * 2constant
         */
#if FICL_WANT_FLOAT
        if ((word != NULL) &&
            ((((ficlInstruction)word->code) == ficlInstruction2ConstantParen) ||
            (((ficlInstruction)word->code) == ficlInstructionF2ConstantParen)))
#else
        if ((word != NULL) &&
            ((((ficlInstruction)word->code) == ficlInstruction2ConstantParen)))
#endif /* FICL_WANT_FLOAT */
        {
                word->code = (ficlPrimitive)instruction;
                word->param[0].u = FICL_2UNSIGNED_GET_HIGH(value);
                word->param[1].u = FICL_2UNSIGNED_GET_LOW(value);
        } else {
                word = ficlDictionaryAppend2ConstantInstruction(dictionary, s,
                    instruction, value);
        }

        return (word);
}

ficlWord *
ficlDictionarySet2Constant(ficlDictionary *dictionary, char *name,
    ficl2Integer value)
{
        ficlString s;
        FICL_STRING_SET_FROM_CSTRING(s, name);

        return (ficlDictionarySet2ConstantInstruction(dictionary, s,
            ficlInstruction2ConstantParen, value));
}

ficlWord *
ficlDictionarySetConstantString(ficlDictionary *dictionary, char *name,
    char *value)
{
        ficlString s;
        ficl2Integer valueAs2Integer;
        FICL_2INTEGER_SET(strlen(value), (intptr_t)value, valueAs2Integer);
        FICL_STRING_SET_FROM_CSTRING(s, name);

        return (ficlDictionarySet2ConstantInstruction(dictionary, s,
            ficlInstruction2ConstantParen, valueAs2Integer));
}

/*
 * d i c t A p p e n d W o r d
 * Create a new word in the dictionary with the specified
 * ficlString, code, and flags. Does not require a NULL-terminated
 * name.
 */
ficlWord *
ficlDictionaryAppendWord(ficlDictionary *dictionary, ficlString name,
    ficlPrimitive code, ficlUnsigned8 flags)
{
        ficlUnsigned8 length = (ficlUnsigned8)FICL_STRING_GET_LENGTH(name);
        char *nameCopy;
        ficlWord *word;

        ficlDictionaryLock(dictionary, FICL_TRUE);

        /*
         * NOTE: ficlDictionaryAppendString advances "here" as a side-effect.
         * It must execute before word is initialized.
         */
        nameCopy = ficlDictionaryAppendString(dictionary, name);
        word = (ficlWord *)dictionary->here;
        dictionary->smudge = word;
        word->hash = ficlHashCode(name);
        word->code = code;
        word->semiParen = ficlInstructionSemiParen;
        word->flags = (ficlUnsigned8)(flags | FICL_WORD_SMUDGED);
        word->length = length;
        word->name = nameCopy;

        /*
         * Point "here" to first ficlCell of new word's param area...
         */
        dictionary->here = word->param;

        if (!(flags & FICL_WORD_SMUDGED))
                ficlDictionaryUnsmudge(dictionary);

        ficlDictionaryLock(dictionary, FICL_FALSE);
        return (word);
}

/*
 * d i c t A p p e n d W o r d
 * Create a new word in the dictionary with the specified
 * name, code, and flags. Name must be NULL-terminated.
 */
ficlWord *
ficlDictionaryAppendPrimitive(ficlDictionary *dictionary, char *name,
    ficlPrimitive code, ficlUnsigned8 flags)
{
        ficlString s;
        FICL_STRING_SET_FROM_CSTRING(s, name);

        return (ficlDictionaryAppendWord(dictionary, s, code, flags));
}

ficlWord *
ficlDictionarySetPrimitive(ficlDictionary *dictionary, char *name,
    ficlPrimitive code, ficlUnsigned8 flags)
{
        ficlString s;
        ficlWord *word;

        FICL_STRING_SET_FROM_CSTRING(s, name);
        word = ficlDictionaryLookup(dictionary, s);

        if (word == NULL) {
                word = ficlDictionaryAppendPrimitive(dictionary, name,
                    code, flags);
        } else {
                word->code = (ficlPrimitive)code;
                word->flags = flags;
        }
        return (word);
}

ficlWord *
ficlDictionaryAppendInstruction(ficlDictionary *dictionary, char *name,
    ficlInstruction i, ficlUnsigned8 flags)
{
        return (ficlDictionaryAppendPrimitive(dictionary, name,
            (ficlPrimitive)i, (ficlUnsigned8)(FICL_WORD_INSTRUCTION | flags)));
}

ficlWord *
ficlDictionarySetInstruction(ficlDictionary *dictionary, char *name,
    ficlInstruction i, ficlUnsigned8 flags)
{
        return (ficlDictionarySetPrimitive(dictionary, name,
            (ficlPrimitive)i, (ficlUnsigned8)(FICL_WORD_INSTRUCTION | flags)));
}

/*
 * d i c t C e l l s A v a i l
 * Returns the number of empty ficlCells left in the dictionary
 */
int
ficlDictionaryCellsAvailable(ficlDictionary *dictionary)
{
        return (dictionary->size - ficlDictionaryCellsUsed(dictionary));
}

/*
 * d i c t C e l l s U s e d
 * Returns the number of ficlCells consumed in the dicionary
 */
int
ficlDictionaryCellsUsed(ficlDictionary *dictionary)
{
        return (dictionary->here - dictionary->base);
}

/*
 * d i c t C r e a t e
 * Create and initialize a dictionary with the specified number
 * of ficlCells capacity, and no hashing (hash size == 1).
 */
ficlDictionary *
ficlDictionaryCreate(ficlSystem *system, unsigned size)
{
        return (ficlDictionaryCreateHashed(system, size, 1));
}

ficlDictionary *
ficlDictionaryCreateHashed(ficlSystem *system, unsigned size,
    unsigned bucketCount)
{
        ficlDictionary *dictionary;
        size_t nAlloc;

        nAlloc =  sizeof (ficlDictionary) + (size * sizeof (ficlCell))
            + sizeof (ficlHash) + (bucketCount - 1) * sizeof (ficlWord *);

        dictionary = ficlMalloc(nAlloc);
        FICL_SYSTEM_ASSERT(system, dictionary != NULL);

        dictionary->size = size;
        dictionary->system = system;

        ficlDictionaryEmpty(dictionary, bucketCount);
        return (dictionary);
}

/*
 * d i c t C r e a t e W o r d l i s t
 * Create and initialize an anonymous wordlist
 */
ficlHash *
ficlDictionaryCreateWordlist(ficlDictionary *dictionary, int bucketCount)
{
        ficlHash *hash;

        ficlDictionaryAlign(dictionary);
        hash = (ficlHash *)dictionary->here;
        ficlDictionaryAllot(dictionary,
            sizeof (ficlHash) + (bucketCount - 1) * sizeof (ficlWord *));

        hash->size = bucketCount;
        ficlHashReset(hash);
        return (hash);
}

/*
 * d i c t D e l e t e
 * Free all memory allocated for the given dictionary
 */
void
ficlDictionaryDestroy(ficlDictionary *dictionary)
{
        FICL_DICTIONARY_ASSERT(dictionary, dictionary != NULL);
        ficlFree(dictionary);
}

/*
 * d i c t E m p t y
 * Empty the dictionary, reset its hash table, and reset its search order.
 * Clears and (re-)creates the hash table with the size specified by nHash.
 */
void
ficlDictionaryEmpty(ficlDictionary *dictionary, unsigned bucketCount)
{
        ficlHash *hash;

        dictionary->here = dictionary->base;

        ficlDictionaryAlign(dictionary);
        hash = (ficlHash *)dictionary->here;
        ficlDictionaryAllot(dictionary,
            sizeof (ficlHash) + (bucketCount - 1) * sizeof (ficlWord *));

        hash->size = bucketCount;
        ficlHashReset(hash);

        dictionary->forthWordlist = hash;
        dictionary->smudge = NULL;
        ficlDictionaryResetSearchOrder(dictionary);
}

/*
 * i s A F i c l W o r d
 * Vet a candidate pointer carefully to make sure
 * it's not some chunk o' inline data...
 * It has to have a name, and it has to look
 * like it's in the dictionary address range.
 * NOTE: this excludes :noname words!
 */
int
ficlDictionaryIsAWord(ficlDictionary *dictionary, ficlWord *word)
{
        if ((((ficlInstruction)word) > ficlInstructionInvalid) &&
            (((ficlInstruction)word) < ficlInstructionLast))
                return (1);

        if (!ficlDictionaryIncludes(dictionary, word))
                return (0);

        if (!ficlDictionaryIncludes(dictionary, word->name))
                return (0);

        if ((word->link != NULL) &&
            !ficlDictionaryIncludes(dictionary, word->link))
                return (0);

        if ((word->length <= 0) || (word->name[word->length] != '\0'))
                return (0);

        if (strlen(word->name) != word->length)
                return (0);

        return (1);
}

/*
 * f i n d E n c l o s i n g W o r d
 * Given a pointer to something, check to make sure it's an address in the
 * dictionary. If so, search backwards until we find something that looks
 * like a dictionary header. If successful, return the address of the
 * ficlWord found. Otherwise return NULL. nSEARCH_CELLS sets the maximum
 * neighborhood this func will search before giving up
 */
#define nSEARCH_CELLS   100

ficlWord *
ficlDictionaryFindEnclosingWord(ficlDictionary *dictionary, ficlCell *cell)
{
        ficlWord *word;
        int i;

        if (!ficlDictionaryIncludes(dictionary, (void *)cell))
                return (NULL);

        for (i = nSEARCH_CELLS; i > 0; --i, --cell) {
                word = (ficlWord *)
                    (cell + 1 - (sizeof (ficlWord) / sizeof (ficlCell)));
                if (ficlDictionaryIsAWord(dictionary, word))
                        return (word);
        }

        return (NULL);
}

/*
 * d i c t I n c l u d e s
 * Returns FICL_TRUE iff the given pointer is within the address range of
 * the dictionary.
 */
int
ficlDictionaryIncludes(ficlDictionary *dictionary, void *p)
{
        return ((p >= (void *) &dictionary->base) &&
            (p <  (void *)(&dictionary->base + dictionary->size)));
}

/*
 * d i c t L o o k u p
 * Find the ficlWord that matches the given name and length.
 * If found, returns the word's address. Otherwise returns NULL.
 * Uses the search order list to search multiple wordlists.
 */
ficlWord *
ficlDictionaryLookup(ficlDictionary *dictionary, ficlString name)
{
        ficlWord *word = NULL;
        ficlHash *hash;
        int i;
        ficlUnsigned16 hashCode = ficlHashCode(name);

        FICL_DICTIONARY_ASSERT(dictionary, dictionary != NULL);

        ficlDictionaryLock(dictionary, FICL_TRUE);

        for (i = (int)dictionary->wordlistCount - 1; (i >= 0) && (!word); --i) {
                hash = dictionary->wordlists[i];
                word = ficlHashLookup(hash, name, hashCode);
        }

        ficlDictionaryLock(dictionary, FICL_FALSE);
        return (word);
}

/*
 * s e e
 * TOOLS ( "<spaces>name" -- )
 * Display a human-readable representation of the named word's definition.
 * The source of the representation (object-code decompilation, source
 * block, etc.) and the particular form of the display is implementation
 * defined.
 */
/*
 * ficlSeeColon (for proctologists only)
 * Walks a colon definition, decompiling
 * on the fly. Knows about primitive control structures.
 */
char *ficlDictionaryInstructionNames[] =
{
#define FICL_TOKEN(token, description)  description,
#define FICL_INSTRUCTION_TOKEN(token, description, flags)       description,
#include "ficltokens.h"
#undef FICL_TOKEN
#undef FICL_INSTRUCTION_TOKEN
};

void
ficlDictionarySee(ficlDictionary *dictionary, ficlWord *word,
    ficlCallback *callback)
{
        char *trace;
        ficlCell *cell = word->param;
        ficlCell *param0 = cell;
        char buffer[128];

        for (; cell->i != ficlInstructionSemiParen; cell++) {
                ficlWord *word = (ficlWord *)(cell->p);

                trace = buffer;
                if ((void *)cell == (void *)buffer)
                        *trace++ = '>';
                else
                        *trace++ = ' ';
                trace += sprintf(trace, "%3ld   ", (long)(cell - param0));

                if (ficlDictionaryIsAWord(dictionary, word)) {
                        ficlWordKind kind = ficlWordClassify(word);
                        ficlCell c, c2;

                        switch (kind) {
                        case FICL_WORDKIND_INSTRUCTION:
                                (void) sprintf(trace, "%s (instruction %ld)",
                                    ficlDictionaryInstructionNames[(long)word],
                                    (long)word);
                        break;
                        case FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT:
                                c = *++cell;
                                (void) sprintf(trace, "%s (instruction %ld), "
                                    "with argument %ld (%#lx)",
                                    ficlDictionaryInstructionNames[(long)word],
                                    (long)word, (long)c.i, (unsigned long)c.u);
                        break;
                        case FICL_WORDKIND_INSTRUCTION_WORD:
                                (void) sprintf(trace,
                                    "%s :: executes %s (instruction word %ld)",
                                    word->name,
                                    ficlDictionaryInstructionNames[
                                    (long)word->code], (long)word->code);
                        break;
                        case FICL_WORDKIND_LITERAL:
                                c = *++cell;
                                if (ficlDictionaryIsAWord(dictionary, c.p) &&
                                    (c.i >= ficlInstructionLast)) {
                                        ficlWord *word = (ficlWord *)c.p;
                                        (void) sprintf(trace,
                                            "%.*s ( %#lx literal )",
                                            word->length, word->name,
                                            (unsigned long)c.u);
                                } else
                                        (void) sprintf(trace,
                                            "literal %ld (%#lx)", (long)c.i,
                                            (unsigned long)c.u);
                        break;
                        case FICL_WORDKIND_2LITERAL:
                                c = *++cell;
                                c2 = *++cell;
                                (void) sprintf(trace,
                                    "2literal %ld %ld (%#lx %#lx)",
                                    (long)c2.i, (long)c.i, (unsigned long)c2.u,
                                    (unsigned long)c.u);
                        break;
#if FICL_WANT_FLOAT
                        case FICL_WORDKIND_FLITERAL:
                                c = *++cell;
                                (void) sprintf(trace, "fliteral %f (%#lx)",
                                    (double)c.f, (unsigned long)c.u);
                        break;
#endif /* FICL_WANT_FLOAT */
                        case FICL_WORDKIND_STRING_LITERAL: {
                                ficlCountedString *counted;
                                counted = (ficlCountedString *)(void *)++cell;
                                cell = (ficlCell *)
                                    ficlAlignPointer(counted->text +
                                    counted->length + 1) - 1;
                                (void) sprintf(trace, "s\" %.*s\"",
                                    counted->length, counted->text);
                        }
                        break;
                        case FICL_WORDKIND_CSTRING_LITERAL: {
                                ficlCountedString *counted;
                                counted = (ficlCountedString *)(void *)++cell;
                                cell = (ficlCell *)
                                    ficlAlignPointer(counted->text +
                                    counted->length + 1) - 1;
                                (void) sprintf(trace, "c\" %.*s\"",
                                    counted->length, counted->text);
                        }
                        break;
                        case FICL_WORDKIND_BRANCH0:
                                c = *++cell;
                                (void) sprintf(trace, "branch0 %ld",
                                    (long)(cell + c.i - param0));
                        break;
                        case FICL_WORDKIND_BRANCH:
                                c = *++cell;
                                (void) sprintf(trace, "branch %ld",
                                    (long)(cell + c.i - param0));
                        break;

                        case FICL_WORDKIND_QDO:
                                c = *++cell;
                                (void) sprintf(trace, "?do (leave %ld)",
                                    (long)((ficlCell *)c.p - param0));
                        break;
                        case FICL_WORDKIND_DO:
                                c = *++cell;
                                (void) sprintf(trace, "do (leave %ld)",
                                    (long)((ficlCell *)c.p - param0));
                        break;
                        case FICL_WORDKIND_LOOP:
                                c = *++cell;
                                (void) sprintf(trace, "loop (branch %ld)",
                                    (long)(cell + c.i - param0));
                        break;
                        case FICL_WORDKIND_OF:
                                c = *++cell;
                                (void) sprintf(trace, "of (branch %ld)",
                                    (long)(cell + c.i - param0));
                        break;
                        case FICL_WORDKIND_PLOOP:
                                c = *++cell;
                                (void) sprintf(trace, "+loop (branch %ld)",
                                    (long)(cell + c.i - param0));
                        break;
                        default:
                                (void) sprintf(trace, "%.*s", word->length,
                                    word->name);
                        break;
                        }
                } else {
                        /* probably not a word - punt and print value */
                        (void) sprintf(trace, "%ld ( %#lx )", (long)cell->i,
                            (unsigned long)cell->u);
                }

                ficlCallbackTextOut(callback, buffer);
                ficlCallbackTextOut(callback, "\n");
        }

        ficlCallbackTextOut(callback, ";\n");
}

/*
 * d i c t R e s e t S e a r c h O r d e r
 * Initialize the dictionary search order list to sane state
 */
void
ficlDictionaryResetSearchOrder(ficlDictionary *dictionary)
{
        FICL_DICTIONARY_ASSERT(dictionary, dictionary);
        dictionary->compilationWordlist = dictionary->forthWordlist;
        dictionary->wordlistCount = 1;
        dictionary->wordlists[0] = dictionary->forthWordlist;
}

/*
 * d i c t S e t F l a g s
 * Changes the flags field of the most recently defined word:
 * Set all bits that are ones in the set parameter.
 */
void
ficlDictionarySetFlags(ficlDictionary *dictionary, ficlUnsigned8 set)
{
        FICL_DICTIONARY_ASSERT(dictionary, dictionary->smudge);
        dictionary->smudge->flags |= set;
}


/*
 * d i c t C l e a r F l a g s
 * Changes the flags field of the most recently defined word:
 * Clear all bits that are ones in the clear parameter.
 */
void
ficlDictionaryClearFlags(ficlDictionary *dictionary, ficlUnsigned8 clear)
{
        FICL_DICTIONARY_ASSERT(dictionary, dictionary->smudge);
        dictionary->smudge->flags &= ~clear;
}

/*
 * d i c t S e t I m m e d i a t e
 * Set the most recently defined word as IMMEDIATE
 */
void
ficlDictionarySetImmediate(ficlDictionary *dictionary)
{
        FICL_DICTIONARY_ASSERT(dictionary, dictionary->smudge);
        dictionary->smudge->flags |= FICL_WORD_IMMEDIATE;
}

/*
 * d i c t U n s m u d g e
 * Completes the definition of a word by linking it
 * into the main list
 */
void
ficlDictionaryUnsmudge(ficlDictionary *dictionary)
{
        ficlWord *word = dictionary->smudge;
        ficlHash *hash = dictionary->compilationWordlist;

        FICL_DICTIONARY_ASSERT(dictionary, hash);
        FICL_DICTIONARY_ASSERT(dictionary, word);

        /*
         * :noname words never get linked into the list...
         */
        if (word->length > 0)
                ficlHashInsertWord(hash, word);
        word->flags &= ~(FICL_WORD_SMUDGED);
}

/*
 * d i c t W h e r e
 * Returns the value of the HERE pointer -- the address
 * of the next free ficlCell in the dictionary
 */
ficlCell *
ficlDictionaryWhere(ficlDictionary *dictionary)
{
        return (dictionary->here);
}