[openfirmware] [commit] r2909 - forth/lib
repository service
svn at openfirmware.info
Wed Mar 21 23:14:02 CET 2012
Author: wmb
Date: Wed Mar 21 23:14:01 2012
New Revision: 2909
URL: http://tracker.coreboot.org/trac/openfirmware/changeset/2909
Log:
Decompiler - fixed the indentation logic (it sometimes messed up on repeated conditionals or loops) and added h#/d# number prefixes.
Modified:
forth/lib/decomp.fth
Modified: forth/lib/decomp.fth
==============================================================================
--- forth/lib/decomp.fth Wed Mar 21 06:42:47 2012 (r2908)
+++ forth/lib/decomp.fth Wed Mar 21 23:14:01 2012 (r2909)
@@ -54,7 +54,7 @@
defer (see)
hidden definitions
-d# 200 2* /n* constant /positions
+d# 300 2* /n* constant /positions
/positions buffer: positions
0 value end-positions
\ 0 value line-after-;
@@ -70,14 +70,14 @@
2 /n* +loop ( ip )
drop true ( true )
;
-0 value the-ip
+0 value decompiler-ip
: add-position ( ip -- )
- the-ip find-position if ( )
+ decompiler-ip find-position if ( )
end-positions positions /positions + >= ( flag )
abort" Decompiler position table overflow" ( )
end-positions dup 2 na+ is end-positions ( adr )
then ( adr )
- #out @ #line @ wljoin the-ip rot 2! ( )
+ #out @ #line @ wljoin decompiler-ip rot 2! ( )
;
: ip>position ( ip -- true | #out #line false )
find-position if ( )
@@ -91,10 +91,20 @@
ip>position 0= if at-xy then
;
+headers
+defer indent
+: (indent) ( -- ) lmargin @ #out @ - 0 max spaces ;
+' (indent) is indent
+headerless
+
+: +indent ( -- ) 3 lmargin +! cr ;
+: -indent ( -- ) ??cr -3 lmargin +! ;
+\ : <indent ( -- ) ??cr -3 lmargin +! indent 3 lmargin +! ;
+
headerless
\ Like ." but goes to a new line if needed.
: cr". ( adr len -- )
- dup ?line ( adr len )
+ dup ?line indent ( adr len )
add-position ( adr len )
magenta-letters type cancel ( )
;
@@ -198,21 +208,9 @@
then
;
-headers
-defer indent
-: (indent) ( -- )
- #out @ lmargin @ > if cr then
- lmargin @ #out @ - spaces
-;
-' (indent) is indent
-headerless
-
-: +indent ( -- ) 3 lmargin +! indent ;
-: -indent ( -- ) -3 lmargin +! indent ;
-: <indent ( -- ) -3 lmargin +! indent 3 lmargin +! ;
: .begin ( -- ) .." begin " +indent ;
-: .then ( -- ) -indent .." then " ;
+: .then ( -- ) -indent .." then" cr ;
\ Extent holds the largest known extent of the current word, as determined
\ by branch targets seen so far. This is used to decide if an exit should
@@ -220,10 +218,10 @@
variable extent extent off
: +extent ( possible-new-extent -- ) extent @ umax extent ! ;
: +branch ( ip-of-branch -- next-ip ) ta1+ /branch + ;
-: .endof ( ip -- ip' ) .." endof" indent +branch ;
-: .endcase ( ip -- ip' ) indent .." endcase" indent ta1+ ;
-: .$endof ( ip -- ip' ) .." $endof" indent +branch ;
-: .$endcase ( ip -- ip' ) indent .." $endcase" indent ta1+ ;
+: .endof ( ip -- ip' ) .." endof" cr +branch ;
+: .endcase ( ip -- ip' ) .." endcase" cr ta1+ ;
+: .$endof ( ip -- ip' ) .." $endof" cr +branch ;
+: .$endcase ( ip -- ip' ) .." $endcase" cr ta1+ ;
: add-break ( break-address break-type -- )
end-breaks @ breaks /breaks + >= ( adr,type full? )
@@ -283,36 +281,36 @@
: scan-;code ( ip -- ip' | 0 ) does-ip? 0= if drop 0 then ;
: .;code (s ip -- ip' )
does-ip? if
- cr lmargin @ spaces ." does> "
+ ??cr .." does> "
else
- 0 lmargin ! indent .." ;code " cr disassemble 0
+ ??cr 0 lmargin ! .." ;code " cr disassemble 0
then
;
: .branch ( ip -- ip' )
dup forward-branch? if
- <indent .." else" indent
+ -indent .." else" +indent
else
- -indent .." repeat "
+ -indent .." repeat" cr
then
+branch
;
: .?branch ( ip -- ip' )
dup forward-branch? if
dup while? if
- <indent .." while" indent
+ -indent .." while" +indent
else
- .." if " +indent
+ .." if" +indent
then
else
- -indent .." until "
+ -indent .." until " cr
then
+branch
;
: .do ( ip -- ip' ) .." do " +indent +branch ;
: .?do ( ip -- ip' ) .." ?do " +indent +branch ;
-: .loop ( ip -- ip' ) -indent .." loop " +branch ;
-: .+loop ( ip -- ip' ) -indent .." +loop " +branch ;
+: .loop ( ip -- ip' ) .." loop " cr +branch ;
+: .+loop ( ip -- ip' ) -indent .." +loop " cr +branch ;
: .of ( ip -- ip' ) .." of " +branch ;
: .$of ( ip -- ip' ) .." $of " +branch ;
@@ -343,8 +341,15 @@
: pretty-. ( n -- )
base @ d# 10 = if (.) else (u.) then ( adr len )
- dup ?line add-position
- green-letters type cancel space
+ dup 3 + ?line indent add-position
+ green-letters
+ base @ case
+ d# 10 of ." d# " endof
+ d# 16 of ." h# " endof
+ d# 8 of ." o# " endof
+ d# 2 of ." b# " endof
+ endcase
+ type cancel space
;
: .compiled ( ip -- ip' )
@@ -354,6 +359,7 @@
ta1+ ( ip' )
;
: .word ( ip -- ip' )
+ indent
dup token@ check-[compile] ( ip xt )
>name name>string ( ip adr len )
dup ?line add-position ( ip adr len )
@@ -378,7 +384,7 @@
headers
: skip-(') ( ip -- ip' ) ta1+ ta1+ ;
headerless
-: .is ( ip -- ip' ) .." to " ta1+ dup token@ .name ta1+ ;
+: .is ( ip -- ip' ) .." to " ta1+ dup token@ .name ta1+ ;
: .string ( ip -- ip' ) cword-name .string-tail +str ;
: .nstring ( ip -- ip' ) ta1+ dup ncount " n""" .string-tail +nstr ;
@@ -387,7 +393,7 @@
: .unnest ( ip -- ip' )
dup extent @ u>= if
- 0 lmargin ! indent .." ; " drop 0
+ ??cr 0 lmargin ! .." ;" drop 0
else
.." exit " ta1+
then
@@ -498,8 +504,9 @@
init-positions ( apf )
dup scan-pf next-break 3 lmargin ! indent ( apf )
begin ( adr )
- dup is the-ip ( adr )
- ?cr break-addr @ over = if ( adr )
+ dup is decompiler-ip ( adr )
+ ?cr ( adr )
+ break-addr @ over = if ( adr )
begin ( adr )
break-type @ execute ( adr )
next-break break-addr @ over <> ( adr done? )
@@ -525,7 +532,7 @@
pop-base
;
\ Display category of word
-: .: ( acf definer -- ) .definer space space >body .pf ;
+: .: ( acf definer -- ) .definer cr ( space space ) >body .pf ;
: debug-see ( apf -- )
page-mode? >r no-page
find-cfa ['] : .:
More information about the openfirmware
mailing list