--- gforth/debug.fs	1999/12/03 18:28:58	1.14
+++ gforth/debug.fs	2003/01/19 23:35:29	1.20
@@ -1,6 +1,6 @@
 \ DEBUG.FS     Debugger                                12jun93jaw
 
-\ Copyright (C) 1995,1996,1997 Free Software Foundation, Inc.
+\ Copyright (C) 1995-2003 Free Software Foundation, Inc.
 
 \ This file is part of Gforth.
 
@@ -16,13 +16,26 @@
 
 \ 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.
+\ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
+
+require see.fs
 
 decimal
 
 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 -- )
+        >r save-see-flags r>
         c-init C-Output off
         ScanMode c-pass !
         dup MakePass
@@ -30,7 +43,7 @@ VARIABLE dbg-ip     \ instruction pointe
         0 XPos !
         DisplayMode c-pass !
         MakePass
-        C-Output on ;
+        restore-see-flags ;
 
 : .n    0 <# # # # # #S #> ctype bl cemit ;
 
@@ -42,15 +55,20 @@ VARIABLE dbg-ip     \ instruction pointe
                 C-Formated off
                 ;
 
-: disp-step
+: Leave-D ;
+
+: disp-step ( -- )
+\ display step at current dbg-ip
         DisplayMode c-pass !            \ change to displaymode
         cr
         c-stop off
         Base @ hex dbg-ip @ 8 u.r space dbg-ip @ @ 8 u.r space
         Base !
+        save-see-flags
         NoFine 10 XPos !
         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 )
         DebugMode c-pass !
@@ -81,29 +99,47 @@ CREATE DT 0 , 0 ,
 
 VARIABLE Body
 
-: 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
-                xt-see C-Output on
-                c-pass @ DebugMode = dup
-                IF      ." Cannot debug" cr
-                THEN ;         
+: nestXT-checkSpecial ( xt -- xt2 | cfa xt2 ) 
+  dup >does-code IF
+    \ if nest into a does> we must leave
+    \ the body address on stack as does> does...
+    dup >body swap EXIT
+  THEN
+  dup ['] EXECUTE = IF   
+    \ xt to EXECUTE is next stack item...
+    drop EXIT 
+  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
 
-: Leave-D
-                C-Formated on
-                C-Output on ;
-
 VARIABLE Unnest
 
 : D-KEY         ( -- flag )
         BEGIN
                 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
                                         -128 THROW ENDOF
                         [char] a OF     Leave-D
@@ -120,11 +156,11 @@ VARIABLE Unnest
                 ENDCASE
         AGAIN ;
 
-: (debug) ( body -- )
+: (_debug) ( body ip -- )
         0 Nesting !
         BEGIN   Unnest off
                 cr ." Scanning code..." cr C-Formated on
-                dup scanword dbg-ip !
+                swap scanword dbg-ip !
                 cr ." Nesting debugger ready!" cr
                 BEGIN   d.s disp-step D-Key
                 WHILE   C-Stop @ 0=
@@ -138,21 +174,29 @@ VARIABLE Unnest
                 ELSE
                 dbg-ip @ 1 cells + >r 1 Nesting +!
                 THEN
+                dup
         AGAIN ;
 
+: (debug) dup (_debug) ;
+
 : dbg ( "name" -- ) \ gforth 
     ' NestXT IF EXIT THEN (debug) Leave-D ;
 
-has? compiler invert [IF] \ nac bugfix
+: break:, ( -- )
+  lastxt postpone literal ;
+
+: (break:)
+    r> ['] (_debug) >body >r ;
+  
 : break: ( -- ) \ gforth
-    r> ['] (debug) >body >r ;
+    break:, postpone (break:) ; immediate
 
 : (break")
     cr
     ." BREAK AT: " type cr
-    r> ['] (debug) >body >r ;
+    r> ['] (_debug) >body >r ;
 
 : break" ( 'ccc"' -- ) \ gforth
+    break:,
     postpone s"
     postpone (break") ; immediate
-[THEN]