Author: blueswirl Date: 2009-11-15 22:03:51 +0100 (Sun, 15 Nov 2009) New Revision: 611
Modified: trunk/openbios-devel/arch/unix/gui_qt/gui-qt.cpp trunk/openbios-devel/arch/unix/plugins/plugin_qt/plugin_qt.cpp trunk/openbios-devel/forth/bootstrap/interpreter.fs trunk/openbios-devel/forth/debugging/firmware.fs trunk/openbios-devel/forth/lib/vocabulary.fs trunk/openbios-devel/include/openbios/kernel.h trunk/openbios-devel/include/openbios/stack.h trunk/openbios-devel/kernel/bootstrap.c trunk/openbios-devel/kernel/dict.c trunk/openbios-devel/kernel/include/dict.h trunk/openbios-devel/kernel/internal.c trunk/openbios-devel/kernel/primitives.c trunk/openbios-devel/kernel/stack.c trunk/openbios-devel/modules/cmdline.c Log: Reworked version of Forth Source debugger (Mark Cave-Ayland)
This patch implements the following Forth words:
debug <xt> - Mark word for debugging debug-off - Unmark all words for debugging resume - Return from subordinate Forth interpreter
The source debugger also implements the following commands when it has been activated:
Up - Unmark current word for debugging, mark parent and continue Down - Mark next word for debugging Trace - Continue execution until end of word displaying debug information Rstack - Display contents of the Rstack Forth - Launch subordinate Forth interpreter
Signed-off-by: Blue Swirl blauwirbel@gmail.com
Modified: trunk/openbios-devel/arch/unix/gui_qt/gui-qt.cpp =================================================================== --- trunk/openbios-devel/arch/unix/gui_qt/gui-qt.cpp 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/arch/unix/gui_qt/gui-qt.cpp 2009-11-15 21:03:51 UTC (rev 611) @@ -108,7 +108,7 @@ extern volatile int runforth;
gui_running=0; - runforth=0; + interruptforth=1;
qApp->quit(); }
Modified: trunk/openbios-devel/arch/unix/plugins/plugin_qt/plugin_qt.cpp =================================================================== --- trunk/openbios-devel/arch/unix/plugins/plugin_qt/plugin_qt.cpp 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/arch/unix/plugins/plugin_qt/plugin_qt.cpp 2009-11-15 21:03:51 UTC (rev 611) @@ -105,10 +105,10 @@ void FrameBufferWidget::quit() { extern volatile int gui_running; - extern volatile int runforth; + extern volatile int interruptforth;
gui_running=0; - runforth=0; + interruptforth=1;
qApp->quit(); }
Modified: trunk/openbios-devel/forth/bootstrap/interpreter.fs =================================================================== --- trunk/openbios-devel/forth/bootstrap/interpreter.fs 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/forth/bootstrap/interpreter.fs 2009-11-15 21:03:51 UTC (rev 611) @@ -12,6 +12,7 @@ \
0 value interactive? +0 value terminate?
: exit? interactive? 0= if @@ -122,7 +123,8 @@ refill
['] interpret catch print-status - again + terminate? + until ; ['] outer-interpreter (to)
\
Modified: trunk/openbios-devel/forth/debugging/firmware.fs =================================================================== --- trunk/openbios-devel/forth/debugging/firmware.fs 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/forth/debugging/firmware.fs 2009-11-15 21:03:51 UTC (rev 611) @@ -62,13 +62,18 @@
\ 7.5.3.4 Forth source-level debugger - + : debug ( "old-name< >" -- ) + parse-word \ Look up word CFA in dictionary + $find + 0 = if + ." could not locate word for debugging" + 2drop + else + (debug + then ;
-: (debug ( xt -- ) - ; - : stepping ( -- ) ;
@@ -76,7 +81,10 @@ ;
: debug-off ( -- ) + (debug-off) ;
: resume ( -- ) + \ Set interpreter termination flag + 1 to terminate? ;
Modified: trunk/openbios-devel/forth/lib/vocabulary.fs =================================================================== --- trunk/openbios-devel/forth/lib/vocabulary.fs 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/forth/lib/vocabulary.fs 2009-11-15 21:03:51 UTC (rev 611) @@ -62,9 +62,9 @@ \ which new definitions will be placed. cr get-order 0 ?do - ." wordlist " i (.) type 2e emit space . cr + ." wordlist " i (.) type 2e emit space u. cr loop - cr ." definitions: " current @ . cr + cr ." definitions: " current @ u. cr ;
Modified: trunk/openbios-devel/include/openbios/kernel.h =================================================================== --- trunk/openbios-devel/include/openbios/kernel.h 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/include/openbios/kernel.h 2009-11-15 21:03:51 UTC (rev 611) @@ -21,7 +21,12 @@ #include "openbios/stack.h" #include "asm/io.h"
-extern volatile int runforth; +/* Interrupt status */ +#define FORTH_INTSTAT_CLR 0x0 +#define FORTH_INTSTAT_STOP 0x1 +#define FORTH_INTSTAT_DBG 0x2 + +extern volatile int interruptforth; extern int enterforth( xt_t xt ); extern void panic(const char *error) __attribute__ ((noreturn));
Modified: trunk/openbios-devel/include/openbios/stack.h =================================================================== --- trunk/openbios-devel/include/openbios/stack.h 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/include/openbios/stack.h 2009-11-15 21:03:51 UTC (rev 611) @@ -18,6 +18,8 @@ extern int rstackcnt; extern cell rstack[rstacksize];
+extern int dbgrstackcnt; + //typedef struct opaque_xt *xt_t; //typedef struct opaque_ihandle *ihandle_t; //typedef struct opaque_phandle *phandle_t;
Modified: trunk/openbios-devel/kernel/bootstrap.c =================================================================== --- trunk/openbios-devel/kernel/bootstrap.c 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/kernel/bootstrap.c 2009-11-15 21:03:51 UTC (rev 611) @@ -78,7 +78,7 @@ "here", "here!", "dobranch", "do?branch", "unaligned-w@", "unaligned-w!", "unaligned-l@", "unaligned-l!", "ioc@", "iow@", "iol@", "ioc!", "iow!", "iol!", "i", "j", "call", "sys-debug", - "$include", "$encode-file" + "$include", "$encode-file", "(debug", "(debug-off)" };
static void init_trampoline(void) @@ -743,7 +743,7 @@ { int tmp; if( cursrc < 1 ) { - runforth = 0; + interruptforth |= FORTH_INTSTAT_STOP; /* return -1 in order to exit the loop in key() */ return -1; } @@ -763,7 +763,7 @@ int tmp;
if( cursrc < 1 ) { - runforth = 0; + interruptforth |= FORTH_INTSTAT_STOP; return 0; }
@@ -909,7 +909,7 @@ if (verbose) printk("Jumping to dictionary...");
- runforth=-1; + interruptforth = 1; enterforth((xt_t)PC); }
Modified: trunk/openbios-devel/kernel/dict.c =================================================================== --- trunk/openbios-devel/kernel/dict.c 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/kernel/dict.c 2009-11-15 21:03:51 UTC (rev 611) @@ -50,7 +50,7 @@
/* fstrlen - returns length of a forth string. */
-static ucell fstrlen(ucell fstr) +ucell fstrlen(ucell fstr) { fstr -= pointer2cell(dict)+1; //fstr -= pointer2cell(dict); FIXME @@ -78,6 +78,18 @@ return 0; }
+/* fstrncpy - copy a forth string to a destination (with NULL termination) */ + +void fstrncpy(char *dest, ucell src, unsigned int maxlen) +{ + int len = fstrlen(src); + + if (fstrlen(src) >= maxlen) len = maxlen - 1; + memcpy(dest, cell2pointer(src), len); + *(dest + len) = '\0'; +} + + /* findword * looks up a given word in the dictionary. This function * is used by the c based interpreter and to find the "initialize" @@ -109,6 +121,131 @@ }
+/* findsemis_wordlist + * Given a DOCOL xt and a wordlist, find the address of the semis + * word at the end of the word definition. We do this by finding + * the word before this in the dictionary, then counting back one + * from the NFA. + */ + +ucell findsemis_wordlist(ucell xt, ucell wordlist) +{ + ucell tmplfa, nextlfa, nextcfa; + + if (!wordlist) + return 0; + + tmplfa = read_ucell(cell2pointer(wordlist)); + nextcfa = lfa2cfa(tmplfa); + + /* Catch the special case where the lfa of the word we + * want is the last word in the dictionary; in that case + * the end of the word is given by "here" - 1 */ + if (nextcfa == xt) + return pointer2cell(dict) + dicthead - sizeof(cell); + + while (tmplfa) { + + /* Peek ahead and see if the next CFA in the list is the + * one we are searching for */ + nextlfa = read_ucell(cell2pointer(tmplfa)); + nextcfa = lfa2cfa(nextlfa); + + /* If so, count back 1 cell from the current NFA */ + if (nextcfa == xt) + return lfa2nfa(tmplfa) - sizeof(cell); + + tmplfa = nextlfa; + } + + return 0; +} + + +/* findsemis + * Given a DOCOL xt, find the address of the semis word at the end + * of the word definition by searching all vocabularies */ + +ucell findsemis(ucell xt) +{ + ucell usesvocab = findword("vocabularies?") + sizeof(cell); + unsigned int i; + + if (read_ucell(cell2pointer(usesvocab))) { + /* Vocabularies are in use, so search each one in turn */ + ucell numvocabs = findword("#vocs") + sizeof(cell); + + for (i = 0; i < read_ucell(cell2pointer(numvocabs)); i++) { + ucell vocabs = findword("vocabularies") + 2 * sizeof(cell); + ucell semis = findsemis_wordlist(xt, read_cell(cell2pointer(vocabs + (i * sizeof(cell))))); + + /* If we get a non-zero result, we found the xt in this vocab */ + if (semis) + return semis; + } + } else { + /* Vocabularies not in use */ + return findsemis_wordlist(xt, read_ucell(last)); + } + + return 0; +} + + +/* findxtfromcell_wordlist + * Given a cell and a wordlist, determine the CFA of the word containing + * the cell or 0 if we are unable to return a suitable CFA + */ + +ucell findxtfromcell_wordlist(ucell incell, ucell wordlist) +{ + ucell tmplfa; + + if (!wordlist) + return 0; + + tmplfa = read_ucell(cell2pointer(wordlist)); + while (tmplfa) { + if (tmplfa < incell) + return lfa2cfa(tmplfa); + + tmplfa = read_ucell(cell2pointer(tmplfa)); + } + + return 0; +} + + +/* findxtfromcell + * Given a cell, determine the CFA of the word containing + * the cell by searching all vocabularies + */ + +ucell findxtfromcell(ucell incell) +{ + ucell usesvocab = findword("vocabularies?") + sizeof(cell); + unsigned int i; + + if (read_ucell(cell2pointer(usesvocab))) { + /* Vocabularies are in use, so search each one in turn */ + ucell numvocabs = findword("#vocs") + sizeof(cell); + + for (i = 0; i < read_ucell(cell2pointer(numvocabs)); i++) { + ucell vocabs = findword("vocabularies") + 2 * sizeof(cell); + ucell semis = findxtfromcell_wordlist(incell, read_cell(cell2pointer(vocabs + (i * sizeof(cell))))); + + /* If we get a non-zero result, we found the xt in this vocab */ + if (semis) + return semis; + } + } else { + /* Vocabularies not in use */ + return findxtfromcell_wordlist(incell, read_ucell(last)); + } + + return 0; +} + void dump_header(dictionary_header_t *header) { printk("OpenBIOS dictionary:\n");
Modified: trunk/openbios-devel/kernel/include/dict.h =================================================================== --- trunk/openbios-devel/kernel/include/dict.h 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/kernel/include/dict.h 2009-11-15 21:03:51 UTC (rev 611) @@ -11,13 +11,15 @@
#define DICTID "OpenBIOS"
-#define DOCOL 1 -#define DOLIT 2 -#define DOCON 3 -#define DOVAR 4 -#define DODFR 5 -#define DODOES 6 +#define DOSEMIS 0 +#define DOCOL 1 +#define DOLIT 2 +#define DOCON 3 +#define DOVAR 4 +#define DODFR 5 +#define DODOES 6
+#define MAXNFALEN 128
/* The header is 28/32 bytes on 32/64bit platforms */
@@ -37,6 +39,12 @@ ucell lfa2nfa(ucell ilfa); ucell load_dictionary(const char *data, ucell len); void dump_header(dictionary_header_t *header); +ucell fstrlen(ucell fstr); +void fstrncpy(char *dest, ucell src, unsigned int maxlen); +ucell findsemis_wordlist(ucell xt, ucell wordlist); +ucell findsemis(ucell xt); +ucell findxtfromcell_wordlist(ucell incell, ucell wordlist); +ucell findxtfromcell(ucell incell);
/* program counter */ extern ucell PC;
Modified: trunk/openbios-devel/kernel/internal.c =================================================================== --- trunk/openbios-devel/kernel/internal.c 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/kernel/internal.c 2009-11-15 21:03:51 UTC (rev 611) @@ -13,12 +13,39 @@ * - address pointed by CFA is executed by CPU */
+#ifndef FCOMPILER +#include "libc/vsprintf.h" +#else +#include <stdarg.h> +#endif + typedef void forth_word(void);
static forth_word * const words[]; ucell PC; -volatile int runforth = 0; +volatile int interruptforth = 0;
+#define DEBUG_MODE_NONE 0 +#define DEBUG_MODE_STEP 1 +#define DEBUG_MODE_TRACE 2 +#define DEBUG_MODE_STEPUP 3 + +#define DEBUG_BANNER "\nStepper keys: <space>/<enter> Up Down Trace Rstack Forth\n" + +/* Empty linked list of debug xts */ +struct debug_xt { + ucell xt_docol; + ucell xt_semis; + int mode; + struct debug_xt *next; +}; + +static struct debug_xt debug_xt_eol = { (ucell)0, (ucell)0, 0, NULL}; +static struct debug_xt *debug_xt_list = &debug_xt_eol; + +/* Static buffer for xt name */ +char xtname[MAXNFALEN]; + #ifndef FCOMPILER /* instead of pointing to an explicit 0 variable we * point behind the pointer. @@ -70,6 +97,8 @@ processxt(read_ucell(cell2pointer(read_ucell(cell2pointer(PC))))); }
+static inline void next_dbg(void); + int enterforth(xt_t xt) { ucell *_cfa = (ucell*)cell2pointer(xt); @@ -84,13 +113,26 @@ rstackcnt = 0;
tmp = rstackcnt; - runforth = 1; + interruptforth = FORTH_INTSTAT_CLR;
PUSHR(PC); PC = pointer2cell(_cfa); - while (rstackcnt > tmp && runforth) { - dbg_interp_printk("enterforth: NEXT\n"); - next(); + + 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 @@ -367,3 +409,366 @@ { string_relay( &encode_file ); } + + +/* + * Debug support functions + */ + +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 +display_dbg_dstack ( void ) +{ + /* Display dstack contents between parentheses */ + int i; + + if (dstackcnt == 0) { + printf_console(" ( Empty ) "); + return; + } else { + printf_console(" ( "); + for (i = 1; i <= dstackcnt; i++) { + if (i != 1) + printf_console(" "); + printf_console("%" FMT_CELL_x, dstack[i]); + } + printf_console(" ) "); + } +} + +static void +display_dbg_rstack ( void ) +{ + /* Display rstack contents between parentheses */ + int i; + + if (rstackcnt == 0) { + printf_console(" ( Empty ) "); + return; + } else { + printf_console("\nR: ( "); + for (i = 1; i <= rstackcnt; i++) { + if (i != 1) + printf_console(" "); + printf_console("%" FMT_CELL_x, rstack[i]); + } + printf_console(" ) \n"); + } +} + +static int +add_debug_xt( ucell xt ) +{ + struct debug_xt *debug_xt_item; + + /* If the xt CFA isn't DOCOL then issue a warning and do nothing */ + if (read_ucell(cell2pointer(xt)) != DOCOL) { + printf_console("\nprimitive words cannot be debugged\n"); + return 0; + } + + /* If this xt is already in the list, do nothing but indicate success */ + for (debug_xt_item = debug_xt_list; debug_xt_item->next != NULL; debug_xt_item = debug_xt_item->next) + if (debug_xt_item->xt_docol == xt) + return 1; + + /* We already have the CFA (PC) indicating the starting cell of the word, however we also + need the ending cell too (we cannot rely on the rstack as it can be arbitrarily + changed by a forth word). Hence the use of findsemis() */ + + /* Otherwise add to the head of the linked list */ + debug_xt_item = malloc(sizeof(struct debug_xt)); + debug_xt_item->xt_docol = xt; + debug_xt_item->xt_semis = findsemis(xt); + debug_xt_item->mode = DEBUG_MODE_NONE; + debug_xt_item->next = debug_xt_list; + debug_xt_list = debug_xt_item; + + /* Indicate debug mode change */ + interruptforth |= FORTH_INTSTAT_DBG; + + /* Success */ + return 1; +} + +static void +del_debug_xt( ucell xt ) +{ + struct debug_xt *debug_xt_item, *tmp_xt_item; + + /* Handle the case where the xt is at the head of the list */ + if (debug_xt_list->xt_docol == xt) { + tmp_xt_item = debug_xt_list; + debug_xt_list = debug_xt_list->next; + free(tmp_xt_item); + + return; + } + + /* Otherwise find this xt in the linked list and remove it */ + for (debug_xt_item = debug_xt_list; debug_xt_item->next != NULL; debug_xt_item = debug_xt_item->next) { + if (debug_xt_item->next->xt_docol == xt) { + tmp_xt_item = debug_xt_item->next; + debug_xt_item->next = debug_xt_item->next->next; + free(tmp_xt_item); + } + } + + /* If the list is now empty, indicate debug mode change */ + if (debug_xt_list->next == NULL) + interruptforth |= FORTH_INTSTAT_DBG; +} + +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 */ + while (!availchar()); + k = getchar(); + + /* 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) { + while (!availchar()); + k = getchar(); + } + 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; + while (!availchar()); + k = getchar(); + break; + + case 'f': + case 'F': + /* Start subordinate Forth interpreter */ + PUSHR(PC - sizeof(cell)); + PC = pointer2cell(findword("outer-interpreter")) + sizeof(ucell); + + /* Save rstack position for when we return */ + dbgrstackcnt = rstackcnt; + done = 1; + break; + + default: + /* Display debug banner */ + printk(DEBUG_BANNER); + while (!availchar()); + k = getchar(); + } + } +} + +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)) )); +} + +static void semis_dbg(void) +{ + struct debug_xt *debug_xt_item, *debug_xt_up = NULL; + + /* If current semis is in our debug xt list, disable debug mode */ + debug_xt_item = debug_xt_list; + while (debug_xt_item->next) { + if (debug_xt_item->xt_semis == PC) { + if (debug_xt_item->mode != DEBUG_MODE_STEPUP) { + /* Handle the normal case */ + fstrncpy(xtname, lfa2nfa(debug_xt_item->xt_docol - sizeof(cell)), MAXNFALEN); + printf_console("\n[ Finished %s ] ", xtname); + + /* Reset to step mode in case we were in trace mode */ + debug_xt_item->mode = DEBUG_MODE_STEP; + } else { + /* This word requires execution of the debugger "Up" + * semantics. However we can't do this here since we + * are iterating through the debug list, and we need + * to change it. So we do it afterwards. + */ + debug_xt_up = debug_xt_item; + } + } + + debug_xt_item = debug_xt_item->next; + } + + /* Execute debugger "Up" semantics if required */ + if (debug_xt_up) { + /* Only add the parent word if it is not within the trampoline */ + if (rstack[rstackcnt] != (cell)pointer2cell(&trampoline[1])) { + del_debug_xt(debug_xt_up->xt_docol); + add_debug_xt(findxtfromcell(rstack[rstackcnt])); + + fstrncpy(xtname, lfa2nfa(findxtfromcell(rstack[rstackcnt]) - sizeof(cell)), MAXNFALEN); + printf_console("\n[ Up to %s ] ", xtname); + } else { + fstrncpy(xtname, lfa2nfa(findxtfromcell(debug_xt_up->xt_docol) - sizeof(cell)), MAXNFALEN); + printf_console("\n[ Finished %s (Unable to go up, hit trampoline) ] ", xtname); + + del_debug_xt(debug_xt_up->xt_docol); + } + + debug_xt_up = NULL; + } + + PC = POPR(); +} + +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 void +do_debug_xt( void ) +{ + ucell xt = POP(); + + /* Add to the debug list */ + if (add_debug_xt(xt)) { + /* Display debug banner */ + printf_console(DEBUG_BANNER); + + /* Indicate change to debug mode */ + interruptforth |= FORTH_INTSTAT_DBG; + } +} + +static void +do_debug_off( void ) +{ + /* Empty the debug xt linked list */ + while (debug_xt_list->next != NULL) + del_debug_xt(debug_xt_list->xt_docol); +} +
Modified: trunk/openbios-devel/kernel/primitives.c =================================================================== --- trunk/openbios-devel/kernel/primitives.c 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/kernel/primitives.c 2009-11-15 21:03:51 UTC (rev 611) @@ -143,4 +143,6 @@ sysdebug, /* sys-debug */ do_include, /* $include */ do_encode_file, /* $encode-file */ + do_debug_xt, /* (debug */ + do_debug_off, /* (debug-off) */ };
Modified: trunk/openbios-devel/kernel/stack.c =================================================================== --- trunk/openbios-devel/kernel/stack.c 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/kernel/stack.c 2009-11-15 21:03:51 UTC (rev 611) @@ -19,6 +19,9 @@ int rstackcnt = 0; cell rstack[rstacksize];
+/* Rstack value saved before entering forth interpreter in debugger */ +int dbgrstackcnt = 0; + #if defined(CONFIG_DEBUG_DSTACK) || defined(FCOMPILER) void printdstack(void) {
Modified: trunk/openbios-devel/modules/cmdline.c =================================================================== --- trunk/openbios-devel/modules/cmdline.c 2009-11-12 01:15:02 UTC (rev 610) +++ trunk/openbios-devel/modules/cmdline.c 2009-11-15 21:03:51 UTC (rev 611) @@ -179,6 +179,7 @@ { int cur_added=0, histind=0, ch, i, pos=0, n=0, prompt=1; char *buf = ci->buf; + int terminate = 0;
buf = ci->buf; selfword("prepare"); @@ -187,10 +188,11 @@ #ifdef NOLEAVE for (;;) #else - while (rstackcnt) + while (rstackcnt && !terminate) #endif { int drop = 0; + terminate = 0;
if( prompt ) { fword("print-prompt"); @@ -254,6 +256,12 @@ emit(' '); PUSH( feval(buf) ); fword("print-status"); + + /* Leave the interpreter if terminate? value set */ + fword("terminate?"); + if (POP()) + terminate = 1; + prompt = 1; break;
@@ -384,7 +392,14 @@ move_cursor( 1-emit_str(&buf[pos++]) ); } } - /* won't come here; if we ever do we should close ourselves */ + + /* we only get here if terminate? is non-zero; this should + * only ever be done for a subordinate forth interpreter + * e.g. for debugging */ + + /* Reset stack and terminate? */ + rstackcnt = dbgrstackcnt; + feval("0 to terminate?"); }
NODE_METHODS( cmdline ) = {