ref: c087f58ed0bfe9a8ec1059b43f67b0bd3353666d
parent: 58346fc70b1f39f6cedfad8a86823262b6f72290
author: jsadler <jsadler@ficl.sf.net>
date: Sun Oct 1 18:50:45 CDT 2000
intermediate check-in before merge of contributed changes
--- a/ReadMe.txt
+++ b/ReadMe.txt
@@ -1,19 +1,8 @@
Coming up:
Web server scripting extension (GoAhead port)
-method: defining word for public methods
-
-ficlwin Debugger pane - step, stack trace, breakpoint
-Design:
-0. Debug pane or window - step-into step-over go
-1. DEBUG <word> --- lookup word, decompile it into debug pane
-2. At each STEP, stack pane displays stack state
-3. GO runs until breakpoint or leaves debug mode if no breaks
-4. BREAK stops debug vm at next step
-Requires a debug VM that checks for breaks, step mode, etc.
-How to get stack parameters to execution vm, or get input text to debug vm?
-
-rel 2.05 -- June 2000
+rel 2.05 -- August 2000
+- Step debugger
- *** HTML documentation extensively revised ***
- Incorporated Alpha (64 bit) patches from the freeBSD team.
- Split SEARCH and SEARCH EXT words from words.c to search.c
--- a/doc/ficl.html
+++ b/doc/ficl.html
@@ -17,11 +17,8 @@
<td><b>Forth Inspired Command Language </b></td>
<td ROWSPAN="4"><img SRC="ficl_logo.jpg" height=64 width=64></td>
-<td ROWSPAN="4">
- <a href=http://www.links2go.net/topic/Forth>
- <img alt="Key Resource" src="skey.gif" width=81 height=81 border=0>
- </a>
-</td>
+
+<td ROWSPAN="4"><a href="http://www.links2go.net/topic/Forth"><img SRC="skey.gif" ALT="Key Resource" BORDER=0 height=81 width=81></a></td>
</tr>
<tr>
@@ -77,6 +74,9 @@
<li>
<font size=+1><a href="ficl_oop.html">Object Oriented Programming in ficl</a></font></li>
+
+<li>
+<font size=+1><a href="ficl_debug.html">Ficl Debugger</a></font></li>
<li>
<font size=+1><a href="#extras">Ficl extras</a></font></li>
--- a/ficl.c
+++ b/ficl.c
@@ -3,7 +3,7 @@
** Forth Inspired Command Language - external interface
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 19 July 1997
-** $Id: ficl.c,v 1.7 2000/07/12 06:44:07 jsadler Exp $
+** $Id: ficl.c,v 1.8 2000/10/01 23:50:35 jsadler Exp $
*******************************************************************/
/*
** This is an ANS Forth interpreter written in C.
@@ -209,7 +209,7 @@
int ficlExecC(FICL_VM *pVM, char *pText, FICL_INT size)
{- static FICL_WORD *pInterp = NULL;
+ static FICL_WORD *pInterp[3] = {NULL, NULL, NULL};int except;
jmp_buf vmState;
@@ -216,10 +216,14 @@
jmp_buf *oldState;
TIB saveTib;
- if (!pInterp)
- pInterp = ficlLookup("interpret");+ if (!pInterp[0])
+ {+ pInterp[0] = ficlLookup("interpret");+ pInterp[1] = ficlLookup("(branch)");+ pInterp[2] = (FICL_WORD *)(void *)(-2);
+ }
- assert(pInterp);
+ assert(pInterp[0]);
assert(pVM);
if (size < 0)
@@ -244,7 +248,7 @@
}
else
{ /* set VM up to interpret text */- vmPushIP(pVM, &pInterp);
+ vmPushIP(pVM, &pInterp[0]);
}
vmInnerLoop(pVM);
@@ -322,6 +326,7 @@
int except;
jmp_buf vmState;
jmp_buf *oldState;
+ FICL_WORD *oldRunningWord;
if (!pQuit)
pQuit = ficlLookup("exit-inner");@@ -329,6 +334,11 @@
assert(pVM);
assert(pQuit);
+ /*
+ ** Save the runningword so that RESTART behaves correctly
+ ** over nested calls.
+ */
+ oldRunningWord = pVM->runningWord;
/*
** Save and restore VM's jmp_buf to enable nested calls
*/
@@ -369,6 +379,7 @@
}
pVM->pState = oldState;
+ pVM->runningWord = oldRunningWord;
return (except);
}
--- a/ficl.dsp
+++ b/ficl.dsp
@@ -120,6 +120,10 @@
# End Source File
# Begin Source File
+SOURCE=.\tools.c
+# End Source File
+# Begin Source File
+
SOURCE=.\vm.c
# End Source File
# Begin Source File
--- a/ficl.h
+++ b/ficl.h
@@ -3,7 +3,7 @@
** Forth Inspired Command Language
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 19 July 1997
-** $Id: ficl.h,v 1.8 2000/07/12 06:44:08 jsadler Exp $
+** $Id: ficl.h,v 1.9 2000/10/01 23:50:36 jsadler Exp $
*******************************************************************/
/*
** N O T I C E -- DISCLAIMER OF WARRANTY
@@ -842,7 +842,7 @@
/*
** The following supports SEE and the debugger.
*/
-enum
+typedef enum
{BRANCH,
COLON,
@@ -859,9 +859,7 @@
STRINGLIT,
USER,
VARIABLE,
-} wordkinds;
-
-typedef enum wordkinds WORDKIND;
+} WORDKIND;
WORDKIND ficlWordClassify(FICL_WORD *pFW);
--- a/softwords/oo.fr
+++ b/softwords/oo.fr
@@ -569,6 +569,9 @@
inst swap -
class ;
+: debug ( 2this -- ?? )
+ find-method-xt debug-xt ;
+
previous set-current
\ E N D O B J E C T
--- a/softwords/softcore.fr
+++ b/softwords/softcore.fr
@@ -168,6 +168,8 @@
." Compile: " get-current list-wid cr
;
+: debug ' debug-xt ;
+
previous \ lose hidden words from search order
\ ** E N D S O F T C O R E . F R
--- a/tools.c
+++ b/tools.c
@@ -3,7 +3,7 @@
** Forth Inspired Command Language - programming tools
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 20 June 2000
-** $Id: tools.c,v 1.1 2000/07/12 06:44:12 jsadler Exp $
+** $Id: tools.c,v 1.2 2000/10/01 23:50:41 jsadler Exp $
*******************************************************************/
/*
** NOTES:
@@ -34,7 +34,7 @@
** nBREAKPOINTS sizes the breakpoint array. One breakpoint (bp 0) is reserved
** for the STEP command. The rest are user programmable.
*/
-#define nBREAKPOINTS 10
+#define nBREAKPOINTS 32
#endif
/*
@@ -55,6 +55,7 @@
static BREAKPOINT bpStep = {NULL, NULL};static FICL_WORD *pStep = NULL;
+static FICL_WORD *pOnStep = NULL;
#if 0
/**************************************************************************
@@ -77,16 +78,15 @@
#endif
-/**************************************************************************
- s e e
-** TOOLS ( "<spaces>name" -- )
-** Display a human-readable representation of the named word's definition.
-** The source of the representation (object-code decompilation, source
-** block, etc.) and the particular form of the display is implementation
-** defined.
-** NOTE: these funcs come late in the file because they reference all
-** of the word-builder funcs without declaring them again. Call me lazy.
-**************************************************************************/
+static void vmSetBreak(FICL_VM *pVM, BREAKPOINT *pBP)
+{+ assert(pStep);
+ pBP->address = pVM->ip;
+ pBP->origXT = *pVM->ip;
+ *pVM->ip = pStep;
+}
+
+
/*
** isAFiclWord
** Vet a candidate pointer carefully to make sure
@@ -108,6 +108,24 @@
return ((pFW->nName > 0) && (pFW->name[pFW->nName] == '\0'));
}
+
+static int isPrimitive(FICL_WORD *pFW)
+{+ WORDKIND wk = ficlWordClassify(pFW);
+ return ((wk != COLON) && (wk != DOES));
+}
+
+
+/**************************************************************************
+ s e e
+** TOOLS ( "<spaces>name" -- )
+** Display a human-readable representation of the named word's definition.
+** The source of the representation (object-code decompilation, source
+** block, etc.) and the particular form of the display is implementation
+** defined.
+** NOTE: these funcs come late in the file because they reference all
+** of the word-builder funcs without declaring them again. Call me lazy.
+**************************************************************************/
/*
** seeColon (for proctologists only)
** Walks a colon definition, decompiling
@@ -273,7 +291,7 @@
/**************************************************************************
- f i c l D e b u g
+ f i c l D e b u g X T
** debug ( xt -- )
** Given an xt of a colon definition or a word defined by DOES>, set the
** VM up to debug the word: push IP, set the xt as the next thing to execute,
@@ -280,7 +298,7 @@
** set a breakpoint at its first instruction, and run to the breakpoint.
** Note: the semantics of this word are equivalent to "step in"
**************************************************************************/
-void ficlDebug(FICL_VM *pVM)
+void ficlDebugXT(FICL_VM *pVM)
{FICL_WORD *xt = stackPopPtr(pVM->pStack);
WORDKIND wk = ficlWordClassify(xt);
@@ -287,6 +305,8 @@
assert(pStep);
+ pOnStep = ficlLookup("on-step");+
stackPushPtr(pVM->pStack, xt);
seeXT(pVM);
@@ -311,6 +331,12 @@
}
+/**************************************************************************
+ s t e p I n
+** FICL
+** Execute the next instruction, stepping into it if it's a colon definition
+** or a does> word. This is the easy kind of step.
+**************************************************************************/
void stepIn(FICL_VM *pVM)
{assert(pStep);
@@ -324,9 +350,7 @@
/*
** Now set a breakpoint at the next instruction
*/
- bpStep.address = pVM->ip;
- bpStep.origXT = *pVM->ip;
- *pVM->ip = pStep;
+ vmSetBreak(pVM, &bpStep);
return;
}
@@ -335,30 +359,41 @@
/**************************************************************************
s t e p O v e r
** FICL
-** Execute the next instruction atomically.
+** Execute the next instruction atomically. This requires some insight into
+** the memory layout of compiled code. Set a breakpoint at the next instruction
+** in this word, and run until we hit it
**************************************************************************/
void stepOver(FICL_VM *pVM)
{+ FICL_WORD *pFW;
+ WORDKIND kind;
assert(pStep);
- /*
- ** Do one step of the inner loop
- */
- { - M_VM_STEP(pVM)
+
+ pFW = *pVM->ip;
+ kind = ficlWordClassify(pFW);
+
+ switch (kind)
+ {+ case COLON:
+ case DOES:
+ /*
+ ** assume that the next cell holds an instruction
+ ** set a breakpoint there and return to the inner interp
+ */
+ bpStep.address = pVM->ip + 1;
+ bpStep.origXT = pVM->ip[1];
+ pVM->ip[1] = pStep;
+ break;
+
+ default:
+ stepIn(pVM);
+ break;
}
- /*
- ** Now set a breakpoint at the next instruction
- */
- bpStep.address = pVM->ip;
- bpStep.origXT = *pVM->ip;
- *pVM->ip = pStep;
-
return;
}
-
/**************************************************************************
s t e p - b r e a k
** FICL
@@ -367,11 +402,13 @@
** of the current breakpoint.
** Clear the breakpoint
** Get a command from the console.
-** in (step in) - execute the current instruction and set a new breakpoint
+** i (step in) - execute the current instruction and set a new breakpoint
** at the IP
-** ov (step over) - execute the current instruction to completion and set
+** o (step over) - execute the current instruction to completion and set
** a new breakpoint at the IP
-** go - execute the current instruction and exit
+** g (go) - execute the current instruction and exit
+** q (quit) - abort current word
+** b (toggle breakpoint)
**************************************************************************/
void stepBreak(FICL_VM *pVM)
{@@ -383,32 +420,64 @@
assert(bpStep.address != NULL);
/*
- ** restore the original instruction at the breakpoint, and restore the IP
+ ** Clear the breakpoint that caused me to run
+ ** Restore the original instruction at the breakpoint,
+ ** and restore the IP
*/
+ assert(bpStep.address);
+ assert(bpStep.origXT);
+
pVM->ip = (IPTYPE)bpStep.address;
- *pVM->ip = pFW = bpStep.origXT;
+ *pVM->ip = bpStep.origXT;
/*
- ** Print the name of the next instruction and get a debug command
+ ** If there's an onStep, do it
*/
- sprintf(pVM->pad, "%.*s", pFW->nName, pFW->name);
+ if (pOnStep)
+ ficlExecXT(pVM, pOnStep);
+
+ /*
+ ** Print the name of the next instruction
+ */
+ pFW = bpStep.origXT;
+ sprintf(pVM->pad, "next: %.*s", pFW->nName, pFW->name);
+ if (isPrimitive(pFW))
+ {+ strcat(pVM->pad, " primitive");
+ }
+
vmTextOut(pVM, pVM->pad, 1);
}
+ else
+ {+ pVM->fRestart = 0;
+ }
si = vmGetWord(pVM);
- if (!strincmp(si.cp, "in", (unsigned char)si.count))
+ if (!strincmp(si.cp, "i", (unsigned char)si.count))
{stepIn(pVM);
}
- else if (!strincmp(si.cp, "go", (unsigned char)si.count))
+ else if (!strincmp(si.cp, "g", (unsigned char)si.count))
{return;
}
- else if (!strincmp(si.cp, "ov", (unsigned char)si.count))
+ else if (!strincmp(si.cp, "o", (unsigned char)si.count))
{stepOver(pVM);
}
+ else if (!strincmp(si.cp, "q", (unsigned char)si.count))
+ {+ vmThrow(pVM, VM_ABORT);
+ }
+ else if (!strincmp(si.cp, "?", (unsigned char)si.count))
+ {+ vmTextOut(pVM, "i -- step In", 1);
+ vmTextOut(pVM, "o -- step Over", 1);
+ vmTextOut(pVM, "g -- Go (execute to completion)", 1);
+ vmTextOut(pVM, "q -- Quit (stop debugging and abort)", 1);
+ }
else
{vmTextOut(pVM, "unrecognized debug command", 1);
@@ -425,7 +494,6 @@
** Signal the system to shut down - this causes ficlExec to return
** VM_USEREXIT. The rest is up to you.
**************************************************************************/
-
static void bye(FICL_VM *pVM)
{vmThrow(pVM, VM_USEREXIT);
@@ -438,7 +506,6 @@
** TOOLS
** Display the parameter stack (code for ".s")
**************************************************************************/
-
static void displayStack(FICL_VM *pVM)
{int d = stackDepth(pVM->pStack);
@@ -461,17 +528,30 @@
}
+static void displayRStack(FICL_VM *pVM)
+{+ int d = stackDepth(pVM->rStack);
+ int i;
+ CELL *pCell;
+
+ vmTextOut(pVM, "Return Stack: ", 0);
+ if (d == 0)
+ vmTextOut(pVM, "Empty ", 0);
+ else
+ {+ pCell = pVM->rStack->base;
+ for (i = 0; i < d; i++)
+ {+ vmTextOut(pVM, ultoa((*pCell++).i, pVM->pad, 16), 0);
+ vmTextOut(pVM, " ", 0);
+ }
+ }
+}
+
+
/**************************************************************************
- f o r g e t
-** TOOLS EXT ( "<spaces>name" -- )
-** Skip leading space delimiters. Parse name delimited by a space.
-** Find name, then delete name from the dictionary along with all
-** words added to the dictionary after name. An ambiguous
-** condition exists if name cannot be found.
+ f o r g e t - w i d
**
-** If the Search-Order word set is present, FORGET searches the
-** compilation word list. An ambiguous condition exists if the
-** compilation word list is deleted.
**************************************************************************/
static void forgetWid(FICL_VM *pVM)
{@@ -485,6 +565,18 @@
}
+/**************************************************************************
+ f o r g e t
+** TOOLS EXT ( "<spaces>name" -- )
+** Skip leading space delimiters. Parse name delimited by a space.
+** Find name, then delete name from the dictionary along with all
+** words added to the dictionary after name. An ambiguous
+** condition exists if name cannot be found.
+**
+** If the Search-Order word set is present, FORGET searches the
+** compilation word list. An ambiguous condition exists if the
+** compilation word list is deleted.
+**************************************************************************/
static void forget(FICL_VM *pVM)
{void *where;
@@ -618,11 +710,13 @@
** Ficl extras
*/
dictAppendWord(dp, ".env", listEnv, FW_DEFAULT);
- dictAppendWord(dp, "debug", ficlDebug, FW_DEFAULT);
+ dictAppendWord(dp, "debug-xt", ficlDebugXT, FW_DEFAULT);
pStep =
dictAppendWord(dp, "step-break",stepBreak, FW_DEFAULT);
dictAppendWord(dp, "forget-wid",forgetWid, FW_DEFAULT);
dictAppendWord(dp, "see-xt", seeXT, FW_DEFAULT);
+ dictAppendWord(dp, ".r", displayRStack, FW_DEFAULT);
+
return;
}
--- a/words.c
+++ b/words.c
@@ -4,7 +4,7 @@
** ANS Forth CORE word-set written in C
** Author: John Sadler (john_sadler@alum.mit.edu)
** Created: 19 July 1997
-** $Id: words.c,v 1.8 2000/07/12 06:44:09 jsadler Exp $
+** $Id: words.c,v 1.9 2000/10/01 23:50:40 jsadler Exp $
*******************************************************************/
#include <stdlib.h>
@@ -1172,7 +1172,7 @@
assert(pVM);
si = vmGetWord0(pVM);
- vmBranchRelative(pVM, -1);
+ /* vmBranchRelative(pVM, -1); */
/*
** Get next word...if out of text, we're done.