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 -- )