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); }