static void doplusloop(void)
{
ucell high, low;
cell increment, startval, endval, offset;
increment = POP();
startval = POPR();
endval = POPR();
low = (ucell) startval;
startval += increment;
PC += sizeof(cell);
if (increment >= 0) {
high = (ucell) startval;
} else {
high = low;
low = (ucell) startval;
}
if (endval - (low + 1) >= high - low) {
offset = read_cell(cell2pointer(PC));
PC += offset;
PUSHR(endval);
PUSHR(startval);
}
}
static void dodo(void)
{
cell startval, endval;
startval = POP();
endval = POP();
PUSHR(endval);
PUSHR(startval);
}
static
int printf_console(const char *fmt, ...)
{
cell tmp;
char buf[512];
va_list args;
int i;
va_start(args, fmt);
i = vsnprintf(buf, sizeof(buf), fmt, args);
va_end(args);
/* Push to the Forth interpreter for console output */
tmp = rstackcnt;
PUSH(pointer2cell(buf));
PUSH((int)strlen(buf));
trampoline[1] = findword("type");
PUSHR(PC);
PC = pointer2cell(trampoline);
while (rstackcnt > tmp) {
dbg_interp_printk("printf_console: NEXT\n");
next();
}
return i;
}
static void docol(void)
{ /* DOCOL */
PUSHR(PC);
PC = read_ucell(cell2pointer(PC));
dbg_interp_printk("docol: %s\n", cell2pointer( lfa2nfa(PC - sizeof(cell)) ));
}
static void doloop(void)
{
cell offset, startval, endval;
startval = POPR() + 1;
endval = POPR();
PC += sizeof(cell);
if (startval < endval) {
offset = read_cell(cell2pointer(PC));
PC += offset;
PUSHR(endval);
PUSHR(startval);
}
}
static void doisdo(void)
{
cell startval, endval, offset;
startval = POP();
endval = POP();
PC += sizeof(cell);
if (startval == endval) {
offset = read_cell(cell2pointer(PC));
PC += offset;
} else {
PUSHR(endval);
PUSHR(startval);
}
}
static void tor(void)
{
ucell tmp = POP();
#ifdef CONFIG_DEBUG_RSTACK
printk(" >R: %x\n", tmp);
#endif
PUSHR(tmp);
}
static void execute(void)
{ /* EXECUTE */
ucell address = POP();
dbg_interp_printk("execute: %x\n", address);
PUSHR(PC);
trampoline[1] = target_ucell(address);
PC = pointer2cell(trampoline);
}
static void doidefer(void)
{
ucell *p = (ucell *)(*(ucell *) cell2pointer(PC) + sizeof(ucell));
ucell ibase = get_myself();
dbg_interp_printk("doidefer, offset: %d size: %d\n", p[0], p[1] );
PUSHR(PC);
PC = ibase ? ibase + p[0] : pointer2cell(&p[2]);
PC -= sizeof(ucell);
}
int enterforth(xt_t xt)
{
ucell *_cfa = (ucell*)cell2pointer(xt);
cell tmp;
if (read_ucell(_cfa) != DOCOL) {
trampoline[1] = target_ucell(xt);
_cfa = trampoline;
}
if (rstackcnt < 0) {
rstackcnt = 0;
}
tmp = rstackcnt;
interruptforth = FORTH_INTSTAT_CLR;
PUSHR(PC);
PC = pointer2cell(_cfa);
while (rstackcnt > tmp && !(interruptforth & FORTH_INTSTAT_STOP)) {
if (debug_xt_list->next == NULL) {
while (rstackcnt > tmp && !interruptforth) {
dbg_interp_printk("enterforth: NEXT\n");
next();
}
} else {
while (rstackcnt > tmp && !interruptforth) {
dbg_interp_printk("enterforth: NEXT_DBG\n");
next_dbg();
}
}
/* Always clear the debug mode change flag */
interruptforth = interruptforth & (~FORTH_INTSTAT_DBG);
}
#if 0
/* return true if we took an exception. The caller should normally
* handle exceptions by returning immediately since the throw
* is supposed to abort the execution of this C-code too.
*/
if (rstackcnt != tmp) {
printk("EXCEPTION DETECTED!\n");
}
#endif
return rstackcnt != tmp;
}
static
int getchar_console(void)
{
cell tmp;
/* Push to the Forth interpreter for console output */
tmp = rstackcnt;
trampoline[1] = findword("key");
PUSHR(PC);
PC = pointer2cell(trampoline);
while (rstackcnt > tmp) {
dbg_interp_printk("getchar_console: NEXT\n");
next();
}
return POP();
}
static void docol_dbg(void)
{ /* DOCOL */
struct debug_xt *debug_xt_item;
PUSHR(PC);
PC = read_ucell(cell2pointer(PC));
/* If current xt is in our debug xt list, display word name */
debug_xt_item = debug_xt_list;
while (debug_xt_item->next) {
if (debug_xt_item->xt_docol == PC) {
fstrncpy(xtname, lfa2nfa(PC - sizeof(cell)), MAXNFALEN);
printf_console("\n: %s ", xtname);
/* Step mode is the default */
debug_xt_item->mode = DEBUG_MODE_STEP;
}
debug_xt_item = debug_xt_item->next;
}
dbg_interp_printk("docol_dbg: %s\n", cell2pointer(lfa2nfa(PC - sizeof(cell))));
}
/* Process 2OP Integer instructions */
bool eval_2OP_Int(struct lilith* vm, struct Instruction* c)
{
#ifdef DEBUG
char Name[20] = "ILLEGAL_2OP";
#endif
switch(c->raw_XOP)
{
case 0x0000: /* NEG */
{
#ifdef DEBUG
strncpy(Name, "NEG", 19);
#elif TRACE
record_trace("NEG");
#endif
NEG(vm, c);
break;
}
case 0x0001: /* ABS */
{
#ifdef DEBUG
strncpy(Name, "ABS", 19);
#elif TRACE
record_trace("ABS");
#endif
ABS(vm, c);
break;
}
case 0x0002: /* NABS */
{
#ifdef DEBUG
strncpy(Name, "NABS", 19);
#elif TRACE
record_trace("NABS");
#endif
NABS(vm, c);
break;
}
case 0x0003: /* SWAP */
{
#ifdef DEBUG
strncpy(Name, "SWAP", 19);
#elif TRACE
record_trace("SWAP");
#endif
SWAP(vm, c);
break;
}
case 0x0004: /* COPY */
{
#ifdef DEBUG
strncpy(Name, "COPY", 19);
#elif TRACE
record_trace("COPY");
#endif
COPY(vm, c);
break;
}
case 0x0005: /* MOVE */
{
#ifdef DEBUG
strncpy(Name, "MOVE", 19);
#elif TRACE
record_trace("MOVE");
#endif
MOVE(vm, c);
break;
}
case 0x0006: /* NOT */
{
#ifdef DEBUG
strncpy(Name, "NOT", 19);
#elif TRACE
record_trace("NOT");
#endif
NOT(vm, c);
break;
}
case 0x0100: /* BRANCH */
{
#ifdef DEBUG
strncpy(Name, "BRANCH", 19);
#elif TRACE
record_trace("BRANCH");
#endif
BRANCH(vm, c);
break;
}
case 0x0101: /* CALL */
{
#ifdef DEBUG
strncpy(Name, "CALL", 19);
#elif TRACE
record_trace("CALL");
#endif
CALL(vm, c);
break;
}
case 0x0200: /* PUSHR */
{
#ifdef DEBUG
strncpy(Name, "PUSHR", 19);
#elif TRACE
record_trace("PUSHR");
#endif
PUSHR(vm, c);
break;
}
case 0x0201: /* PUSH8 */
{
#ifdef DEBUG
strncpy(Name, "PUSH8", 19);
#elif TRACE
record_trace("PUSH8");
#endif
PUSH8(vm, c);
break;
}
case 0x0202: /* PUSH16 */
{
#ifdef DEBUG
strncpy(Name, "PUSH16", 19);
#elif TRACE
record_trace("PUSH16");
#endif
PUSH16(vm, c);
break;
}
case 0x0203: /* PUSH32 */
{
#ifdef DEBUG
strncpy(Name, "PUSH32", 19);
#elif TRACE
record_trace("PUSH32");
#endif
PUSH32(vm, c);
break;
}
case 0x0280: /* POPR */
{
#ifdef DEBUG
strncpy(Name, "POPR", 19);
#elif TRACE
record_trace("POPR");
#endif
POPR(vm, c);
break;
}
case 0x0281: /* POP8 */
{
#ifdef DEBUG
strncpy(Name, "POP8", 19);
#elif TRACE
record_trace("POP8");
#endif
POP8(vm, c);
break;
}
case 0x0282: /* POPU8 */
{
#ifdef DEBUG
strncpy(Name, "POPU8", 19);
#elif TRACE
record_trace("POPU8");
#endif
POPU8(vm, c);
break;
}
case 0x0283: /* POP16 */
{
#ifdef DEBUG
strncpy(Name, "POP16", 19);
#elif TRACE
record_trace("POP16");
#endif
POP16(vm, c);
break;
}
case 0x0284: /* POPU16 */
{
#ifdef DEBUG
strncpy(Name, "POPU16", 19);
#elif TRACE
record_trace("POPU16");
#endif
POPU16(vm, c);
break;
}
case 0x0285: /* POP32 */
{
#ifdef DEBUG
strncpy(Name, "POP32", 19);
#elif TRACE
record_trace("POP32");
#endif
POP32(vm, c);
break;
}
case 0x0286: /* POPU32 */
{
#ifdef DEBUG
strncpy(Name, "POPU32", 19);
#elif TRACE
record_trace("POPU32");
#endif
POPU32(vm, c);
break;
}
case 0x0300: /* CMPSKIP.G */
{
#ifdef DEBUG
strncpy(Name, "CMPSKIP.G", 19);
#elif TRACE
record_trace("CMPSKIP.G");
#endif
CMPSKIP_G(vm, c);
break;
}
case 0x0301: /* CMPSKIP.GE */
{
#ifdef DEBUG
strncpy(Name, "CMPSKIP.GE", 19);
#elif TRACE
record_trace("CMPSKIP.GE");
#endif
CMPSKIP_GE(vm, c);
break;
}
case 0x0302: /* CMPSKIP.E */
{
#ifdef DEBUG
strncpy(Name, "CMPSKIP.E", 19);
#elif TRACE
record_trace("CMPSKIP.E");
#endif
CMPSKIP_E(vm, c);
break;
}
case 0x0303: /* CMPSKIP.NE */
{
#ifdef DEBUG
strncpy(Name, "CMPSKIP.NE", 19);
#elif TRACE
record_trace("CMPSKIP.NE");
#endif
CMPSKIP_NE(vm, c);
break;
}
case 0x0304: /* CMPSKIP.LE */
{
#ifdef DEBUG
strncpy(Name, "CMPSKIP.LE", 19);
#elif TRACE
record_trace("CMPSKIP.LE");
#endif
CMPSKIP_LE(vm, c);
break;
}
case 0x0305: /* CMPSKIP.L */
{
#ifdef DEBUG
strncpy(Name, "CMPSKIP.L", 19);
#elif TRACE
record_trace("CMPSKIP.L");
#endif
CMPSKIP_L(vm, c);
break;
}
case 0x0380: /* CMPSKIPU.G */
{
#ifdef DEBUG
strncpy(Name, "CMPSKIPU.G", 19);
#elif TRACE
record_trace("CMPSKIPU.G");
#endif
CMPSKIPU_G(vm, c);
break;
}
case 0x0381: /* CMPSKIPU.GE */
{
#ifdef DEBUG
strncpy(Name, "CMPSKIPU.GE", 19);
#elif TRACE
record_trace("CMPSKIPU.GE");
#endif
CMPSKIPU_GE(vm, c);
break;
}
case 0x0384: /* CMPSKIPU.LE */
{
#ifdef DEBUG
strncpy(Name, "CMPSKIPU.LE", 19);
#elif TRACE
record_trace("CMPSKIPU.LE");
#endif
CMPSKIPU_LE(vm, c);
break;
}
case 0x0385: /* CMPSKIPU.L */
{
#ifdef DEBUG
strncpy(Name, "CMPSKIPU.L", 19);
#elif TRACE
record_trace("CMPSKIPU.L");
#endif
CMPSKIPU_L(vm, c);
break;
}
default:
{
illegal_instruction(vm, c);
break;
}
}
#ifdef DEBUG
fprintf(stdout, "# %s reg%u reg%u\n", Name, c->reg0, c->reg1);
#endif
return false;
}
static void
do_source_dbg(struct debug_xt *debug_xt_item)
{
/* Forth source debugger implementation */
char k, done = 0;
/* Display current dstack */
display_dbg_dstack();
printf_console("\n");
fstrncpy(xtname, lfa2nfa(read_ucell(cell2pointer(PC)) - sizeof(cell)), MAXNFALEN);
printf_console("%p: %s ", cell2pointer(PC), xtname);
/* If in trace mode, we just carry on */
if (debug_xt_item->mode == DEBUG_MODE_TRACE) {
return;
}
/* Otherwise in step mode, prompt for a keypress */
k = getchar_console();
/* Only proceed if done is true */
while (!done) {
switch (k) {
case ' ':
case '\n':
/* Perform a single step */
done = 1;
break;
case 'u':
case 'U':
/* Up - unmark current word for debug, mark its caller for
* debugging and finish executing current word */
/* Since this word could alter the rstack during its execution,
* we only know the caller when (semis) is called for this xt.
* Hence we mark the xt as a special DEBUG_MODE_STEPUP which
* means we run as normal, but schedule the xt for deletion
* at its corresponding (semis) word when we know the rstack
* will be set to its final parent value */
debug_xt_item->mode = DEBUG_MODE_STEPUP;
done = 1;
break;
case 'd':
case 'D':
/* Down - mark current word for debug and step into it */
done = add_debug_xt(read_ucell(cell2pointer(PC)));
if (!done) {
k = getchar_console();
}
break;
case 't':
case 'T':
/* Trace mode */
debug_xt_item->mode = DEBUG_MODE_TRACE;
done = 1;
break;
case 'r':
case 'R':
/* Display rstack */
display_dbg_rstack();
done = 0;
k = getchar_console();
break;
case 'f':
case 'F':
/* Start subordinate Forth interpreter */
PUSHR(PC - sizeof(cell));
PC = findword("outer-interpreter") + sizeof(ucell);
/* Save rstack position for when we return */
dbgrstackcnt = rstackcnt;
done = 1;
break;
default:
/* Display debug banner */
printf_console(DEBUG_BANNER);
k = getchar_console();
}
}
}
