Ejemplo n.º 1
0
/**************************************************************************
                        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;
}
Ejemplo n.º 2
0
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;
}
Ejemplo n.º 3
0
/**************************************************************************
                        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;
}
Ejemplo n.º 4
0
/**************************************************************************
                        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;
}
Ejemplo n.º 5
0
/**************************************************************************
                        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;
}
Ejemplo n.º 6
0
/**************************************************************************
                        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;
}
Ejemplo n.º 7
0
/**************************************************************************
                        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;
}
Ejemplo n.º 8
0
/**************************************************************************
                        > 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;
}
Ejemplo n.º 9
0
/**************************************************************************
                        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;
}
Ejemplo n.º 10
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;
}
Ejemplo n.º 11
0
/**************************************************************************
                        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;
}
Ejemplo n.º 12
0
/**************************************************************************
                        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;
}