[openfirmware] [commit] r3346 - forth/lib

[repository service]

Author: wmb
Date: Tue Oct  2 02:59:50 2012
New Revision: 3346
URL: http://tracker.coreboot.org/trac/openfirmware/changeset/3346

Log:
Debugger - the "up" keystroke ('U') was not working when debugging inside a do .. loop due to misinterpreting a pointer to the loop end address as a return address.

Modified:
   forth/lib/debug.fth
   forth/lib/rstrace.fth

Modified: forth/lib/debug.fth
==============================================================================
--- forth/lib/debug.fth	Tue Oct  2 02:26:16 2012	(r3345)
+++ forth/lib/debug.fth	Tue Oct  2 02:59:50 2012	(r3346)
@@ -87,24 +87,28 @@
 headerless
 \ Go up the return stack until we find an interesting caller
 : up1  ( rp -- )
-   begin  na1+  dup rp0 @ <>  while          ( rs-adr )
-      dup @                                  ( rs-adr ip )
-      dup in-dictionary?  if                 ( rs-adr ip )
-         find-cfa  dup indirect-call?  if    ( rs-adr xt )
-            drop                             ( rs-adr )
-         else                                ( rs-adr xt )
-            nip                              ( rs-adr )
-            scrolling-debug?  if             ( xt )
-               cr ." [ Up to " dup .name ." ]" cr
-            then                             ( xt )
-            (debug                           ( )
-            exit                             ( -- )
-         then                                ( rs-adr )
-      else                                   ( rs-adr ip )
-         drop                                ( rs-adr )
-      then                                   ( rs-adr )
-   repeat                                    ( rs-adr )
-   drop                                      ( )
+   begin  na1+  dup rp0 @ <>  while             ( rs-adr )
+      dup @                                     ( rs-adr ip )
+      dup in-dictionary?  if                    ( rs-adr ip )
+	 dup loop-end?  if                      ( rs-adr ip )
+	    drop                                ( rs-adr )
+         else                                   ( rs-adr ip )
+            find-cfa  dup indirect-call?  if    ( rs-adr xt )
+ 	       drop                             ( rs-adr )
+            else                                ( rs-adr xt )
+               nip                              ( rs-adr )
+               scrolling-debug?  if             ( xt )
+                  cr ." [ Up to " dup .name ." ]" cr
+               then                             ( xt )
+               (debug                           ( )
+               exit                             ( -- )
+            then                                ( rs-adr )
+         then                                   ( rs-adr )
+      else                                      ( rs-adr )
+         drop                                   ( rs-adr )
+      then                                      ( rs-adr )
+   repeat                                       ( rs-adr )
+   drop                                         ( )
 ;
 
 defer to-debug-window  ' noop is to-debug-window

Modified: forth/lib/rstrace.fth
==============================================================================
--- forth/lib/rstrace.fth	Tue Oct  2 02:26:16 2012	(r3345)
+++ forth/lib/rstrace.fth	Tue Oct  2 02:59:50 2012	(r3346)
@@ -22,29 +22,32 @@
    ."    Catch frame - SP: " @+ .  ."   my-self: "  @+ .  ."   handler: "  @+ .
 ;
 1 bits/cell 1- lshift constant minus0
+: loop-end?  ( adr -- flag )
+   dup reasonable-ip?  0=  if    ( adr )
+      drop false exit            ( -- false )
+   then                          ( adr )
+   dup @ +                       ( adr' )
+   dup reasonable-ip?  0=  if    ( adr )
+      drop false exit            ( -- false )
+   then                          ( adr )
+   ip>token  -1 na+  token@      ( xt )
+   dup ['] (loop) =  swap ['] (+loop) =  or  ( flag )
+;
+
 : .do-or-n  ( rs-adr n -- rs-adr' )
    over @ reasonable-ip?  0=  if              ( rs-adr n )
       \ The second number is not an IP so it could be a do loop frame
-      over na1+ @  reasonable-ip?  if         ( rs-adr n )
-         \ The third entry is a reasonable IP so it could be a do loop frame
-         \ Make sure it points just past a loop end
-         over na1+ @  dup @ +                 ( rs-adr n n2 )
-         dup reasonable-ip?  if               ( rs-adr n adr )
-            ip>token  -1 na+  token@          ( rs-adr n xt )
-            dup ['] (loop) =  swap ['] (+loop) =  or  if  ( rs-adr n )
-               \ The two numbers span the +- boundary, so probably a do loop
-               ."    Do loop frame inside "
-               over na1+ @ ip>token .current-word ( rs-adr n )
-               over @                             ( rs-adr n n1 )
-               ."   i: "  tuck + .                ( rs-adr n1 )
-               ."   limit: "  minus0  + .         ( rs-adr )
-               2 na+ exit
-            then                               ( rs-adr n )
-         else                                  ( rs-adr n n2 )
-            drop                               ( rs-adr n )
-         then                                  ( rs-adr n )
-      then                                     ( rs-adr n )
-   then                                        ( rs-adr n )
+      over na1+ @                             ( rs-adr n n2 )
+      dup loop-end?  if                       ( rs-adr n n2 )
+         ."    Do loop frame inside "
+         ip>token .current-word               ( rs-adr n )
+         over @                               ( rs-adr n n1 )
+         ."   i: "  tuck + .                  ( rs-adr n1 )
+         ."   limit: "  minus0  + .           ( rs-adr )
+         2 na+ exit                           ( -- rs-adr' )
+      then                                    ( rs-adr n n2 )
+      drop                                    ( rs-adr n )
+   then                                       ( rs-adr n )
    9 u.r
 ;
 : .traceline  ( ipaddr -- )