File:
[gforth] /
gforth /
debug.fs
Revision
1.11:
download - view:
text,
annotated -
select for diffs
Tue Mar 23 20:24:17 1999 UTC (25 years, 1 month ago) by
crook
Branches:
MAIN
CVS tags:
HEAD
Makefile.in
-- changes to make documentation build with moofglos.fs
rather than with mini-oof.fs (since the former contains glossary
entries and the latter does not)
assert.fs blocks.fs debug.fs environ.fs errors.fs extend.fs float.fs
glocals.fs moofglos.fs prim search.fs struct.fs stuff.fs vt100.fs
kernel/args.fs kernel/basics.fs kernel/comp.fs kernel/cond.fs
kernel/files.fs kernel/getdoers.fs kernel/int.fs kernel/io.fs
kernel/nio.fs kernel/paths.fs kernel/require.fs kernel/special.fs
kernel/tools.fs kernel/toolsext.fs kernel/vars.fs
-- many small changes to glossary entries.. I think most are done
now, so I hope to change far fewer files next time!
doc/gforth.ds
-- many, many small changes and a few large ones. Moved some sections
around, fixed typos and formatting errors, added new section on
exception handling, rearranged 'files' section.
1: \ DEBUG.FS Debugger 12jun93jaw
2:
3: \ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation; either version 2
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program; if not, write to the Free Software
19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20:
21: decimal
22:
23: VARIABLE dbg-ip \ istruction pointer for debugger
24:
25: : scanword ( body -- )
26: c-init C-Output off
27: ScanMode c-pass !
28: dup MakePass
29: 0 Level !
30: 0 XPos !
31: DisplayMode c-pass !
32: MakePass
33: C-Output on ;
34:
35: : .n 0 <# # # # # #S #> ctype bl cemit ;
36:
37: : d.s ." [ " depth . ." ] "
38: depth 4 min dup 0 ?DO dup i - pick .n LOOP drop ;
39:
40: : NoFine XPos off YPos off
41: NLFlag off Level off
42: C-Formated off
43: ;
44:
45: : disp-step
46: DisplayMode c-pass ! \ change to displaymode
47: cr
48: c-stop off
49: Base @ hex dbg-ip @ 8 u.r space dbg-ip @ @ 8 u.r space
50: Base !
51: NoFine 10 XPos !
52: dbg-ip @ DisplayMode c-pass ! Analyse drop
53: 25 XPos @ - 0 max spaces ." -> " ;
54:
55: : get-next ( -- n | n n )
56: DebugMode c-pass !
57: dbg-ip @ Analyse ;
58:
59: : jump ( addr -- )
60: r> drop \ discard last ip
61: >r ;
62:
63: AVARIABLE DebugLoop
64:
65: : breaker r> 1 cells - dbg-ip ! DebugLoop @ jump ;
66:
67: CREATE BP 0 , 0 ,
68: CREATE DT 0 , 0 ,
69:
70: : set-bp ( 0 n | 0 n n -- )
71: 0. BP 2!
72: ?dup IF dup BP ! dup @ DT !
73: ['] Breaker swap !
74: ?dup IF dup BP cell+ ! dup @ DT cell+ !
75: ['] Breaker swap ! drop THEN
76: THEN ;
77:
78: : restore-bp ( -- )
79: BP @ ?dup IF DT @ swap ! THEN
80: BP cell+ @ ?dup IF DT cell+ @ swap ! THEN ;
81:
82: VARIABLE Body
83:
84: : NestXT ( xt -- true | body false )
85: \ special deal for create does> words
86: \ leaves body address on the stack
87: dup >does-code IF dup >body swap THEN
88:
89: DebugMode c-pass ! C-Output off
90: xt-see C-Output on
91: c-pass @ DebugMode = dup
92: IF ." Cannot debug" cr
93: THEN ;
94:
95: VARIABLE Nesting
96:
97: : Leave-D
98: C-Formated on
99: C-Output on ;
100:
101: VARIABLE Unnest
102:
103: : D-KEY ( -- flag )
104: BEGIN
105: Unnest @ IF 0 ELSE key THEN
106: CASE [char] n OF dbg-ip @ @ NestXT EXIT ENDOF
107: [char] s OF Leave-D
108: -128 THROW ENDOF
109: [char] a OF Leave-D
110: -128 THROW ENDOF
111: [char] d OF Leave-D
112: cr ." Done..." cr
113: Nesting off
114: r> drop dbg-ip @ >r
115: EXIT ENDOF
116: [char] ? OF cr ." Nest Stop Done Unnest" cr
117: ENDOF
118: [char] u OF Unnest on true EXIT ENDOF
119: drop true EXIT
120: ENDCASE
121: AGAIN ;
122:
123: : (debug) ( body -- )
124: 0 Nesting !
125: BEGIN Unnest off
126: cr ." Scanning code..." cr C-Formated on
127: dup scanword dbg-ip !
128: cr ." Nesting debugger ready!" cr
129: BEGIN d.s disp-step D-Key
130: WHILE C-Stop @ 0=
131: WHILE 0 get-next set-bp
132: dbg-ip @ jump
133: [ here DebugLoop ! ]
134: restore-bp
135: REPEAT
136: Nesting @ 0= IF EXIT THEN
137: -1 Nesting +! r>
138: ELSE
139: dbg-ip @ 1 cells + >r 1 Nesting +!
140: THEN
141: AGAIN ;
142:
143: : dbg \ gforth
144: ' NestXT IF EXIT THEN (debug) Leave-D ;
145:
146: : break: \ gforth
147: r> ['] (debug) >body >r ;
148:
149: : (break")
150: cr
151: ." BREAK AT: " type cr
152: r> ['] (debug) >body >r ;
153:
154: : break" \ gforth
155: postpone s"
156: postpone (break") ; immediate
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>