/* * f i c l C o m p i l e S e a r c h * Builds the primitive wordset and the environment-query namespace. */ void ficlSystemCompileSearch(ficlSystem *system) { ficlDictionary *dictionary = ficlSystemGetDictionary(system); ficlDictionary *environment = ficlSystemGetEnvironment(system); FICL_SYSTEM_ASSERT(system, dictionary); FICL_SYSTEM_ASSERT(system, environment); /* * optional SEARCH-ORDER word set */ (void) ficlDictionarySetPrimitive(dictionary, ">search", ficlPrimitiveSearchPush, FICL_WORD_DEFAULT); (void) ficlDictionarySetPrimitive(dictionary, "search>", ficlPrimitiveSearchPop, FICL_WORD_DEFAULT); (void) ficlDictionarySetPrimitive(dictionary, "definitions", ficlPrimitiveDefinitions, FICL_WORD_DEFAULT); (void) ficlDictionarySetPrimitive(dictionary, "forth-wordlist", ficlPrimitiveForthWordlist, FICL_WORD_DEFAULT); (void) ficlDictionarySetPrimitive(dictionary, "get-current", ficlPrimitiveGetCurrent, FICL_WORD_DEFAULT); (void) ficlDictionarySetPrimitive(dictionary, "get-order", ficlPrimitiveGetOrder, FICL_WORD_DEFAULT); (void) ficlDictionarySetPrimitive(dictionary, "search-wordlist", ficlPrimitiveSearchWordlist, FICL_WORD_DEFAULT); (void) ficlDictionarySetPrimitive(dictionary, "set-current", ficlPrimitiveSetCurrent, FICL_WORD_DEFAULT); (void) ficlDictionarySetPrimitive(dictionary, "set-order", ficlPrimitiveSetOrder, FICL_WORD_DEFAULT); (void) ficlDictionarySetPrimitive(dictionary, "ficl-wordlist", ficlPrimitiveFiclWordlist, FICL_WORD_DEFAULT); /* * Set SEARCH environment query values */ (void) ficlDictionarySetConstant(environment, "search-order", FICL_TRUE); (void) ficlDictionarySetConstant(environment, "search-order-ext", FICL_TRUE); (void) ficlDictionarySetConstant(environment, "wordlists", FICL_MAX_WORDLISTS); (void) ficlDictionarySetPrimitive(dictionary, "wid-get-name", ficlPrimitiveWidGetName, FICL_WORD_DEFAULT); (void) ficlDictionarySetPrimitive(dictionary, "wid-set-name", ficlPrimitiveWidSetName, FICL_WORD_DEFAULT); (void) ficlDictionarySetPrimitive(dictionary, "wid-set-super", ficlPrimitiveSetParentWid, FICL_WORD_DEFAULT); }
/* * Initialise the Forth interpreter, create all our commands as words. */ void bf_init(char *rc) { struct bootblk_command **cmdp; char create_buf[41]; /* 31 characters-long builtins */ int fd, rv; ficlDictionary *dict; ficlDictionary *env; fsi = malloc(sizeof (ficlSystemInformation)); ficlSystemInformationInitialize(fsi); fsi->dictionarySize = BF_DICTSIZE; bf_sys = ficlSystemCreate(fsi); bf_vm = ficlSystemCreateVm(bf_sys); /* Put all private definitions in a "builtins" vocabulary */ rv = ficlVmEvaluate(bf_vm, "vocabulary builtins also builtins definitions"); if (rv != FICL_VM_STATUS_OUT_OF_TEXT) { panic("error interpreting forth: %d", rv); } /* Builtin constructor word */ rv = ficlVmEvaluate(bf_vm, BUILTIN_CONSTRUCTOR); if (rv != FICL_VM_STATUS_OUT_OF_TEXT) { panic("error interpreting forth: %d", rv); } /* make all commands appear as Forth words */ dict = ficlSystemGetDictionary(bf_sys); SET_FOREACH(cmdp, Xcommand_set) { ficlDictionaryAppendPrimitive(dict, (char *)(*cmdp)->c_name, bf_command, FICL_WORD_DEFAULT); rv = ficlVmEvaluate(bf_vm, "forth definitions builtins"); if (rv != FICL_VM_STATUS_OUT_OF_TEXT) { panic("error interpreting forth: %d", rv); } sprintf(create_buf, "builtin: %s", (*cmdp)->c_name); rv = ficlVmEvaluate(bf_vm, create_buf); if (rv != FICL_VM_STATUS_OUT_OF_TEXT) { panic("error interpreting forth: %d", rv); } rv = ficlVmEvaluate(bf_vm, "builtins definitions"); if (rv != FICL_VM_STATUS_OUT_OF_TEXT) { panic("error interpreting forth: %d", rv); } }
void ficlSystemCompileExtras(ficlSystem *system) { ficlDictionary *dictionary = ficlSystemGetDictionary(system); ficlDictionarySetPrimitive(dictionary, "break", ficlPrimitiveBreak, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "load", ficlPrimitiveLoad, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "spewhash", ficlPrimitiveSpewHash, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "system", ficlPrimitiveSystem, FICL_WORD_DEFAULT); #ifndef FICL_ANSI ficlDictionarySetPrimitive(dictionary, "clock", ficlPrimitiveClock, FICL_WORD_DEFAULT); ficlDictionarySetConstant(dictionary, "clocks/sec", CLOCKS_PER_SEC); ficlDictionarySetPrimitive(dictionary, "pwd", ficlPrimitiveGetCwd, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "cd", ficlPrimitiveChDir, FICL_WORD_DEFAULT); #endif /* FICL_ANSI */ return; }
void ficlSystemCompileFile(ficlSystem *system) { #if !FICL_WANT_FILE FICL_IGNORE(system); #else ficlDictionary *dictionary = ficlSystemGetDictionary(system); ficlDictionary *environment = ficlSystemGetEnvironment(system); FICL_SYSTEM_ASSERT(system, dictionary); FICL_SYSTEM_ASSERT(system, environment); ficlDictionarySetPrimitive(dictionary, "create-file", ficlPrimitiveCreateFile, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "open-file", ficlPrimitiveOpenFile, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "close-file", ficlPrimitiveCloseFile, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "include-file", ficlPrimitiveIncludeFile, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "read-file", ficlPrimitiveReadFile, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "read-line", ficlPrimitiveReadLine, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "write-file", ficlPrimitiveWriteFile, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "write-line", ficlPrimitiveWriteLine, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "file-position", ficlPrimitiveFilePosition, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "file-size", ficlPrimitiveFileSize, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "reposition-file", ficlPrimitiveRepositionFile, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "file-status", ficlPrimitiveFileStatus, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "flush-file", ficlPrimitiveFlushFile, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "delete-file", ficlPrimitiveDeleteFile, FICL_WORD_DEFAULT); ficlDictionarySetPrimitive(dictionary, "rename-file", ficlPrimitiveRenameFile, FICL_WORD_DEFAULT); #if FICL_PLATFORM_HAS_FTRUNCATE ficlDictionarySetPrimitive(dictionary, "resize-file", ficlPrimitiveResizeFile, FICL_WORD_DEFAULT); ficlDictionarySetConstant(environment, "file", FICL_TRUE); ficlDictionarySetConstant(environment, "file-ext", FICL_TRUE); #else /* FICL_PLATFORM_HAS_FTRUNCATE */ ficlDictionarySetConstant(environment, "file", FICL_FALSE); ficlDictionarySetConstant(environment, "file-ext", FICL_FALSE); #endif /* FICL_PLATFORM_HAS_FTRUNCATE */ #endif /* !FICL_WANT_FILE */ }
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; }
FICL_PLATFORM_EXTERN void ficlSetEnvD(ficlSystem *system, char *name, ficlInteger high, ficlInteger low) { ficl2Unsigned value; FICL_2UNSIGNED_SET(low, high, value); ficlDictionarySet2Constant(ficlSystemGetDictionary(system), name, FICL_2UNSIGNED_TO_2INTEGER(value)); }
FICL_PLATFORM_EXTERN void ficlSetEnv (ficlSystem *system, char *name, ficlInteger value) { ficlDictionarySetConstant(ficlSystemGetDictionary(system), name, value); }
FICL_PLATFORM_EXTERN ficlDictionary *ficlGetDict(ficlSystem *system) { return ficlSystemGetDictionary(system); }