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 void docol(void) { /* DOCOL */ PUSHR(PC); PC = read_ucell(cell2pointer(PC)); dbg_interp_printk("docol: %s\n", cell2pointer( lfa2nfa(PC - sizeof(cell)) )); }
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 inline void next_dbg(void) { struct debug_xt *debug_xt_item; void (*tokenp) (void); PC += sizeof(ucell); /* If the PC lies within a debug range, run the source debugger */ debug_xt_item = debug_xt_list; while (debug_xt_item->next) { if (PC >= debug_xt_item->xt_docol && PC <= debug_xt_item->xt_semis && debug_xt_item->mode != DEBUG_MODE_STEPUP) { do_source_dbg(debug_xt_item); } debug_xt_item = debug_xt_item->next; } dbg_interp_printk("next_dbg: PC is now %x\n", PC); /* Intercept DOCOL and SEMIS and redirect to debug versions */ if (read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))) == DOCOL) { tokenp = docol_dbg; tokenp(); } else if (read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))) == DOSEMIS) { tokenp = semis_dbg; tokenp(); } else { /* Otherwise process as normal */ processxt(read_ucell(cell2pointer(read_ucell(cell2pointer(PC))))); } }
static inline void next(void) { PC += sizeof(ucell); dbg_interp_printk("next: PC is now %x\n", PC); processxt(read_ucell(cell2pointer(read_ucell(cell2pointer(PC))))); }
static inline void processxt(ucell xt) { void (*tokenp) (void); dbg_interp_printk("processxt: pc=%x, xt=%x\n", PC, xt); tokenp = words[xt]; tokenp(); }
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 doival(void) { ucell r, *p = (ucell *)(*(ucell *) PC + sizeof(ucell)); ucell ibase = get_myself(); dbg_interp_printk("ivar, offset: %d size: %d\n", p[0], p[1] ); r = ibase ? ibase + p[0] : (ucell)&p[2]; PUSH( *(ucell *)r ); }
static void doival(void) { ucell r, *p = (ucell *)(*(ucell *) cell2pointer(PC) + sizeof(ucell)); ucell ibase = get_myself(); dbg_interp_printk("ivar, offset: %d size: %d\n", p[0], p[1] ); r = ibase ? ibase + p[0] : pointer2cell(&p[2]); PUSH( *(ucell *)cell2pointer(r) ); }
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); }
/* * call ( ... function-ptr -- ??? ) */ static void call(void) { #ifdef FCOMPILER printk("Sorry. Usage of Forth2C binding is forbidden during bootstrap.\n"); exit(1); #else void (*funcptr) (void); funcptr=(void *)cell2pointer(POP()); dbg_interp_printk("call: %x", funcptr); funcptr(); #endif }
static void dodoes(void) { /* DODOES */ ucell data = read_ucell(cell2pointer(PC)) + (2 * sizeof(ucell)); ucell word = read_ucell(cell2pointer(read_ucell(cell2pointer(PC)) + sizeof(ucell))); dbg_interp_printk("DODOES data=%x word=%x\n", data, word); PUSH(data); PUSH(word); execute(); }
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)))); }
/* called inline thus a slightly different behaviour */ static void lit(void) { /* LIT */ PC += sizeof(cell); PUSH(read_ucell(cell2pointer(PC))); dbg_interp_printk("lit: %x\n", read_ucell(cell2pointer(PC))); }
static void docon(void) { /* DOCON */ ucell tmp = read_ucell(cell2pointer(read_ucell(cell2pointer(PC)) + sizeof(ucell))); PUSH(tmp); dbg_interp_printk("docon: PC=%x, value=%x\n", PC, tmp); }
static void dovar(void) { /* DOVAR */ ucell tmp = read_ucell(cell2pointer(PC)) + sizeof(ucell); PUSH(tmp); /* returns address to variable */ dbg_interp_printk("dovar: PC: %x, %x\n", PC, tmp); }