/************************************************************************** g e t - c u r r e n t ** SEARCH ( -- wid ) ** Return wid, the identifier of the compilation word list. **************************************************************************/ static void getCurrent(FICL_VM *pVM) { ficlLockDictionary(TRUE); stackPushPtr(pVM->pStack, vmGetDict(pVM)->pCompile); ficlLockDictionary(FALSE); return; }
FICL_WORD *ficlLookupLoc(FICL_SYSTEM *pSys, STRINGINFO si) { FICL_WORD *pFW = NULL; FICL_DICT *pDict = pSys->dp; FICL_HASH *pHash = ficlGetLoc(pSys)->pForthWords; int i; UNS16 hashCode = hashHashCode(si); assert(pHash); assert(pDict); ficlLockDictionary(1); /* ** check the locals dict first... */ pFW = hashLookup(pHash, si, hashCode); /* ** If no joy, (!pFW) --------------------------v ** iterate over the search list in the main dict */ for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i) { pHash = pDict->pSearch[i]; pFW = hashLookup(pHash, si, hashCode); } ficlLockDictionary(0); return pFW; }
/************************************************************************** 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; }
/************************************************************************** s e a r c h - w o r d l i s t ** SEARCH ( c-addr u wid -- 0 | xt 1 | xt -1 ) ** Find the definition identified by the string c-addr u in the word list ** identified by wid. If the definition is not found, return zero. If the ** definition is found, return its execution token xt and one (1) if the ** definition is immediate, minus-one (-1) otherwise. **************************************************************************/ static void searchWordlist(FICL_VM *pVM) { STRINGINFO si; UNS16 hashCode; FICL_WORD *pFW; FICL_HASH *pHash = stackPopPtr(pVM->pStack); si.count = (FICL_COUNT)stackPopUNS(pVM->pStack); si.cp = stackPopPtr(pVM->pStack); hashCode = hashHashCode(si); ficlLockDictionary(TRUE); pFW = hashLookup(pHash, si, hashCode); ficlLockDictionary(FALSE); if (pFW) { stackPushPtr(pVM->pStack, pFW); stackPushINT(pVM->pStack, (wordIsImmediate(pFW) ? 1 : -1)); } else { stackPushUNS(pVM->pStack, 0); } return; }
/************************************************************************** d i c t A p p e n d W o r d 2 ** Create a new word in the dictionary with the specified ** STRINGINFO, code, and flags. Does not require a NULL-terminated ** name. **************************************************************************/ FICL_WORD *dictAppendWord2(FICL_DICT *pDict, STRINGINFO si, FICL_CODE pCode, UNS8 flags) { FICL_COUNT len = (FICL_COUNT)SI_COUNT(si); char *pName; FICL_WORD *pFW; ficlLockDictionary(TRUE); /* ** NOTE: dictCopyName advances "here" as a side-effect. ** It must execute before pFW is initialized. */ pName = dictCopyName(pDict, si); pFW = (FICL_WORD *)pDict->here; pDict->smudge = pFW; pFW->hash = hashHashCode(si); pFW->code = pCode; pFW->flags = (UNS8)(flags | FW_SMUDGE); pFW->nName = (char)len; pFW->name = pName; /* ** Point "here" to first cell of new word's param area... */ pDict->here = pFW->param; if (!(flags & FW_SMUDGE)) dictUnsmudge(pDict); ficlLockDictionary(FALSE); return pFW; }
/************************************************************************** s e t - c u r r e n t ** SEARCH ( wid -- ) ** Set the compilation word list to the word list identified by wid. **************************************************************************/ static void setCurrent(FICL_VM *pVM) { FICL_HASH *pHash = stackPopPtr(pVM->pStack); FICL_DICT *pDict = vmGetDict(pVM); ficlLockDictionary(TRUE); pDict->pCompile = pHash; ficlLockDictionary(FALSE); return; }
/************************************************************************** d i c t A b o r t D e f i n i t i o n ** Abort a definition in process: reclaim its memory and unlink it ** from the dictionary list. Assumes that there is a smudged ** definition in process...otherwise does nothing. ** NOTE: this function is not smart enough to unlink a word that ** has been successfully defined (ie linked into a hash). It ** only works for defs in process. If the def has been unsmudged, ** nothing happens. **************************************************************************/ void dictAbortDefinition(FICL_DICT *pDict) { FICL_WORD *pFW; ficlLockDictionary(TRUE); pFW = pDict->smudge; if (pFW->flags & FW_SMUDGE) pDict->here = (CELL *)pFW->name; ficlLockDictionary(FALSE); return; }
/************************************************************************** > S E A R C H ** ficl ( wid -- ) ** Push wid onto the search order. Error if the search order is full. **************************************************************************/ static void searchPush(FICL_VM *pVM) { FICL_DICT *dp = vmGetDict(pVM); ficlLockDictionary(TRUE); if (dp->nLists > FICL_DEFAULT_VOCS) { vmThrowErr(pVM, ">search error: search order overflow"); } dp->pSearch[dp->nLists++] = stackPopPtr(pVM->pStack); ficlLockDictionary(FALSE); 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; }
/************************************************************************** S E A R C H > ** ficl ( -- wid ) ** Pop wid off the search order. Error if the search order is empty **************************************************************************/ static void searchPop(FICL_VM *pVM) { FICL_DICT *dp = vmGetDict(pVM); int nLists; ficlLockDictionary(TRUE); nLists = dp->nLists; if (nLists == 0) { vmThrowErr(pVM, "search> error: empty search order"); } stackPushPtr(pVM->pStack, dp->pSearch[--dp->nLists]); ficlLockDictionary(FALSE); return; }
/************************************************************************** g e t - o r d e r ** SEARCH ( -- widn ... wid1 n ) ** Returns the number of word lists n in the search order and the word list ** identifiers widn ... wid1 identifying these word lists. wid1 identifies ** the word list that is searched first, and widn the word list that is ** searched last. The search order is unaffected. **************************************************************************/ static void getOrder(FICL_VM *pVM) { FICL_DICT *pDict = vmGetDict(pVM); int nLists = pDict->nLists; int i; ficlLockDictionary(TRUE); for (i = 0; i < nLists; i++) { stackPushPtr(pVM->pStack, pDict->pSearch[i]); } stackPushUNS(pVM->pStack, nLists); ficlLockDictionary(FALSE); return; }
/************************************************************************** d i c t L o o k u p ** Find the FICL_WORD that matches the given name and length. ** If found, returns the word's address. Otherwise returns NULL. ** Uses the search order list to search multiple wordlists. **************************************************************************/ FICL_WORD *dictLookup(FICL_DICT *pDict, STRINGINFO si) { FICL_WORD *pFW = NULL; FICL_HASH *pHash; int i; UNS16 hashCode = hashHashCode(si); assert(pDict); ficlLockDictionary(1); for (i = (int)pDict->nLists - 1; (i >= 0) && (!pFW); --i) { pHash = pDict->pSearch[i]; pFW = hashLookup(pHash, si, hashCode); } ficlLockDictionary(0); return pFW; }