version 1.2, 1994/07/13 19:21:01
|
version 1.9, 1998/12/08 22:02:38
|
Line 1
|
Line 1
|
\ DEBUG.FS Debugger 12jun93jaw |
\ DEBUG.FS Debugger 12jun93jaw |
|
|
|
\ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. |
|
|
|
\ This file is part of Gforth. |
|
|
|
\ Gforth is free software; you can redistribute it and/or |
|
\ modify it under the terms of the GNU General Public License |
|
\ as published by the Free Software Foundation; either version 2 |
|
\ of the License, or (at your option) any later version. |
|
|
|
\ This program is distributed in the hope that it will be useful, |
|
\ but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
|
\ GNU General Public License for more details. |
|
|
|
\ You should have received a copy of the GNU General Public License |
|
\ along with this program; if not, write to the Free Software |
|
\ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. |
|
|
decimal |
decimal |
|
|
VARIABLE IP \ istruction pointer for debugger |
VARIABLE dbg-ip \ istruction pointer for debugger |
|
|
\ Formated debugger words 12jun93jaw |
\ Formated debugger words 12jun93jaw |
|
|
Line 79 VARIABLE Body
|
Line 97 VARIABLE Body
|
\ dup D-TableL + C@ dup Level ! dup XPos ! spaces 0 YPos ! |
\ dup D-TableL + C@ dup Level ! dup XPos ! spaces 0 YPos ! |
\ D-LineIP + @ C-Stop off |
\ D-LineIP + @ C-Stop off |
\ BEGIN |
\ BEGIN |
\ [IFDEF] Green IP @ over = |
\ [IFDEF] Green dbg-ip @ over = |
\ IF hig# C-Highlight ! ELSE C-Highlight off THEN |
\ IF hig# C-Highlight ! ELSE C-Highlight off THEN |
\ [THEN] |
\ [THEN] |
\ Analyse |
\ Analyse |
Line 116 VARIABLE LastIP
|
Line 134 VARIABLE LastIP
|
|
|
: Watcher ( -- ) |
: Watcher ( -- ) |
TopLine |
TopLine |
IP @ SearchLine dup D-Line @ dup D-MaxLines @ + |
dbg-ip @ SearchLine dup D-Line @ dup D-MaxLines @ + |
within |
within |
IF drop D-Line @ Display |
IF drop D-Line @ Display |
ELSE D-MaxLines @ 2/ - 0 max dup D-Line ! |
ELSE D-MaxLines @ 2/ - 0 max dup D-Line ! |
Line 125 VARIABLE LastIP
|
Line 143 VARIABLE LastIP
|
C-Formated off Colors on |
C-Formated off Colors on |
\ LastIP @ ?DUP IF DispIP THEN |
\ LastIP @ ?DUP IF DispIP THEN |
Hig# C-Highlight ! |
Hig# C-Highlight ! |
IP @ DispIP IP @ LastIP ! |
dbg-ip @ DispIP dbg-ip @ LastIP ! |
C-Formated on C-Highlight off |
C-Formated on C-Highlight off |
BottomLine ; |
BottomLine ; |
|
|
Line 135 VARIABLE LastIP
|
Line 153 VARIABLE LastIP
|
\ end formated debugger words |
\ end formated debugger words |
|
|
[ELSE] |
[ELSE] |
' \ alias \w immediate |
\ ' \ alias \w immediate |
|
|
: scanword ( body -- ) |
: scanword ( body -- ) |
c-init C-Output off |
c-init C-Output off |
Line 156 VARIABLE LastIP
|
Line 174 VARIABLE LastIP
|
: NoFine XPos off YPos off |
: NoFine XPos off YPos off |
NLFlag off Level off |
NLFlag off Level off |
C-Formated off |
C-Formated off |
[IFDEF] Colors Colors off [THEN] |
[ [IFDEF] Colors ] Colors off [ [THEN] ] |
; |
; |
|
|
: disp-step |
: disp-step |
Line 164 VARIABLE LastIP
|
Line 182 VARIABLE LastIP
|
\ Branches Off \ don't display |
\ Branches Off \ don't display |
\ \ BEGIN and THEN |
\ \ BEGIN and THEN |
cr |
cr |
\w YPos @ 1+ D-BugLine ! |
\ YPos @ 1+ D-BugLine ! |
\w Watcher |
\ w Watcher |
c-stop off |
c-stop off |
\w 0 D-BugLine @ at-xy |
\ w 0 D-BugLine @ at-xy |
Base @ hex IP @ 8 u.r space IP @ @ 8 u.r space |
Base @ hex dbg-ip @ 8 u.r space dbg-ip @ @ 8 u.r space |
Base ! |
Base ! |
NoFine 10 XPos ! |
NoFine 10 XPos ! |
\w D-Bugline @ YPos ! |
\ w D-Bugline @ YPos ! |
ip @ DisplayMode c-pass ! Analyse drop |
dbg-ip @ DisplayMode c-pass ! Analyse drop |
25 XPos @ - 0 max spaces ." -> " ; |
25 XPos @ - 0 max spaces ." -> " ; |
|
|
: get-next ( -- n | n n ) |
: get-next ( -- n | n n ) |
DebugMode c-pass ! |
DebugMode c-pass ! |
ip @ Analyse ; |
dbg-ip @ Analyse ; |
|
|
: jump ( addr -- ) |
: jump ( addr -- ) |
r> drop \ discard last ip |
r> drop \ discard last ip |
Line 185 VARIABLE LastIP
|
Line 203 VARIABLE LastIP
|
|
|
AVARIABLE DebugLoop |
AVARIABLE DebugLoop |
|
|
: breaker r> 1 cells - IP ! DebugLoop @ jump ; |
: breaker r> 1 cells - dbg-ip ! DebugLoop @ jump ; |
|
|
CREATE BP 0 , 0 , |
CREATE BP 0 , 0 , |
CREATE DT 0 , 0 , |
CREATE DT 0 , 0 , |
Line 206 VARIABLE Body
|
Line 224 VARIABLE Body
|
|
|
: NestXT ( xt -- true | body false ) |
: NestXT ( xt -- true | body false ) |
DebugMode c-pass ! C-Output off |
DebugMode c-pass ! C-Output off |
xtc C-Output on |
xt-see C-Output on |
c-pass @ DebugMode = dup |
c-pass @ DebugMode = dup |
IF ." Cannot debug" cr |
IF ." Cannot debug" cr |
THEN ; |
THEN ; |
Line 214 VARIABLE Body
|
Line 232 VARIABLE Body
|
VARIABLE Nesting |
VARIABLE Nesting |
|
|
: Leave-D |
: Leave-D |
[IFDEF] Colors Colors on [THEN] |
[ [IFDEF] Colors ] Colors on [ [THEN] ] |
C-Formated on |
C-Formated on |
C-Output on ; |
C-Output on ; |
|
|
Line 223 VARIABLE Unnest
|
Line 241 VARIABLE Unnest
|
: D-KEY ( -- flag ) |
: D-KEY ( -- flag ) |
BEGIN |
BEGIN |
Unnest @ IF 0 ELSE key THEN |
Unnest @ IF 0 ELSE key THEN |
CASE [char] n OF IP @ @ NestXT EXIT ENDOF |
CASE [char] n OF dbg-ip @ @ NestXT EXIT ENDOF |
[char] s OF Leave-D |
[char] s OF Leave-D |
-128 THROW ENDOF |
-128 THROW ENDOF |
[char] a OF Leave-D |
[char] a OF Leave-D |
Line 231 VARIABLE Unnest
|
Line 249 VARIABLE Unnest
|
[char] d OF Leave-D |
[char] d OF Leave-D |
cr ." Done..." cr |
cr ." Done..." cr |
Nesting off |
Nesting off |
r> drop IP @ >r |
r> drop dbg-ip @ >r |
EXIT ENDOF |
EXIT ENDOF |
[char] ? OF cr ." Nest Stop Done Unnest" cr |
[char] ? OF cr ." Nest Stop Done Unnest" cr |
ENDOF |
ENDOF |
Line 244 VARIABLE Unnest
|
Line 262 VARIABLE Unnest
|
0 Nesting ! |
0 Nesting ! |
BEGIN Unnest off |
BEGIN Unnest off |
cr ." Scanning code..." cr C-Formated on |
cr ." Scanning code..." cr C-Formated on |
dup scanword IP ! |
dup scanword dbg-ip ! |
cr ." Nesting debugger ready!" cr |
cr ." Nesting debugger ready!" cr |
\w WatcherInit 0 CT@ attr! page |
\ WatcherInit 0 CT@ attr! page |
BEGIN disp-step D-Key |
BEGIN disp-step D-Key |
WHILE C-Stop @ 0= |
WHILE C-Stop @ 0= |
WHILE 0 get-next set-bp |
WHILE 0 get-next set-bp |
IP @ jump |
dbg-ip @ jump |
[ here DebugLoop ! ] |
[ here DebugLoop ! ] |
restore-bp |
restore-bp |
d.s |
d.s |
REPEAT |
REPEAT |
Nesting @ 0= ?EXIT |
Nesting @ 0= IF EXIT THEN |
-1 Nesting +! r> |
-1 Nesting +! r> |
ELSE |
ELSE |
IP @ >r 1 Nesting +! |
dbg-ip @ 1 cells + >r 1 Nesting +! |
THEN |
THEN |
AGAIN ; |
AGAIN ; |
|
|
: dbg ' NestXT ?EXIT (debug) ; |
: dbg ' NestXT IF EXIT THEN (debug) Leave-D ; |
|
|
|
: break: |
|
r> ['] (debug) >body >r ; |
|
|
|
: (break") |
|
cr |
|
." BREAK AT: " type cr |
|
r> ['] (debug) >body >r ; |
|
|
\ : test 1 2 4 swap dup . ; |
: break" |
|
postpone s" |
|
postpone (break") ; immediate |