/**************************************************************************
f i c l D e b u g X T
** debug ( xt -- )
** Given an xt of a colon definition or a word defined by DOES>, set the
** VM up to debug the word: push IP, set the xt as the next thing to execute,
** set a breakpoint at its first instruction, and run to the breakpoint.
** Note: the semantics of this word are equivalent to "step in"
**************************************************************************/
void ficlDebugXT(FICL_VM *pVM)
{
FICL_WORD *xt = stackPopPtr(pVM->pStack);
WORDKIND wk = ficlWordClassify(xt);
stackPushPtr(pVM->pStack, xt);
seeXT(pVM);
switch (wk)
{
case COLON:
case DOES:
/*
** Run the colon code and set a breakpoint at the next instruction
*/
vmExecute(pVM, xt);
vmSetBreak(pVM, &(pVM->pSys->bpStep));
break;
default:
vmExecute(pVM, xt);
break;
}
return;
}
/**************************************************************************
f i c l E x e c X T
** Given a pointer to a FICL_WORD, push an inner interpreter and
** execute the word to completion. This is in contrast with vmExecute,
** which does not guarantee that the word will have completed when
** the function returns (ie in the case of colon definitions, which
** need an inner interpreter to finish)
**
** Returns one of the VM_XXXX exception codes listed in ficl.h. Normal
** exit condition is VM_INNEREXIT, ficl's private signal to exit the
** inner loop under normal circumstances. If another code is thrown to
** exit the loop, this function will re-throw it if it's nested under
** itself or ficlExec.
**
** NOTE: this function is intended so that C code can execute ficlWords
** given their address in the dictionary (xt).
**************************************************************************/
int ficlExecXT(FICL_VM *pVM, FICL_WORD *pWord)
{
int except;
jmp_buf vmState;
jmp_buf *oldState;
FICL_WORD *oldRunningWord;
assert(pVM);
assert(pVM->pSys->pExitInner);
/*
** Save the runningword so that RESTART behaves correctly
** over nested calls.
*/
oldRunningWord = pVM->runningWord;
/*
** Save and restore VM's jmp_buf to enable nested calls
*/
oldState = pVM->pState;
pVM->pState = &vmState; /* This has to come before the setjmp! */
except = setjmp(vmState);
if (except)
vmPopIP(pVM);
else
vmPushIP(pVM, &(pVM->pSys->pExitInner));
switch (except)
{
case 0:
vmExecute(pVM, pWord);
vmInnerLoop(pVM);
break;
case VM_INNEREXIT:
case VM_BREAK:
break;
case VM_RESTART:
case VM_OUTOFTEXT:
case VM_USEREXIT:
case VM_QUIT:
case VM_ERREXIT:
case VM_ABORT:
case VM_ABORTQ:
default: /* user defined exit code?? */
if (oldState)
{
pVM->pState = oldState;
vmThrow(pVM, except);
}
break;
}
pVM->pState = oldState;
pVM->runningWord = oldRunningWord;
return (except);
}
/**************************************************************************
f i c l P a r s e P r e f i x
** This is the parse step for prefixes - it checks an incoming word
** to see if it starts with a prefix, and if so runs the corrseponding
** code against the remainder of the word and returns true.
**************************************************************************/
int ficlParsePrefix(FICL_VM *pVM, STRINGINFO si)
{
int i;
FICL_HASH *pHash;
FICL_WORD *pFW = ficlLookup(pVM->pSys, list_name);
/*
** Make sure we found the prefix dictionary - otherwise silently fail
** If forth-wordlist is not in the search order, we won't find the prefixes.
*/
if (!pFW)
return FICL_FALSE;
pHash = (FICL_HASH *)(pFW->param[0].p);
/*
** Walk the list looking for a match with the beginning of the incoming token
*/
for (i = 0; i < (int)pHash->size; i++)
{
pFW = pHash->table[i];
while (pFW != NULL)
{
int n;
n = pFW->nName;
/*
** If we find a match, adjust the TIB to give back the non-prefix characters
** and execute the prefix word.
*/
if (!strincmp(SI_PTR(si), pFW->name, (FICL_UNS)n))
{
/* (sadler) fixed off-by-one error when the token has no trailing space in the TIB */
vmSetTibIndex(pVM, si.cp + n - pVM->tib.cp );
vmExecute(pVM, pFW);
return (int)FICL_TRUE;
}
pFW = pFW->link;
}
}
return FICL_FALSE;
}
