[openfirmware] r974 - forth/lib
svn at openfirmware.info
svn at openfirmware.info
Sat Oct 4 02:10:44 CEST 2008
Author: wmb
Date: 2008-10-04 02:10:44 +0200 (Sat, 04 Oct 2008)
New Revision: 974
Modified:
forth/lib/rstrace.fth
Log:
Generic rstrace command - decode do loop indices and catch frames.
Modified: forth/lib/rstrace.fth
===================================================================
--- forth/lib/rstrace.fth 2008-10-04 00:10:41 UTC (rev 973)
+++ forth/lib/rstrace.fth 2008-10-04 00:10:44 UTC (rev 974)
@@ -12,18 +12,57 @@
decimal
only forth also hidden also definitions
headerless
+: @+ ( adr -- adr' n ) dup na1+ swap @ ;
: .last-executed ( ip -- )
ip>token token@ ( acf )
dup reasonable-ip? if .name else drop ." ??" then
;
-: .traceline ( ipaddr -- )
- push-hex
- dup reasonable-ip?
- if dup .last-executed ip>token .caller else 9 u.r then cr
+: in-catch? ( ip -- flag ) find-cfa ['] catch = ;
+: .catch ( rs-adr -- rs-adr' )
+ ." Catch frame - SP: " @+ . ." my-self: " @+ . ." handler: " @+ .
+;
+1 bits/cell 1- lshift constant minus0
+: .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+ @ ( rs-adr n n2 )
+ 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 )
+ then ( rs-adr n )
+ then ( rs-adr n )
+ 9 u.r
+;
+: .traceline ( rs-adr -- rs-adr' )
+ push-hex ( rs-adr )
+ @+ ( rs-adr' ip )
+ dup reasonable-ip? if ( rs-adr ip )
+ dup in-catch? if ( rs-adr ip )
+ drop .catch ( rs-adr' )
+ else ( rs-adr ip )
+ dup .last-executed ip>token .caller ( rs-adr )
+ then ( rs-adr )
+ else ( rs-adr ip )
+ .do-or-n ( rs-adr )
+ then cr ( rs-adr )
pop-base
;
-: (rstrace ( bottom-adr top-adr -- )
- do i @ .traceline exit? ?leave /n +loop
+: (rstrace ( end-adr start-adr -- )
+ begin 2dup u> while ( end-adr adr )
+ .traceline ( end-adr adr' )
+ exit? if 2drop exit then ( end-adr adr )
+ repeat ( end-adr adr )
+ 2drop
;
headers
forth definitions
@@ -35,6 +74,7 @@
then
;
only forth also definitions
+
\ LICENSE_BEGIN
\ Copyright (c) 2006 FirmWorks
\
More information about the openfirmware
mailing list