/**************************************************************************
W I D - G E T - N A M E
** ficl ( wid -- c-addr u )
** Get wid's (optional) name and push onto stack as a counted string
**************************************************************************/
static void widGetName(FICL_VM *pVM)
{
FICL_HASH *pHash = vmPop(pVM).p;
char *cp = pHash->name;
FICL_INT len = 0;
if (cp)
len = strlen(cp);
vmPush(pVM, LVALUEtoCELL(cp));
vmPush(pVM, LVALUEtoCELL(len));
return;
}
/*
** 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);
}
/*******************************************************************
** Compile a floating point literal.
*******************************************************************/
static void fliteralIm(FICL_VM *pVM)
{
FICL_DICT *dp = vmGetDict(pVM);
FICL_WORD *pfLitParen = ficlLookup(pVM->pSys, "(fliteral)");
#if FICL_ROBUST > 1
vmCheckFStack(pVM, 1, 0);
#endif
dictAppendCell(dp, LVALUEtoCELL(pfLitParen));
dictAppendCell(dp, stackPop(pVM->fStack));
}
/**************************************************************************
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;
}
/**************************************************************************
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;
}
void stackPushFloat(FICL_STACK *pStack, FICL_FLOAT f)
{
*pStack->sp++ = LVALUEtoCELL(f);
}
void stackPushINT(FICL_STACK *pStack, FICL_INT i)
{
*pStack->sp++ = LVALUEtoCELL(i);
}
void stackPushUNS(FICL_STACK *pStack, FICL_UNS u)
{
*pStack->sp++ = LVALUEtoCELL(u);
}
void stackPushPtr(FICL_STACK *pStack, void *ptr)
{
*pStack->sp++ = LVALUEtoCELL(ptr);
}
/**************************************************************************
d i c t A p p e n d U N S
** Append the specified FICL_UNS to the dictionary
**************************************************************************/
void dictAppendUNS(FICL_DICT *pDict, FICL_UNS u)
{
*pDict->here++ = LVALUEtoCELL(u);
return;
}