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