Esempio n. 1
0
/*
 *                      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);
}
Esempio n. 2
0
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;
}
Esempio n. 3
0
/*
 * 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);
}
Esempio n. 4
0
/*
 * 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);
}
Esempio n. 5
0
/*
 * 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);
}
Esempio n. 6
0
/*
 * 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);
}
Esempio n. 7
0
/*
 * > 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);
}
Esempio n. 8
0
/*
 * 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);
}
Esempio n. 9
0
/*
 * 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);
}
Esempio n. 10
0
/*
 * 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);
}
Esempio n. 11
0
/*
 * 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);
	}
}
Esempio n. 12
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; }