blob: 39460e91445b38f6d018392746b103d0445e55e2 [file] [log] [blame]
/*
* 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:
sprintf(trace, "%s (instruction %ld)",
ficlDictionaryInstructionNames[(long)word],
(long)word);
break;
case FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT:
c = *++cell;
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:
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;
sprintf(trace, "%.*s ( %#lx literal )",
word->length, word->name,
(unsigned long)c.u);
} else
sprintf(trace,
"literal %ld (%#lx)", (long)c.i,
(unsigned long)c.u);
break;
case FICL_WORDKIND_2LITERAL:
c = *++cell;
c2 = *++cell;
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;
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;
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;
sprintf(trace, "c\" %.*s\"", counted->length,
counted->text);
}
break;
case FICL_WORDKIND_BRANCH0:
c = *++cell;
sprintf(trace, "branch0 %ld",
(long)(cell + c.i - param0));
break;
case FICL_WORDKIND_BRANCH:
c = *++cell;
sprintf(trace, "branch %ld",
(long)(cell + c.i - param0));
break;
case FICL_WORDKIND_QDO:
c = *++cell;
sprintf(trace, "?do (leave %ld)",
(long)((ficlCell *)c.p - param0));
break;
case FICL_WORDKIND_DO:
c = *++cell;
sprintf(trace, "do (leave %ld)",
(long)((ficlCell *)c.p - param0));
break;
case FICL_WORDKIND_LOOP:
c = *++cell;
sprintf(trace, "loop (branch %ld)",
(long)(cell + c.i - param0));
break;
case FICL_WORDKIND_OF:
c = *++cell;
sprintf(trace, "of (branch %ld)",
(long)(cell + c.i - param0));
break;
case FICL_WORDKIND_PLOOP:
c = *++cell;
sprintf(trace, "+loop (branch %ld)",
(long)(cell + c.i - param0));
break;
default:
sprintf(trace, "%.*s", word->length,
word->name);
break;
}
} else {
/* probably not a word - punt and print value */
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);
}