/************************************************************************** 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; }
/* ** Here's the outer part of the decompiler. It's ** just a big nested conditional that checks the ** CFA of the word to decompile for each kind of ** known word-builder code, and tries to do ** something appropriate. If the CFA is not recognized, ** just indicate that it is a primitive. */ static void seeXT(FICL_VM *pVM) { FICL_WORD *pFW; WORDKIND kind; pFW = (FICL_WORD *)stackPopPtr(pVM->pStack); kind = ficlWordClassify(pFW); switch (kind) { case COLON: sprintf(pVM->pad, ": %.*s", pFW->nName, pFW->name); vmTextOut(pVM, pVM->pad, 1); seeColon(pVM, pFW->param); break; case DOES: vmTextOut(pVM, "does>", 1); seeColon(pVM, (CELL *)pFW->param->p); break; case CREATE: vmTextOut(pVM, "create", 1); break; case VARIABLE: sprintf(pVM->pad, "variable = %ld (%#lx)", pFW->param->i, pFW->param->u); vmTextOut(pVM, pVM->pad, 1); break; #if FICL_WANT_USER case USER: sprintf(pVM->pad, "user variable %ld (%#lx)", pFW->param->i, pFW->param->u); vmTextOut(pVM, pVM->pad, 1); break; #endif case CONSTANT: sprintf(pVM->pad, "constant = %ld (%#lx)", pFW->param->i, pFW->param->u); vmTextOut(pVM, pVM->pad, 1); default: sprintf(pVM->pad, "%.*s is a primitive", pFW->nName, pFW->name); vmTextOut(pVM, pVM->pad, 1); break; } if (pFW->flags & FW_IMMEDIATE) { vmTextOut(pVM, "immediate", 1); } if (pFW->flags & FW_COMPILE) { vmTextOut(pVM, "compile-only", 1); } return; }
/* ** seeColon (for proctologists only) ** Walks a colon definition, decompiling ** on the fly. Knows about primitive control structures. */ static void seeColon(FICL_VM *pVM, CELL *pc) { char *cp; CELL *param0 = pc; FICL_DICT *pd = vmGetDict(pVM); FICL_WORD *pSemiParen = ficlLookup(pVM->pSys, "(;)"); assert(pSemiParen); for (; pc->p != pSemiParen; pc++) { FICL_WORD *pFW = (FICL_WORD *)(pc->p); cp = pVM->pad; if ((void *)pc == (void *)pVM->ip) *cp++ = '>'; else *cp++ = ' '; cp += sprintf(cp, "%3d ", pc-param0); if (isAFiclWord(pd, pFW)) { WORDKIND kind = ficlWordClassify(pFW); CELL c; switch (kind) { case LITERAL: c = *++pc; if (isAFiclWord(pd, c.p)) { FICL_WORD *pLit = (FICL_WORD *)c.p; sprintf(cp, "%.*s ( %#lx literal )", pLit->nName, pLit->name, (unsigned long)c.u); } else sprintf(cp, "literal %ld (%#lx)", (long)c.i, (unsigned long)c.u); break; case STRINGLIT: { FICL_STRING *sp = (FICL_STRING *)(void *)++pc; pc = (CELL *)alignPtr(sp->text + sp->count + 1) - 1; sprintf(cp, "s\" %.*s\"", sp->count, sp->text); } break; case CSTRINGLIT: { FICL_STRING *sp = (FICL_STRING *)(void *)++pc; pc = (CELL *)alignPtr(sp->text + sp->count + 1) - 1; sprintf(cp, "c\" %.*s\"", sp->count, sp->text); } break; case IF: c = *++pc; if (c.i > 0) sprintf(cp, "if / while (branch %d)", pc+c.i-param0); else sprintf(cp, "until (branch %d)", pc+c.i-param0); break; case BRANCH: c = *++pc; if (c.i == 0) sprintf(cp, "repeat (branch %d)", pc+c.i-param0); else if (c.i == 1) sprintf(cp, "else (branch %d)", pc+c.i-param0); else sprintf(cp, "endof (branch %d)", pc+c.i-param0); break; case OF: c = *++pc; sprintf(cp, "of (branch %d)", pc+c.i-param0); break; case QDO: c = *++pc; sprintf(cp, "?do (leave %d)", (CELL *)c.p-param0); break; case DO: c = *++pc; sprintf(cp, "do (leave %d)", (CELL *)c.p-param0); break; case LOOP: c = *++pc; sprintf(cp, "loop (branch %d)", pc+c.i-param0); break; case PLOOP: c = *++pc; sprintf(cp, "+loop (branch %d)", pc+c.i-param0); break; default: sprintf(cp, "%.*s", pFW->nName, pFW->name); break; } } else /* probably not a word - punt and print value */ { sprintf(cp, "%ld ( %#lx )", (long)pc->i, (unsigned long)pc->u); } vmTextOut(pVM, pVM->pad, 1); } vmTextOut(pVM, ";", 1); }
static int isPrimitive(FICL_WORD *pFW) { WORDKIND wk = ficlWordClassify(pFW); return ((wk != COLON) && (wk != DOES)); }
void ficlDictionarySee(ficlDictionary *dictionary, ficlWord *word, ficlCallback *callback) { char *trace; ficlCell *cell = word->param; ficlCell *param0 = cell; char buffer[128]; for (; cell->i != ficlInstructionSemiParen; cell++) { ficlWord *word = (ficlWord *)(cell->p); trace = buffer; if ((void *)cell == (void *)buffer) *trace++ = '>'; else *trace++ = ' '; trace += sprintf(trace, "%3ld ", (long)(cell - param0)); if (ficlDictionaryIsAWord(dictionary, word)) { ficlWordKind kind = ficlWordClassify(word); ficlCell c, c2; switch (kind) { case FICL_WORDKIND_INSTRUCTION: (void) sprintf(trace, "%s (instruction %ld)", ficlDictionaryInstructionNames[(long)word], (long)word); break; case FICL_WORDKIND_INSTRUCTION_WITH_ARGUMENT: c = *++cell; (void) sprintf(trace, "%s (instruction %ld), " "with argument %ld (%#lx)", ficlDictionaryInstructionNames[(long)word], (long)word, (long)c.i, (unsigned long)c.u); break; case FICL_WORDKIND_INSTRUCTION_WORD: (void) sprintf(trace, "%s :: executes %s (instruction word %ld)", word->name, ficlDictionaryInstructionNames[ (long)word->code], (long)word->code); break; case FICL_WORDKIND_LITERAL: c = *++cell; if (ficlDictionaryIsAWord(dictionary, c.p) && (c.i >= ficlInstructionLast)) { ficlWord *word = (ficlWord *)c.p; (void) sprintf(trace, "%.*s ( %#lx literal )", word->length, word->name, (unsigned long)c.u); } else (void) sprintf(trace, "literal %ld (%#lx)", (long)c.i, (unsigned long)c.u); break; case FICL_WORDKIND_2LITERAL: c = *++cell; c2 = *++cell; (void) sprintf(trace, "2literal %ld %ld (%#lx %#lx)", (long)c2.i, (long)c.i, (unsigned long)c2.u, (unsigned long)c.u); break; #if FICL_WANT_FLOAT case FICL_WORDKIND_FLITERAL: c = *++cell; (void) sprintf(trace, "fliteral %f (%#lx)", (double)c.f, (unsigned long)c.u); break; #endif /* FICL_WANT_FLOAT */ case FICL_WORDKIND_STRING_LITERAL: { ficlCountedString *counted; counted = (ficlCountedString *)(void *)++cell; cell = (ficlCell *) ficlAlignPointer(counted->text + counted->length + 1) - 1; (void) sprintf(trace, "s\" %.*s\"", counted->length, counted->text); } break; case FICL_WORDKIND_CSTRING_LITERAL: { ficlCountedString *counted; counted = (ficlCountedString *)(void *)++cell; cell = (ficlCell *) ficlAlignPointer(counted->text + counted->length + 1) - 1; (void) sprintf(trace, "c\" %.*s\"", counted->length, counted->text); } break; case FICL_WORDKIND_BRANCH0: c = *++cell; (void) sprintf(trace, "branch0 %ld", (long)(cell + c.i - param0)); break; case FICL_WORDKIND_BRANCH: c = *++cell; (void) sprintf(trace, "branch %ld", (long)(cell + c.i - param0)); break; case FICL_WORDKIND_QDO: c = *++cell; (void) sprintf(trace, "?do (leave %ld)", (long)((ficlCell *)c.p - param0)); break; case FICL_WORDKIND_DO: c = *++cell; (void) sprintf(trace, "do (leave %ld)", (long)((ficlCell *)c.p - param0)); break; case FICL_WORDKIND_LOOP: c = *++cell; (void) sprintf(trace, "loop (branch %ld)", (long)(cell + c.i - param0)); break; case FICL_WORDKIND_OF: c = *++cell; (void) sprintf(trace, "of (branch %ld)", (long)(cell + c.i - param0)); break; case FICL_WORDKIND_PLOOP: c = *++cell; (void) sprintf(trace, "+loop (branch %ld)", (long)(cell + c.i - param0)); break; default: (void) sprintf(trace, "%.*s", word->length, word->name); break; } } else { /* probably not a word - punt and print value */ (void) sprintf(trace, "%ld ( %#lx )", (long)cell->i, (unsigned long)cell->u); } ficlCallbackTextOut(callback, buffer); ficlCallbackTextOut(callback, "\n"); } ficlCallbackTextOut(callback, ";\n"); }