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