version 1.1, 1994/02/11 16:30:45
|
version 1.12, 1999/05/20 13:31:57
|
Line 1
|
Line 1
|
\ DEBUG.FS Debugger 12jun93jaw |
\ DEBUG.FS Debugger 12jun93jaw |
|
|
decimal |
\ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc. |
|
|
VARIABLE IP \ istruction pointer for debugger |
|
|
|
\ Formated debugger words 12jun93jaw |
|
|
|
false [IF] |
|
|
|
Color: Men# |
|
<A red >b yellow >f bold A> Men# CT! |
|
|
|
CREATE D-LineIP 80 cells allot |
\ This file is part of Gforth. |
CREATE D-XPos 300 chars allot align |
|
CREATE D-LineA 80 cells allot |
|
VARIABLE ^LineA |
|
|
|
VARIABLE D-Lines |
\ Gforth is free software; you can redistribute it and/or |
VARIABLE D-Line |
\ modify it under the terms of the GNU General Public License |
VARIABLE D-MaxLines 10 D-MaxLines ! |
\ as published by the Free Software Foundation; either version 2 |
VARIABLE D-Bugline |
\ 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. |
|
|
: WatcherInit |
decimal |
D-MaxLines @ 3 + YPos ! 0 D-Line ! ; |
|
|
|
: (lines) |
|
1 cells ^LineA +! |
|
O-PNT@ ^LineA @ ! ; |
|
|
|
VARIABLE Body |
|
|
|
: ScanWord ( body -- ) |
|
dup body ! |
|
c-init |
|
ScanMode c-pass ! |
|
C-Formated on 0 Level ! |
|
C-ClearLine on |
|
Colors on |
|
0 XPos ! 0 YPos ! |
|
O-INIT |
|
dup MakePass |
|
DisplayMode c-pass ! |
|
c-stop off |
|
D-LineIP 80 cells erase |
|
0 D-Lines ! dup D-LineIP ! |
|
O-PNT@ D-LineA ! D-LineA ^LineA ! |
|
['] (lines) IS nlcount |
|
XPos @ D-XPos c! |
|
BEGIN analyse |
|
D-Lines @ YPos @ <> |
|
IF YPos @ D-Lines ! |
|
dup YPos @ cells D-LineIP + ! |
|
THEN |
|
XPos @ over Body @ - 0 1 cells um/mod nip chars |
|
D-XPos + c! |
|
C-Stop @ |
|
UNTIL drop |
|
O-PNT@ YPos @ 1+ cells D-LineA + ! |
|
-1 YPos @ 1+ cells D-LineIP + ! |
|
O-DEINIT |
|
C-Formated off |
|
0 D-Line ! |
|
['] noop IS nlcount ; |
|
|
|
: SearchLine ( addr -- n ) |
|
D-LineIP D-Lines @ 0 |
|
?DO dup @ 2 pick U> IF 2drop I 1- UNLOOP EXIT THEN |
|
cell+ |
|
LOOP 2drop 0 ; |
|
|
|
: Display ( n -- ) |
|
dup cells D-LineA + @ O-Buffer + |
|
swap D-MaxLines @ + D-Lines @ min 1+ |
|
cells D-LineA + @ O-Buffer + |
|
over - type ; |
|
|
|
\ [IFDEF] Green Colors on [THEN] |
|
\ dup D-TableL + C@ dup Level ! dup XPos ! spaces 0 YPos ! |
|
\ D-LineIP + @ C-Stop off |
|
\ BEGIN |
|
\ [IFDEF] Green IP @ over = |
|
\ IF hig# C-Highlight ! ELSE C-Highlight off THEN |
|
\ [THEN] |
|
\ Analyse |
|
\ C-Stop @ YPos @ D-MaxLines @ u>= or |
|
\ UNTIL drop ; |
|
|
|
: TopLine |
|
0 0 at-xy |
|
Men# CT@ attr! |
|
." OSB-DEBUG (C) 1993 by Jens A. Wilke" cr cr |
|
\ one step beyond |
|
0 CT@ attr! ; |
|
|
|
: BottomLine |
|
0 D-MaxLines @ 3 + at-xy |
|
Men# CT@ attr! |
|
." U-nnest D-one N-est A-bort" cr |
|
0 CT@ attr! ; |
|
|
|
VARIABLE LastIP |
|
|
|
: (supress) |
|
YPos @ D-MaxLines @ U>= |
|
IF c-output off THEN ; |
|
|
|
: DispIP |
|
['] (supress) IS nlcount |
|
dup SearchLine D-Line @ - dup YPos ! 2 + |
|
over Body @ - 0 1 cells um/mod nip chars D-XPos + c@ |
|
swap AT-XY |
|
Analyse drop |
|
['] noop IS nlcount |
|
c-output on ; |
|
|
|
: Watcher ( -- ) |
|
TopLine |
|
IP @ SearchLine dup D-Line @ dup D-MaxLines @ + |
|
within |
|
IF drop D-Line @ Display |
|
ELSE D-MaxLines @ 2/ - 0 max dup D-Line ! |
|
Display |
|
THEN |
|
C-Formated off Colors on |
|
\ LastIP @ ?DUP IF DispIP THEN |
|
Hig# C-Highlight ! |
|
IP @ DispIP IP @ LastIP ! |
|
C-Formated on C-Highlight off |
|
BottomLine ; |
|
|
|
|
|
' noop ALIAS \w immediate |
|
|
|
\ end formated debugger words |
|
|
|
[ELSE] |
VARIABLE dbg-ip \ istruction pointer for debugger |
' \ alias \w immediate |
|
|
|
: scanword ( body -- ) |
: scanword ( body -- ) |
c-init C-Output off |
c-init C-Output off |
Line 146 VARIABLE LastIP
|
Line 31 VARIABLE LastIP
|
DisplayMode c-pass ! |
DisplayMode c-pass ! |
MakePass |
MakePass |
C-Output on ; |
C-Output on ; |
[THEN] |
|
|
|
: .n 0 <# # # # # #S #> ctype bl cemit ; |
: .n 0 <# # # # # #S #> ctype bl cemit ; |
|
|
Line 156 VARIABLE LastIP
|
Line 40 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] |
|
; |
; |
|
|
: disp-step |
: disp-step |
DisplayMode c-pass ! \ change to displaymode |
DisplayMode c-pass ! \ change to displaymode |
\ Branches Off \ don't display |
|
\ \ BEGIN and THEN |
|
cr |
cr |
\w YPos @ 1+ D-BugLine ! |
|
\w Watcher |
|
c-stop off |
c-stop off |
\w 0 D-BugLine @ at-xy |
Base @ hex dbg-ip @ 8 u.r space dbg-ip @ @ 8 u.r space |
Base @ hex IP @ 8 u.r space IP @ @ 8 u.r space |
|
Base ! |
Base ! |
NoFine 10 XPos ! |
NoFine 10 XPos ! |
\w D-Bugline @ YPos ! |
dbg-ip @ DisplayMode c-pass ! Analyse drop |
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 62 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 205 CREATE DT 0 , 0 ,
|
Line 82 CREATE DT 0 , 0 ,
|
VARIABLE Body |
VARIABLE Body |
|
|
: NestXT ( xt -- true | body false ) |
: NestXT ( xt -- true | body false ) |
|
\ special deal for create does> words |
|
\ leaves body address on the stack |
|
dup >does-code IF dup >body swap THEN |
|
|
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 95 VARIABLE Body
|
VARIABLE Nesting |
VARIABLE Nesting |
|
|
: Leave-D |
: Leave-D |
[IFDEF] Colors Colors on [THEN] |
|
C-Formated on |
C-Formated on |
C-Output on ; |
C-Output on ; |
|
|
Line 223 VARIABLE Unnest
|
Line 103 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 111 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 124 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 |
BEGIN d.s 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 |
|
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 \ gforth |
|
' NestXT IF EXIT THEN (debug) Leave-D ; |
|
|
: test 1 2 4 swap dup . ; |
has? compiler [IF] |
|
: break: \ gforth |
|
r> ['] (debug) >body >r ; |
|
|
|
: (break") |
|
cr |
|
." BREAK AT: " type cr |
|
r> ['] (debug) >body >r ; |
|
|
|
: break" \ gforth |
|
postpone s" |
|
postpone (break") ; immediate |
|
[THEN] |
|
|