Diff for /gforth/debug.fs between versions 1.16 and 1.21

version 1.16, 2000/09/23 15:05:59 version 1.21, 2003/01/20 17:07:37
Line 16 Line 16
   
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software  \ along with this program; if not, write to the Free Software
 \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   
   require see.fs
   
 decimal  decimal
   
Line 97  CREATE DT 0 , 0 , Line 99  CREATE DT 0 , 0 ,
   
 VARIABLE Body  VARIABLE Body
   
 : NestXT        ( xt -- true | body false )  : nestXT-checkSpecial ( xt -- xt2 | cfa xt2 ) 
                 \ special deal for create does> words    dup >does-code IF
                 \ leaves body address on the stack      \ if nest into a does> we must leave
                 dup >does-code IF dup >body swap THEN      \ the body address on stack as does> does...
       dup >body swap EXIT
                 DebugMode c-pass ! C-Output off    THEN
                 xt-see C-Output on    dup ['] EXECUTE = IF   
                 c-pass @ DebugMode = dup      \ xt to EXECUTE is next stack item...
                 IF      ." Cannot debug" cr      drop EXIT 
                 THEN ;             THEN
     dup ['] PERFORM = IF
       \ xt to EXECUTE is addressed by next stack item
       drop @ EXIT 
     THEN
     BEGIN
       dup >code-address dodefer: =
       WHILE
         \ load xt of DEFERed word
         cr ." nesting defered..." 
         >body @    
     REPEAT ;
   
   : nestXT ( xt -- true | body false )
   \G return true if we are not able to debug this, 
   \G body and false otherwise
     nestXT-checkSpecial 
     \ scan code with xt-see
     DebugMode c-pass ! C-Output off
     xt-see C-Output on
     c-pass @ DebugMode = dup
     IF      cr ." Cannot debug!!"
     THEN ;
   
 VARIABLE Nesting  VARIABLE Nesting
   
Line 115  VARIABLE Unnest Line 139  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     dbg-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

Removed from v.1.16  
changed lines
  Added in v.1.21


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