/**************************************************************************
d i c t C h e c k
** Checks the dictionary for corruption and throws appropriate
** errors.
** Input: +n number of ADDRESS UNITS (not Cells) proposed to allot
** -n number of ADDRESS UNITS proposed to de-allot
** 0 just do a consistency check
**************************************************************************/
void dictCheck(FICL_DICT *pDict, FICL_VM *pVM, int n)
{
if ((n >= 0) && (dictCellsAvail(pDict) * (int)sizeof(CELL) < n))
{
vmThrowErr(pVM, "Error: dictionary full");
}
if ((n <= 0) && (dictCellsUsed(pDict) * (int)sizeof(CELL) < -n))
{
vmThrowErr(pVM, "Error: dictionary underflow");
}
if (pDict->nLists > FICL_DEFAULT_VOCS)
{
dictResetSearchOrder(pDict);
vmThrowErr(pVM, "Error: search order overflow");
}
else if (pDict->nLists < 0)
{
dictResetSearchOrder(pDict);
vmThrowErr(pVM, "Error: search order underflow");
}
return;
}
/**************************************************************************
s e t - o r d e r
** SEARCH ( widn ... wid1 n -- )
** Set the search order to the word lists identified by widn ... wid1.
** Subsequently, word list wid1 will be searched first, and word list
** widn searched last. If n is zero, empty the search order. If n is minus
** one, set the search order to the implementation-defined minimum
** search order. The minimum search order shall include the words
** FORTH-WORDLIST and SET-ORDER. A system shall allow n to
** be at least eight.
**************************************************************************/
static void setOrder(FICL_VM *pVM)
{
int i;
int nLists = stackPopINT(pVM->pStack);
FICL_DICT *dp = vmGetDict(pVM);
if (nLists > FICL_DEFAULT_VOCS)
{
vmThrowErr(pVM, "set-order error: list would be too large");
}
ficlLockDictionary(TRUE);
if (nLists >= 0)
{
dp->nLists = nLists;
for (i = nLists-1; i >= 0; --i)
{
dp->pSearch[i] = stackPopPtr(pVM->pStack);
}
}
else
{
dictResetSearchOrder(dp);
}
ficlLockDictionary(FALSE);
return;
}
/**************************************************************************
d i c t E m p t y
** Empty the dictionary, reset its hash table, and reset its search order.
** Clears and (re-)creates the hash table with the size specified by nHash.
**************************************************************************/
void dictEmpty(FICL_DICT *pDict, unsigned nHash)
{
FICL_HASH *pHash;
pDict->here = pDict->dict;
dictAlign(pDict);
pHash = (FICL_HASH *)pDict->here;
dictAllot(pDict,
sizeof (FICL_HASH) + (nHash - 1) * sizeof (FICL_WORD *));
pHash->size = nHash;
hashReset(pHash);
pDict->pForthWords = pHash;
pDict->smudge = NULL;
dictResetSearchOrder(pDict);
return;
}
int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
{
FICL_SYSTEM *pSys = pVM->pSys;
FICL_DICT *dp = pSys->dp;
int except;
jmp_buf vmState;
jmp_buf *oldState;
TIB saveTib;
assert(pVM);
assert(pSys->pInterp[0]);
if (size < 0)
size = strlen(pText);
vmPushTib(pVM, pText, size, &saveTib);
/*
** Save and restore VM's jmp_buf to enable nested calls to ficlExec
*/
oldState = pVM->pState;
pVM->pState = &vmState; /* This has to come before the setjmp! */
except = setjmp(vmState);
switch (except)
{
case 0:
if (pVM->fRestart)
{
pVM->runningWord->code(pVM);
pVM->fRestart = 0;
}
else
{ /* set VM up to interpret text */
vmPushIP(pVM, &(pSys->pInterp[0]));
}
vmInnerLoop(pVM);
break;
case VM_RESTART:
pVM->fRestart = 1;
except = VM_OUTOFTEXT;
break;
case VM_OUTOFTEXT:
vmPopIP(pVM);
#ifdef TESTMAIN
if ((pVM->state != COMPILE) && (pVM->sourceID.i == 0))
ficlTextOut(pVM, FICL_PROMPT, 0);
#endif
break;
case VM_USEREXIT:
case VM_INNEREXIT:
case VM_BREAK:
break;
case VM_QUIT:
if (pVM->state == COMPILE)
{
dictAbortDefinition(dp);
#if FICL_WANT_LOCALS
dictEmpty(pSys->localp, pSys->localp->pForthWords->size);
#endif
}
vmQuit(pVM);
break;
case VM_ERREXIT:
case VM_ABORT:
case VM_ABORTQ:
default: /* user defined exit code?? */
if (pVM->state == COMPILE)
{
dictAbortDefinition(dp);
#if FICL_WANT_LOCALS
dictEmpty(pSys->localp, pSys->localp->pForthWords->size);
#endif
}
dictResetSearchOrder(dp);
vmReset(pVM);
break;
}
pVM->pState = oldState;
vmPopTib(pVM, &saveTib);
return (except);
}
