/*
* s e t - o r d e r
* SEARCH ( widn ... wid1 n -- )
* Set the search order to the word lists identified by widn ... wid1.
* Subsequently, word list wid1 will be searched first, and word list
* widn searched last. If n is zero, empty the search order. If n is minus
* one, set the search order to the implementation-defined minimum
* search order. The minimum search order shall include the words
* FORTH-WORDLIST and SET-ORDER. A system shall allow n to
* be at least eight.
*/
static void
ficlPrimitiveSetOrder(ficlVm *vm)
{
int i;
int wordlistCount = ficlStackPopInteger(vm->dataStack);
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
if (wordlistCount > FICL_MAX_WORDLISTS) {
ficlVmThrowError(vm,
"set-order error: list would be too large");
}
ficlDictionaryLock(dictionary, FICL_TRUE);
if (wordlistCount >= 0) {
dictionary->wordlistCount = wordlistCount;
for (i = wordlistCount-1; i >= 0; --i) {
dictionary->wordlists[i] =
ficlStackPopPointer(vm->dataStack);
}
} else {
ficlDictionaryResetSearchOrder(dictionary);
}
ficlDictionaryLock(dictionary, FICL_FALSE);
}
ficlWord *ficlSystemLookupLocal(ficlSystem *system, ficlString name)
{
ficlWord *word = NULL;
ficlDictionary *dictionary = system->dictionary;
ficlHash *hash = ficlSystemGetLocals(system)->forthWordlist;
int i;
ficlUnsigned16 hashCode = ficlHashCode(name);
FICL_SYSTEM_ASSERT(system, hash);
FICL_SYSTEM_ASSERT(system, dictionary);
ficlDictionaryLock(dictionary, FICL_TRUE);
/*
** check the locals dictionary first...
*/
word = ficlHashLookup(hash, name, hashCode);
/*
** If no joy, (!word) ------------------------------v
** iterate over the search list in the main dictionary
*/
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;
}
/*
* 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);
}
/*
* g e t - c u r r e n t
* SEARCH ( -- wid )
* Return wid, the identifier of the compilation word list.
*/
static void
ficlPrimitiveGetCurrent(ficlVm *vm)
{
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
ficlDictionaryLock(dictionary, FICL_TRUE);
ficlStackPushPointer(vm->dataStack, dictionary->compilationWordlist);
ficlDictionaryLock(dictionary, FICL_FALSE);
}
/*
* s e t - c u r r e n t
* SEARCH ( wid -- )
* Set the compilation word list to the word list identified by wid.
*/
static void
ficlPrimitiveSetCurrent(ficlVm *vm)
{
ficlHash *hash = ficlStackPopPointer(vm->dataStack);
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
ficlDictionaryLock(dictionary, FICL_TRUE);
dictionary->compilationWordlist = hash;
ficlDictionaryLock(dictionary, FICL_FALSE);
}
/*
* 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);
}
/*
* > S E A R C H
* Ficl ( wid -- )
* Push wid onto the search order. Error if the search order is full.
*/
static void
ficlPrimitiveSearchPush(ficlVm *vm)
{
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
ficlDictionaryLock(dictionary, FICL_TRUE);
if (dictionary->wordlistCount > FICL_MAX_WORDLISTS) {
ficlVmThrowError(vm, ">search error: search order overflow");
}
dictionary->wordlists[dictionary->wordlistCount++] =
ficlStackPopPointer(vm->dataStack);
ficlDictionaryLock(dictionary, FICL_FALSE);
}
/*
* S E A R C H >
* Ficl ( -- wid )
* Pop wid off the search order. Error if the search order is empty
*/
static void
ficlPrimitiveSearchPop(ficlVm *vm)
{
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
int wordlistCount;
ficlDictionaryLock(dictionary, FICL_TRUE);
wordlistCount = dictionary->wordlistCount;
if (wordlistCount == 0) {
ficlVmThrowError(vm, "search> error: empty search order");
}
ficlStackPushPointer(vm->dataStack,
dictionary->wordlists[--dictionary->wordlistCount]);
ficlDictionaryLock(dictionary, FICL_FALSE);
}
/*
* g e t - o r d e r
* SEARCH ( -- widn ... wid1 n )
* Returns the number of word lists n in the search order and the word list
* identifiers widn ... wid1 identifying these word lists. wid1 identifies
* the word list that is searched first, and widn the word list that is
* searched last. The search order is unaffected.
*/
static void
ficlPrimitiveGetOrder(ficlVm *vm)
{
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
int wordlistCount = dictionary->wordlistCount;
int i;
ficlDictionaryLock(dictionary, FICL_TRUE);
for (i = 0; i < wordlistCount; i++) {
ficlStackPushPointer(vm->dataStack, dictionary->wordlists[i]);
}
ficlStackPushUnsigned(vm->dataStack, wordlistCount);
ficlDictionaryLock(dictionary, FICL_FALSE);
}
/*
* 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 a r c h - w o r d l i s t
* SEARCH ( c-addr u wid -- 0 | xt 1 | xt -1 )
* Find the definition identified by the string c-addr u in the word list
* identified by wid. If the definition is not found, return zero. If the
* definition is found, return its execution token xt and one (1) if the
* definition is immediate, minus-one (-1) otherwise.
*/
static void
ficlPrimitiveSearchWordlist(ficlVm *vm)
{
ficlString name;
ficlUnsigned16 hashCode;
ficlWord *word;
ficlHash *hash = ficlStackPopPointer(vm->dataStack);
name.length = (ficlUnsigned8)ficlStackPopUnsigned(vm->dataStack);
name.text = ficlStackPopPointer(vm->dataStack);
hashCode = ficlHashCode(name);
ficlDictionaryLock(ficlVmGetDictionary(vm), FICL_TRUE);
word = ficlHashLookup(hash, name, hashCode);
ficlDictionaryLock(ficlVmGetDictionary(vm), FICL_FALSE);
if (word) {
ficlStackPushPointer(vm->dataStack, word);
ficlStackPushInteger(vm->dataStack,
(ficlWordIsImmediate(word) ? 1 : -1));
} else {
ficlStackPushUnsigned(vm->dataStack, 0);
}
}
FICL_PLATFORM_EXTERN int ficlBuild(ficlSystem *system, char *name, ficlPrimitive code, char flags) { ficlDictionary *dictionary = ficlSystemGetDictionary(system); ficlDictionaryLock(dictionary, FICL_TRUE); ficlDictionaryAppendPrimitive(dictionary, name, code, flags); ficlDictionaryLock(dictionary, FICL_FALSE); return 0; }