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