[BACK]Return to debug.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/debug.fs between versions 1.1 and 1.9

version 1.1, 1994/02/11 16:30:45 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
Removed from v.1.1  
changed lines
  Added in v.1.9

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>