--- gforth/debug.fs	2000/09/23 15:46:52	1.17
+++ gforth/debug.fs	2007/12/31 18:40:23	1.26
@@ -1,12 +1,12 @@
 \ DEBUG.FS     Debugger                                12jun93jaw
 
-\ Copyright (C) 1995,1996,1997,2000 Free Software Foundation, Inc.
+\ Copyright (C) 1995,1996,1997,2000,2003,2004 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
+\ as published by the Free Software Foundation, either version 3
 \ of the License, or (at your option) any later version.
 
 \ This program is distributed in the hope that it will be useful,
@@ -15,8 +15,9 @@
 \ 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., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
+\ along with this program. If not, see http://www.gnu.org/licenses/.
+
+require see.fs
 
 decimal
 
@@ -43,17 +44,17 @@ VARIABLE dbg-ip     \ instruction pointe
         MakePass
         restore-see-flags ;
 
-: .n    0 <# # # # # #S #> ctype bl cemit ;
-
-: d.s   ." [ " depth . ." ] "
-        depth 4 min dup 0 ?DO dup i - pick .n LOOP drop ;
+: .n ( n -- )    0 <# # # # # #S #> ctype bl cemit ;
 
-: NoFine        XPos off YPos off
-                NLFlag off Level off
-                C-Formated off
-                ;
+: d.s   ( .. -- .. )  ." [ " depth . ." ] "
+    depth 4 min dup 0 ?DO dup i - pick .n LOOP drop ;
 
-: Leave-D ;
+: NoFine ( -- )
+    XPos off YPos off
+    NLFlag off Level off
+    C-Formated off ;
+		
+: Leave-D ( -- ) ;
 
 : disp-step ( -- )
 \ display step at current dbg-ip
@@ -73,17 +74,20 @@ VARIABLE dbg-ip     \ instruction pointe
         dbg-ip @ Analyse ;
 
 : jump          ( addr -- )
-                r> drop \ discard last ip
-                >r ;
+    r> drop \ discard last ip
+    >r ;
 
 AVARIABLE DebugLoop
 
-: breaker      r> 1 cells - dbg-ip ! DebugLoop @ jump ;
+1 cells Constant breaker-size \ !!! dependency: ITC
+
+: breaker ( R:body -- )
+    r> breaker-size - dbg-ip ! DebugLoop @ jump ;
 
 CREATE BP 0 , 0 ,
 CREATE DT 0 , 0 ,
 
-: set-bp        ( 0 n | 0 n n -- )
+: set-bp        ( 0 n | 0 n n -- ) \ !!! dependency: ITC
                 0. BP 2!
                 ?dup IF dup BP ! dup @ DT !
                         ['] Breaker swap !
@@ -91,22 +95,47 @@ CREATE DT 0 , 0 ,
                                 ['] Breaker swap ! drop THEN
                      THEN ;
 
-: restore-bp    ( -- )
-                BP @ ?dup IF DT @ swap ! THEN
-                BP cell+ @ ?dup IF DT cell+ @ swap ! THEN ;
+: restore-bp    ( -- ) \ !!! dependency: ITC
+    BP @ ?dup IF DT @ swap ! THEN
+    BP cell+ @ ?dup IF DT cell+ @ swap ! THEN ;
 
 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 ['] call = IF
+	drop dbg-ip @ cell+ @ body>  EXIT
+    THEN
+    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
 
@@ -115,7 +144,7 @@ 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
@@ -148,7 +177,7 @@ VARIABLE Unnest
                 Nesting @ 0= IF EXIT THEN
                 -1 Nesting +! r>
                 ELSE
-                dbg-ip @ 1 cells + >r 1 Nesting +!
+                get-next >r 1 Nesting +!
                 THEN
                 dup
         AGAIN ;
@@ -159,7 +188,7 @@ VARIABLE Unnest
     ' NestXT IF EXIT THEN (debug) Leave-D ;
 
 : break:, ( -- )
-  lastxt postpone literal ;
+  latestxt postpone literal ;
 
 : (break:)
     r> ['] (_debug) >body >r ;