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