From 44e2c94e2048752f628271245c5ac36df638750b Mon Sep 17 00:00:00 2001 From: blueswirl Date: Sun, 15 Nov 2009 21:03:51 +0000 Subject: [PATCH] Reworked version of Forth Source debugger (Mark Cave-Ayland) This patch implements the following Forth words: debug - 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 git-svn-id: svn://openbios.org/openbios/trunk/openbios-devel@611 f158a5a8-5612-0410-a976-696ce0be7e32 --- arch/unix/gui_qt/gui-qt.cpp | 2 +- arch/unix/plugins/plugin_qt/plugin_qt.cpp | 4 +- forth/bootstrap/interpreter.fs | 4 +- forth/debugging/firmware.fs | 16 +- forth/lib/vocabulary.fs | 4 +- include/openbios/kernel.h | 7 +- include/openbios/stack.h | 2 + kernel/bootstrap.c | 8 +- kernel/dict.c | 139 +++++++++- kernel/include/dict.h | 20 +- kernel/internal.c | 415 +++++++++++++++++++++++++++++- kernel/primitives.c | 2 + kernel/stack.c | 3 + modules/cmdline.c | 19 +- 14 files changed, 616 insertions(+), 29 deletions(-) diff --git a/arch/unix/gui_qt/gui-qt.cpp b/arch/unix/gui_qt/gui-qt.cpp index 3af2886..24c0842 100644 --- a/arch/unix/gui_qt/gui-qt.cpp +++ b/arch/unix/gui_qt/gui-qt.cpp @@ -108,7 +108,7 @@ void FrameBufferWidget::quit() extern volatile int runforth; gui_running=0; - runforth=0; + interruptforth=1; qApp->quit(); } diff --git a/arch/unix/plugins/plugin_qt/plugin_qt.cpp b/arch/unix/plugins/plugin_qt/plugin_qt.cpp index 13a96fa..07234dc 100644 --- a/arch/unix/plugins/plugin_qt/plugin_qt.cpp +++ b/arch/unix/plugins/plugin_qt/plugin_qt.cpp @@ -105,10 +105,10 @@ void FrameBufferWidget::aboutQt() 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(); } diff --git a/forth/bootstrap/interpreter.fs b/forth/bootstrap/interpreter.fs index bc7abe4..5187058 100644 --- a/forth/bootstrap/interpreter.fs +++ b/forth/bootstrap/interpreter.fs @@ -12,6 +12,7 @@ \ 0 value interactive? +0 value terminate? : exit? interactive? 0= if @@ -122,7 +123,8 @@ defer outer-interpreter refill ['] interpret catch print-status - again + terminate? + until ; ['] outer-interpreter (to) \ diff --git a/forth/debugging/firmware.fs b/forth/debugging/firmware.fs index 8fe51db..5e16a6c 100644 --- a/forth/debugging/firmware.fs +++ b/forth/debugging/firmware.fs @@ -62,11 +62,16 @@ \ 7.5.3.4 Forth source-level debugger - + : debug ( "old-name< >" -- ) - ; - -: (debug ( xt -- ) + parse-word \ Look up word CFA in dictionary + $find + 0 = if + ." could not locate word for debugging" + 2drop + else + (debug + then ; : stepping ( -- ) @@ -76,7 +81,10 @@ ; : debug-off ( -- ) + (debug-off) ; : resume ( -- ) + \ Set interpreter termination flag + 1 to terminate? ; diff --git a/forth/lib/vocabulary.fs b/forth/lib/vocabulary.fs index b656e2c..faa75ea 100644 --- a/forth/lib/vocabulary.fs +++ b/forth/lib/vocabulary.fs @@ -62,9 +62,9 @@ create vocabularies #vocs cells allot \ word lists \ 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 ; diff --git a/include/openbios/kernel.h b/include/openbios/kernel.h index fac9bf3..1a7ce19 100644 --- a/include/openbios/kernel.h +++ b/include/openbios/kernel.h @@ -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)); diff --git a/include/openbios/stack.h b/include/openbios/stack.h index e9733ef..9fe52ce 100644 --- a/include/openbios/stack.h +++ b/include/openbios/stack.h @@ -18,6 +18,8 @@ extern cell dstack[dstacksize]; 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; diff --git a/kernel/bootstrap.c b/kernel/bootstrap.c index 85a87b9..8eb7b04 100644 --- a/kernel/bootstrap.c +++ b/kernel/bootstrap.c @@ -78,7 +78,7 @@ static const char *wordnames[] = { "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 availchar(void) { 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 get_inputbyte( void ) int tmp; if( cursrc < 1 ) { - runforth = 0; + interruptforth |= FORTH_INTSTAT_STOP; return 0; } @@ -909,7 +909,7 @@ static void run_dictionary(char *basedict) if (verbose) printk("Jumping to dictionary..."); - runforth=-1; + interruptforth = 1; enterforth((xt_t)PC); } diff --git a/kernel/dict.c b/kernel/dict.c index 75e4b16..051174c 100644 --- a/kernel/dict.c +++ b/kernel/dict.c @@ -50,7 +50,7 @@ static xt_t lfa2cfa(ucell ilfa) /* 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 @@ static int fstrcmp(const char *s1, ucell fstr) 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 @@ xt_t findword(const char *s1) } +/* 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"); diff --git a/kernel/include/dict.h b/kernel/include/dict.h index 9332ffb..4eefde2 100644 --- a/kernel/include/dict.h +++ b/kernel/include/dict.h @@ -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 @@ typedef struct dictionary_header { 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; diff --git a/kernel/internal.c b/kernel/internal.c index 63236d1..efa18f3 100644 --- a/kernel/internal.c +++ b/kernel/internal.c @@ -13,11 +13,38 @@ * - address pointed by CFA is executed by CPU */ +#ifndef FCOMPILER +#include "libc/vsprintf.h" +#else +#include +#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: / 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 @@ -70,6 +97,8 @@ static inline void next(void) 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 @@ int enterforth(xt_t xt) 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 @@ do_encode_file( void ) { 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); +} + diff --git a/kernel/primitives.c b/kernel/primitives.c index 67102b2..da67604 100644 --- a/kernel/primitives.c +++ b/kernel/primitives.c @@ -143,4 +143,6 @@ static forth_word * const words[] = { sysdebug, /* sys-debug */ do_include, /* $include */ do_encode_file, /* $encode-file */ + do_debug_xt, /* (debug */ + do_debug_off, /* (debug-off) */ }; diff --git a/kernel/stack.c b/kernel/stack.c index b32fc3a..cb45f97 100644 --- a/kernel/stack.c +++ b/kernel/stack.c @@ -19,6 +19,9 @@ cell dstack[dstacksize]; 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) { diff --git a/modules/cmdline.c b/modules/cmdline.c index 3eb3d1c..fc3388b 100644 --- a/modules/cmdline.c +++ b/modules/cmdline.c @@ -179,6 +179,7 @@ cmdline_prompt( cmdline_info_t *ci ) { 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 @@ cmdline_prompt( cmdline_info_t *ci ) #ifdef NOLEAVE for (;;) #else - while (rstackcnt) + while (rstackcnt && !terminate) #endif { int drop = 0; + terminate = 0; if( prompt ) { fword("print-prompt"); @@ -254,6 +256,12 @@ cmdline_prompt( cmdline_info_t *ci ) 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 @@ go_up: 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 ) = { -- 2.11.4.GIT