Index: debug.fs

===================================================================

RCS file: /usr/local/lib/cvs-repository/src-master/gforth/debug.fs,v

retrieving revision 1.23

retrieving revision 1.24

diff -u -r1.23 -r1.24

--- debug.fs	2003/03/22 10:04:06	1.23

+++ debug.fs	2004/06/19 15:32:31	1.24

@@ -45,18 +45,18 @@

         MakePass

         restore-see-flags ;

-: .n    0 <# # # # # #S #> ctype bl cemit ;

+: .n ( n -- )    0 <# # # # # #S #> ctype bl cemit ;

-: d.s   ." [ " depth . ." ] "

-        depth 4 min dup 0 ?DO dup i - pick .n LOOP drop ;

+: d.s   ( .. -- .. )  ." [ " depth . ." ] "

+    depth 4 min dup 0 ?DO dup i - pick .n LOOP drop ;

-: NoFine        XPos off YPos off

-                NLFlag off Level off

-                C-Formated off

-                ;

+: NoFine ( -- )

+    XPos off YPos off

+    NLFlag off Level off

+    C-Formated off ;

+		

+: Leave-D ( -- ) ;

-: Leave-D ;

-

 : disp-step ( -- )

 \ display step at current dbg-ip

         DisplayMode c-pass !            \ change to displaymode

@@ -75,17 +75,20 @@

         dbg-ip @ Analyse ;

 : jump          ( addr -- )

-                r> drop \ discard last ip

-                >r ;

+    r> drop \ discard last ip

+    >r ;

 AVARIABLE DebugLoop

+

+1 cells Constant breaker-size \ !!! dependency: ITC

-: breaker      r> 1 cells - dbg-ip ! DebugLoop @ jump ;

+: 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 !

@@ -93,33 +96,36 @@

                                 ['] 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-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: =

+: 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 ;

+	    \ 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, 

@@ -172,7 +178,7 @@

                 Nesting @ 0= IF EXIT THEN

                 -1 Nesting +! r>

                 ELSE

-                dbg-ip @ 1 cells + >r 1 Nesting +!

+                get-next >r 1 Nesting +!

                 THEN

                 dup

         AGAIN ;

Index: see.fs

===================================================================

RCS file: /usr/local/lib/cvs-repository/src-master/gforth/see.fs,v

retrieving revision 1.53

retrieving revision 1.54

diff -u -r1.53 -r1.54

--- see.fs	2004/01/13 16:00:55	1.53

+++ see.fs	2004/06/19 15:32:31	1.54

@@ -454,13 +454,13 @@

                 THEN

         THEN

         Debug?

-        IF      dup @ +

+        IF      @ \ !!! cross-interacts with debugger !!!

         ELSE    cell+

         THEN ;

 : DebugBranch

         Debug?

-        IF      dup @ over + swap THEN ; \ return 2 different addresses

+        IF      dup @ swap THEN ; \ return 2 different addresses

 : c-?branch

         Scan?

@@ -494,7 +494,7 @@

         Display? IF nl S" FOR" .struc level+ THEN ;

 : c-loop

-        Display? IF level- nl .name-without bl cemit nl THEN

+        Display? IF level- nl .name-without nl bl cemit THEN

         DebugBranch cell+ 

 	Scan? 

 	IF 	dup BranchAddr? 

@@ -513,13 +513,16 @@

     THEN

     DebugBranch cell+ ;

-: c-exit  dup 1 cells -

-        CheckEnd

-        IF      Display? IF nlflag off S" ;" Com# .string THEN

-                C-Stop on

-        ELSE    Display? IF S" EXIT " .struc THEN

-        THEN

-        Debug? IF drop THEN ;

+: c-exit ( addr1 -- addr2 )

+    dup 1 cells -

+    CheckEnd

+    IF

+	Display? IF nlflag off S" ;" Com# .string THEN

+	C-Stop on

+    ELSE

+	Display? IF S" EXIT " .struc THEN

+    THEN

+    Debug? IF drop THEN ; \ !!! cross-interacts with debugger !!!

 : c-abort"

         count 2dup + aligned -rot