void simon_init(ficlVm *vm)
{
ficlDictionary *dict;
dict = ficlVmGetDictionary(vm);
ficlDictionarySetPrimitive(dict,"dcr!",ficl_sysDcrEbcSet,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"dcr@",ficl_sysDcrEbcGet,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"load",ficlPrimitiveLoad,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"load?",ficlPrimitiveLoadQuestion,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"file!",ficlIcatFileWrite,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"pfile!",ficlIcatPFileWrite,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"isfdir",ficlIsfDir,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"isfdel",ficlIsfDel,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"pcp",ficlPcp,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"icat-load",ficlIcatLoad,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"task-delay",ficl_task_delay,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"wait-fifo",ficl_wait_fifo,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"fifo-return-status",ficl_fifo_return_status,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"reboot",ficl_reboot,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"task-spawn",ficl_taskSpawn,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"diag-print",ficl_diagPrint,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"ftw1",ficl_ftw1,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"ftw2",ficl_ftw2,FICL_WORD_DEFAULT);
ficlDictionarySetPrimitive(dict,"rfswitch",ficl_switch,FICL_WORD_DEFAULT);
install_fifo_finished();
}
/*
* 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);
}
/*
* 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 e f i n i t i o n s
* SEARCH ( -- )
* Make the compilation word list the same as the first word list in the
* search order. Specifies that the names of subsequent definitions will
* be placed in the compilation word list. Subsequent changes in the search
* order will not affect the compilation word list.
*/
static void
ficlPrimitiveDefinitions(ficlVm *vm)
{
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
FICL_VM_ASSERT(vm, dictionary);
if (dictionary->wordlistCount < 1) {
ficlVmThrowError(vm, "DEFINITIONS error - empty search order");
}
dictionary->compilationWordlist =
dictionary->wordlists[dictionary->wordlistCount-1];
}
/*
* > 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);
}
/*
* f i c l - w o r d l i s t
* SEARCH ( -- wid )
* Create a new empty word list, returning its word list identifier wid.
* The new word list may be returned from a pool of preallocated word
* lists or may be dynamically allocated in data space. A system shall
* allow the creation of at least 8 new word lists in addition to any
* provided as part of the system.
* Notes:
* 1. Ficl creates a new single-list hash in the dictionary and returns
* its address.
* 2. ficl-wordlist takes an arg off the stack indicating the number of
* hash entries in the wordlist. Ficl 2.02 and later define WORDLIST as
* : wordlist 1 ficl-wordlist ;
*/
static void
ficlPrimitiveFiclWordlist(ficlVm *vm)
{
ficlDictionary *dictionary = ficlVmGetDictionary(vm);
ficlHash *hash;
ficlUnsigned nBuckets;
FICL_STACK_CHECK(vm->dataStack, 1, 1);
nBuckets = ficlStackPopUnsigned(vm->dataStack);
hash = ficlDictionaryCreateWordlist(dictionary, nBuckets);
ficlStackPushPointer(vm->dataStack, hash);
}
/*
* 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);
}
/*
* 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);
}
}
/*
* 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);
}
/*
** Dump a tab delimited file that summarizes the contents of the
** dictionary hash table by hashcode...
*/
static void ficlPrimitiveSpewHash(ficlVm *vm)
{
ficlHash *hash = ficlVmGetDictionary(vm)->forthWordlist;
ficlWord *word;
FILE *f;
unsigned i;
unsigned hashSize = hash->size;
if (!ficlVmGetWordToPad(vm))
ficlVmThrow(vm, FICL_VM_STATUS_OUT_OF_TEXT);
f = fopen(vm->pad, "w");
if (!f)
{
ficlVmTextOut(vm, "unable to open file\n");
return;
}
for (i = 0; i < hashSize; i++)
{
int n = 0;
word = hash->table[i];
while (word)
{
n++;
word = word->link;
}
fprintf(f, "%d\t%d", i, n);
word = hash->table[i];
while (word)
{
fprintf(f, "\t%s", word->name);
word = word->link;
}
fprintf(f, "\n");
}
fclose(f);
return;
}
FICL_PLATFORM_EXTERN ficlDictionary *vmGetDict (ficlVm *vm) { return ficlVmGetDictionary(vm); }
/*
* f o r t h - w o r d l i s t
* SEARCH ( -- wid )
* Return wid, the identifier of the word list that includes all standard
* words provided by the implementation. This word list is initially the
* compilation word list and is part of the initial search order.
*/
static void
ficlPrimitiveForthWordlist(ficlVm *vm)
{
ficlHash *hash = ficlVmGetDictionary(vm)->forthWordlist;
ficlStackPushPointer(vm->dataStack, hash);
}
