/* ** Compile a word into the dictionary that invokes the specified FICL_PARSE_STEP ** function. It is up to the user (as usual in Forth) to make sure the stack ** preconditions are valid (there needs to be a counted string on top of the stack) ** before using the resulting word. */ void ficlAddPrecompiledParseStep(FICL_SYSTEM *pSys, char *name, FICL_PARSE_STEP pStep) { FICL_DICT *dp = pSys->dp; FICL_WORD *pFW = dictAppendWord(dp, name, parseStepParen, FW_DEFAULT); dictAppendCell(dp, LVALUEtoCELL(pStep)); ficlAddParseStep(pSys, pFW); }
/************************************************************************** f i c l C o m p i l e P r e f i x ** Build prefix support into the dictionary and the parser ** Note: since prefixes always execute, they are effectively IMMEDIATE. ** If they need to generate code in compile state you must add ** this code explicitly. **************************************************************************/ void ficlCompilePrefix(FICL_SYSTEM *pSys) { FICL_DICT *dp = pSys->dp; FICL_HASH *pHash; FICL_HASH *pPrevCompile = dp->pCompile; #if (FICL_EXTENDED_PREFIX) FICL_WORD *pFW; #endif /* ** Create a named wordlist for prefixes to reside in... ** Since we're doing a special kind of search, make it ** a single bucket hashtable - hashing does not help here. */ pHash = dictCreateWordlist(dp, 1); pHash->name = list_name; dictAppendWord(dp, list_name, constantParen, FW_DEFAULT); dictAppendCell(dp, LVALUEtoCELL(pHash)); /* ** Put __tempbase in the forth-wordlist */ dictAppendWord(dp, "__tempbase", fTempBase, FW_DEFAULT); /* ** Temporarily make the prefix list the compile wordlist so that ** we can create some precompiled prefixes. */ dp->pCompile = pHash; dictAppendWord(dp, "0x", prefixHex, FW_DEFAULT); dictAppendWord(dp, "0d", prefixTen, FW_DEFAULT); #if (FICL_EXTENDED_PREFIX) pFW = ficlLookup(pSys, "\\"); if (pFW) { dictAppendWord(dp, "//", pFW->code, FW_DEFAULT); } #endif dp->pCompile = pPrevCompile; return; }
/************************************************************************** f i c l B u i l d ** Builds a word into the dictionary. ** Preconditions: system must be initialized, and there must ** be enough space for the new word's header! Operation is ** controlled by ficlLockDictionary, so any initialization ** required by your version of the function (if you overrode ** it) must be complete at this point. ** Parameters: ** name -- duh, the name of the word ** code -- code to execute when the word is invoked - must take a single param ** pointer to a FICL_VM ** flags -- 0 or more of F_IMMEDIATE, F_COMPILE, use bitwise OR! ** **************************************************************************/ int ficlBuild(FICL_SYSTEM *pSys, char *name, FICL_CODE code, char flags) { #if FICL_MULTITHREAD int err = ficlLockDictionary(TRUE); if (err) return err; #endif /* FICL_MULTITHREAD */ assert(dictCellsAvail(pSys->dp) > sizeof (FICL_WORD) / sizeof (CELL)); dictAppendWord(pSys->dp, name, code, flags); ficlLockDictionary(FALSE); return 0; }
/************************************************************************** f i c l S e t E n v ** Create an environment variable with a one-CELL payload. ficlSetEnvD ** makes one with a two-CELL payload. **************************************************************************/ void ficlSetEnv(FICL_SYSTEM *pSys, char *name, FICL_UNS value) { STRINGINFO si; FICL_WORD *pFW; FICL_DICT *envp = pSys->envp; SI_PSZ(si, name); pFW = dictLookup(envp, si); if (pFW == NULL) { dictAppendWord(envp, name, constantParen, FW_DEFAULT); dictAppendCell(envp, LVALUEtoCELL(value)); } else { pFW->param[0] = LVALUEtoCELL(value); } return; }
void ficlSetEnvD(FICL_SYSTEM *pSys, char *name, FICL_UNS hi, FICL_UNS lo) { FICL_WORD *pFW; STRINGINFO si; FICL_DICT *envp = pSys->envp; SI_PSZ(si, name); pFW = dictLookup(envp, si); if (pFW == NULL) { dictAppendWord(envp, name, twoConstParen, FW_DEFAULT); dictAppendCell(envp, LVALUEtoCELL(lo)); dictAppendCell(envp, LVALUEtoCELL(hi)); } else { pFW->param[0] = LVALUEtoCELL(lo); pFW->param[1] = LVALUEtoCELL(hi); } return; }
/************************************************************************** ** Add float words to a system's dictionary. ** pSys -- Pointer to the FICL sytem to add float words to. **************************************************************************/ void ficlCompileFloat(FICL_SYSTEM *pSys) { FICL_DICT *dp = pSys->dp; assert(dp); #if FICL_WANT_FLOAT dictAppendWord(dp, ">float", ToF, FW_DEFAULT); /* d>f */ dictAppendWord(dp, "f!", Fstore, FW_DEFAULT); dictAppendWord(dp, "f*", Fmul, FW_DEFAULT); dictAppendWord(dp, "f+", Fadd, FW_DEFAULT); dictAppendWord(dp, "f-", Fsub, FW_DEFAULT); dictAppendWord(dp, "f/", Fdiv, FW_DEFAULT); dictAppendWord(dp, "f0<", FzeroLess, FW_DEFAULT); dictAppendWord(dp, "f0=", FzeroEquals, FW_DEFAULT); dictAppendWord(dp, "f<", FisLess, FW_DEFAULT); /* f>d */ dictAppendWord(dp, "f@", Ffetch, FW_DEFAULT); /* falign faligned */ dictAppendWord(dp, "fconstant", Fconstant, FW_DEFAULT); dictAppendWord(dp, "fdepth", Fdepth, FW_DEFAULT); dictAppendWord(dp, "fdrop", Fdrop, FW_DEFAULT); dictAppendWord(dp, "fdup", Fdup, FW_DEFAULT); dictAppendWord(dp, "fliteral", fliteralIm, FW_IMMEDIATE); /* float+ floats floor fmax fmin */ dictAppendWord(dp, "f?dup", FquestionDup, FW_DEFAULT); dictAppendWord(dp, "f=", FisEqual, FW_DEFAULT); dictAppendWord(dp, "f>", FisGreater, FW_DEFAULT); dictAppendWord(dp, "f0>", FzeroGreater, FW_DEFAULT); dictAppendWord(dp, "f2drop", FtwoDrop, FW_DEFAULT); dictAppendWord(dp, "f2dup", FtwoDup, FW_DEFAULT); dictAppendWord(dp, "f2over", FtwoOver, FW_DEFAULT); dictAppendWord(dp, "f2swap", FtwoSwap, FW_DEFAULT); dictAppendWord(dp, "f+!", FplusStore, FW_DEFAULT); dictAppendWord(dp, "f+i", Faddi, FW_DEFAULT); dictAppendWord(dp, "f-i", Fsubi, FW_DEFAULT); dictAppendWord(dp, "f*i", Fmuli, FW_DEFAULT); dictAppendWord(dp, "f/i", Fdivi, FW_DEFAULT); dictAppendWord(dp, "int>float", itof, FW_DEFAULT); dictAppendWord(dp, "float>int", Ftoi, FW_DEFAULT); dictAppendWord(dp, "f.", FDot, FW_DEFAULT); dictAppendWord(dp, "f.s", displayFStack, FW_DEFAULT); dictAppendWord(dp, "fe.", EDot, FW_DEFAULT); dictAppendWord(dp, "fover", Fover, FW_DEFAULT); dictAppendWord(dp, "fnegate", Fnegate, FW_DEFAULT); dictAppendWord(dp, "fpick", Fpick, FW_DEFAULT); dictAppendWord(dp, "froll", Froll, FW_DEFAULT); dictAppendWord(dp, "frot", Frot, FW_DEFAULT); dictAppendWord(dp, "fswap", Fswap, FW_DEFAULT); dictAppendWord(dp, "i-f", isubf, FW_DEFAULT); dictAppendWord(dp, "i/f", idivf, FW_DEFAULT); dictAppendWord(dp, "float>", FFrom, FW_DEFAULT); dictAppendWord(dp, "f-roll", FminusRoll, FW_DEFAULT); dictAppendWord(dp, "f-rot", Fminusrot, FW_DEFAULT); dictAppendWord(dp, "(fliteral)", fliteralParen, FW_COMPILE); ficlSetEnv(pSys, "floating", FICL_FALSE); /* not all required words are present */ ficlSetEnv(pSys, "floating-ext", FICL_FALSE); ficlSetEnv(pSys, "floating-stack", FICL_DEFAULT_STACK); #endif return; }
void ficlCompileFile(FICL_SYSTEM *pSys) { #if FICL_WANT_FILE FICL_DICT *dp = pSys->dp; assert(dp); dictAppendWord(dp, "create-file", ficlCreateFile, FW_DEFAULT); dictAppendWord(dp, "open-file", ficlOpenFile, FW_DEFAULT); dictAppendWord(dp, "close-file", ficlCloseFile, FW_DEFAULT); dictAppendWord(dp, "include-file", ficlIncludeFile, FW_DEFAULT); dictAppendWord(dp, "read-file", ficlReadFile, FW_DEFAULT); dictAppendWord(dp, "read-line", ficlReadLine, FW_DEFAULT); dictAppendWord(dp, "write-file", ficlWriteFile, FW_DEFAULT); dictAppendWord(dp, "write-line", ficlWriteLine, FW_DEFAULT); dictAppendWord(dp, "file-position", ficlFilePosition, FW_DEFAULT); dictAppendWord(dp, "file-size", ficlFileSize, FW_DEFAULT); dictAppendWord(dp, "reposition-file", ficlRepositionFile, FW_DEFAULT); dictAppendWord(dp, "file-status", ficlFileStatus, FW_DEFAULT); dictAppendWord(dp, "flush-file", ficlFlushFile, FW_DEFAULT); dictAppendWord(dp, "delete-file", ficlDeleteFile, FW_DEFAULT); dictAppendWord(dp, "rename-file", ficlRenameFile, FW_DEFAULT); #ifdef FICL_HAVE_FTRUNCATE dictAppendWord(dp, "resize-file", ficlResizeFile, FW_DEFAULT); ficlSetEnv(pSys, "file", FICL_TRUE); ficlSetEnv(pSys, "file-ext", FICL_TRUE); #endif /* FICL_HAVE_FTRUNCATE */ #else &pSys; #endif /* FICL_WANT_FILE */ }
/************************************************************************** f i c l C o m p i l e P l a t f o r m ** Build FreeBSD platform extensions into the system dictionary **************************************************************************/ void ficlCompilePlatform(FICL_SYSTEM *pSys) { FICL_DICT *dp = pSys->dp; assert (dp); dictAppendWord(dp, ".#", displayCellNoPad, FW_DEFAULT); dictAppendWord(dp, "fopen", pfopen, FW_DEFAULT); dictAppendWord(dp, "fclose", pfclose, FW_DEFAULT); dictAppendWord(dp, "fread", pfread, FW_DEFAULT); dictAppendWord(dp, "fload", pfload, FW_DEFAULT); dictAppendWord(dp, "fkey", fkey, FW_DEFAULT); dictAppendWord(dp, "fseek", pfseek, FW_DEFAULT); dictAppendWord(dp, "fwrite", pfwrite, FW_DEFAULT); dictAppendWord(dp, "key", key, FW_DEFAULT); dictAppendWord(dp, "key?", keyQuestion, FW_DEFAULT); dictAppendWord(dp, "ms", ms, FW_DEFAULT); dictAppendWord(dp, "seconds", pseconds, FW_DEFAULT); dictAppendWord(dp, "heap?", freeHeap, FW_DEFAULT); dictAppendWord(dp, "dictthreshold", ficlDictThreshold, FW_DEFAULT); dictAppendWord(dp, "dictincrease", ficlDictIncrease, FW_DEFAULT); dictAppendWord(dp, "setenv", ficlSetenv, FW_DEFAULT); dictAppendWord(dp, "setenv?", ficlSetenvq, FW_DEFAULT); dictAppendWord(dp, "getenv", ficlGetenv, FW_DEFAULT); dictAppendWord(dp, "unsetenv", ficlUnsetenv, FW_DEFAULT); dictAppendWord(dp, "copyin", ficlCopyin, FW_DEFAULT); dictAppendWord(dp, "copyout", ficlCopyout, FW_DEFAULT); dictAppendWord(dp, "findfile", ficlFindfile, FW_DEFAULT); dictAppendWord(dp, "ccall", ficlCcall, FW_DEFAULT); #ifndef TESTMAIN #ifdef __i386__ dictAppendWord(dp, "outb", ficlOutb, FW_DEFAULT); dictAppendWord(dp, "inb", ficlInb, FW_DEFAULT); #endif #ifdef HAVE_PNP dictAppendWord(dp, "pnpdevices",ficlPnpdevices, FW_DEFAULT); dictAppendWord(dp, "pnphandlers",ficlPnphandlers, FW_DEFAULT); #endif #endif #if defined(PC98) ficlSetEnv(pSys, "arch-pc98", FICL_TRUE); #elif defined(__i386__) ficlSetEnv(pSys, "arch-i386", FICL_TRUE); ficlSetEnv(pSys, "arch-ia64", FICL_FALSE); ficlSetEnv(pSys, "arch-powerpc", FICL_FALSE); #elif defined(__ia64__) ficlSetEnv(pSys, "arch-i386", FICL_FALSE); ficlSetEnv(pSys, "arch-ia64", FICL_TRUE); ficlSetEnv(pSys, "arch-powerpc", FICL_FALSE); #elif defined(__powerpc__) ficlSetEnv(pSys, "arch-i386", FICL_FALSE); ficlSetEnv(pSys, "arch-ia64", FICL_FALSE); ficlSetEnv(pSys, "arch-powerpc", FICL_TRUE); #endif return; }
void ficlCompileSearch(FICL_SYSTEM *pSys) { FICL_DICT *dp = pSys->dp; assert (dp); /* ** optional SEARCH-ORDER word set */ dictAppendWord(dp, ">search", searchPush, FW_DEFAULT); dictAppendWord(dp, "search>", searchPop, FW_DEFAULT); dictAppendWord(dp, "definitions", definitions, FW_DEFAULT); dictAppendWord(dp, "forth-wordlist", forthWordlist, FW_DEFAULT); dictAppendWord(dp, "get-current", getCurrent, FW_DEFAULT); dictAppendWord(dp, "get-order", getOrder, FW_DEFAULT); dictAppendWord(dp, "search-wordlist", searchWordlist, FW_DEFAULT); dictAppendWord(dp, "set-current", setCurrent, FW_DEFAULT); dictAppendWord(dp, "set-order", setOrder, FW_DEFAULT); dictAppendWord(dp, "ficl-wordlist", ficlWordlist, FW_DEFAULT); /* ** Set SEARCH environment query values */ ficlSetEnv(pSys, "search-order", FICL_TRUE); ficlSetEnv(pSys, "search-order-ext", FICL_TRUE); ficlSetEnv(pSys, "wordlists", FICL_DEFAULT_VOCS); dictAppendWord(dp, "wid-get-name", widGetName, FW_DEFAULT); dictAppendWord(dp, "wid-set-name", widSetName, FW_DEFAULT); dictAppendWord(dp, "wid-set-super", setParentWid, FW_DEFAULT); return; }
/************************************************************************** f i c l C o m p i l e P l a t f o r m ** Build FreeBSD platform extensions into the system dictionary **************************************************************************/ void ficlCompilePlatform(FICL_SYSTEM *pSys) { ficlCompileFcn **fnpp; FICL_DICT *dp = pSys->dp; assert (dp); dictAppendWord(dp, ".#", displayCellNoPad, FW_DEFAULT); dictAppendWord(dp, "isdir?", isdirQuestion, FW_DEFAULT); dictAppendWord(dp, "fopen", pfopen, FW_DEFAULT); dictAppendWord(dp, "fclose", pfclose, FW_DEFAULT); dictAppendWord(dp, "fread", pfread, FW_DEFAULT); dictAppendWord(dp, "freaddir", pfreaddir, FW_DEFAULT); dictAppendWord(dp, "fload", pfload, FW_DEFAULT); dictAppendWord(dp, "fkey", fkey, FW_DEFAULT); dictAppendWord(dp, "fseek", pfseek, FW_DEFAULT); dictAppendWord(dp, "fwrite", pfwrite, FW_DEFAULT); dictAppendWord(dp, "key", key, FW_DEFAULT); dictAppendWord(dp, "key?", keyQuestion, FW_DEFAULT); dictAppendWord(dp, "ms", ms, FW_DEFAULT); dictAppendWord(dp, "seconds", pseconds, FW_DEFAULT); dictAppendWord(dp, "heap?", freeHeap, FW_DEFAULT); dictAppendWord(dp, "dictthreshold", ficlDictThreshold, FW_DEFAULT); dictAppendWord(dp, "dictincrease", ficlDictIncrease, FW_DEFAULT); dictAppendWord(dp, "setenv", ficlSetenv, FW_DEFAULT); dictAppendWord(dp, "setenv?", ficlSetenvq, FW_DEFAULT); dictAppendWord(dp, "getenv", ficlGetenv, FW_DEFAULT); dictAppendWord(dp, "unsetenv", ficlUnsetenv, FW_DEFAULT); dictAppendWord(dp, "copyin", ficlCopyin, FW_DEFAULT); dictAppendWord(dp, "copyout", ficlCopyout, FW_DEFAULT); dictAppendWord(dp, "findfile", ficlFindfile, FW_DEFAULT); dictAppendWord(dp, "ccall", ficlCcall, FW_DEFAULT); dictAppendWord(dp, "uuid-from-string", ficlUuidFromString, FW_DEFAULT); dictAppendWord(dp, "uuid-to-string", ficlUuidToString, FW_DEFAULT); SET_FOREACH(fnpp, Xficl_compile_set) (*fnpp)(pSys); #if defined(PC98) ficlSetEnv(pSys, "arch-pc98", FICL_TRUE); #elif defined(__i386__) ficlSetEnv(pSys, "arch-i386", FICL_TRUE); ficlSetEnv(pSys, "arch-powerpc", FICL_FALSE); #elif defined(__powerpc__) ficlSetEnv(pSys, "arch-i386", FICL_FALSE); ficlSetEnv(pSys, "arch-powerpc", FICL_TRUE); #endif return; }