[gforth] / gforth / debug.fs  

gforth: gforth/debug.fs

Diff for /gforth/debug.fs between version 1.11 and 1.15

version 1.11, Tue Mar 23 20:24:17 1999 UTC version 1.15, Fri May 12 07:55:41 2000 UTC
Line 20 
Line 20 
   
 decimal  decimal
   
 VARIABLE dbg-ip     \ istruction pointer for debugger  VARIABLE dbg-ip     \ instruction pointer for debugger
   
   \ !! move to see?
   
   : save-see-flags ( -- n* cnt )
     C-Output @
     C-Formated @ 1 ;
   
   : restore-see-flags ( n* cnt -- )
     drop C-Formated !
     C-Output ! ;
   
 : scanword ( body -- )  : scanword ( body -- )
           >r save-see-flags r>
         c-init C-Output off          c-init C-Output off
         ScanMode c-pass !          ScanMode c-pass !
         dup MakePass          dup MakePass
Line 30 
Line 41 
         0 XPos !          0 XPos !
         DisplayMode c-pass !          DisplayMode c-pass !
         MakePass          MakePass
         C-Output on ;          restore-see-flags ;
   
 : .n    0 <# # # # # #S #> ctype bl cemit ;  : .n    0 <# # # # # #S #> ctype bl cemit ;
   
Line 42 
Line 53 
                 C-Formated off                  C-Formated off
                 ;                  ;
   
 : disp-step  : Leave-D ;
   
   : disp-step ( -- )
   \ display step at current dbg-ip
         DisplayMode c-pass !            \ change to displaymode          DisplayMode c-pass !            \ change to displaymode
         cr          cr
         c-stop off          c-stop off
         Base @ hex dbg-ip @ 8 u.r space dbg-ip @ @ 8 u.r space          Base @ hex dbg-ip @ 8 u.r space dbg-ip @ @ 8 u.r space
         Base !          Base !
           save-see-flags
         NoFine 10 XPos !          NoFine 10 XPos !
         dbg-ip @ DisplayMode c-pass ! Analyse drop          dbg-ip @ DisplayMode c-pass ! Analyse drop
         25 XPos @ - 0 max spaces ." -> " ;          25 XPos @ - 0 max spaces ." -> "
           restore-see-flags ;
   
 : get-next ( -- n | n n )  : get-next ( -- n | n n )
         DebugMode c-pass !          DebugMode c-pass !
Line 94 
Line 110 
   
 VARIABLE Nesting  VARIABLE Nesting
   
 : Leave-D  
                 C-Formated on  
                 C-Output on ;  
   
 VARIABLE Unnest  VARIABLE Unnest
   
 : D-KEY         ( -- flag )  : D-KEY         ( -- flag )
Line 120 
Line 132 
                 ENDCASE                  ENDCASE
         AGAIN ;          AGAIN ;
   
 : (debug) ( body -- )  : (_debug) ( body ip -- )
         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 dbg-ip !                  swap scanword dbg-ip !
                 cr ." Nesting debugger ready!" cr                  cr ." Nesting debugger ready!" cr
                 BEGIN   d.s disp-step D-Key                  BEGIN   d.s disp-step D-Key
                 WHILE   C-Stop @ 0=                  WHILE   C-Stop @ 0=
Line 138 
Line 150 
                 ELSE                  ELSE
                 dbg-ip @ 1 cells + >r 1 Nesting +!                  dbg-ip @ 1 cells + >r 1 Nesting +!
                 THEN                  THEN
                   dup
         AGAIN ;          AGAIN ;
   
 : dbg \ gforth  : (debug) dup (_debug) ;
   
   : dbg ( "name" -- ) \ gforth
     ' NestXT IF EXIT THEN (debug) Leave-D ;      ' NestXT IF EXIT THEN (debug) Leave-D ;
   
 : break: \ gforth  : break:, ( -- )
     r> ['] (debug) >body >r ;    lastxt postpone literal ;
   
   : (break:)
       r> ['] (_debug) >body >r ;
   
   : break: ( -- ) \ gforth
       break:, postpone (break:) ; immediate
   
 : (break")  : (break")
     cr      cr
     ." BREAK AT: " type cr      ." BREAK AT: " type cr
     r> ['] (debug) >body >r ;      r> ['] (_debug) >body >r ;
   
 : break" \ gforth  : break" ( 'ccc"' -- ) \ gforth
       break:,
     postpone s"      postpone s"
     postpone (break") ; immediate      postpone (break") ; immediate

Generate output suitable for use with a patch program
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.15
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help