[OpenBIOS] r611 - in trunk/openbios-devel: arch/unix/gui_qt arch/unix/plugins/plugin_qt forth/bootstrap forth/debugging forth/lib include/openbios kernel kernel/include modules
svn at openbios.org
svn at openbios.org
Sun Nov 15 22:03:52 CET 2009
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 at 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 ) = {
More information about the OpenBIOS
mailing list