Changeset 2909

Timestamp:

Mar 21, 2012 11:14:01 PM (15 months ago)

Author:

wmb

Message:

Decompiler - fixed the indentation logic (it sometimes messed up on repeated conditionals or loops) and added h#/d# number prefixes.

File:

• forth/lib/decomp.fth (modified) (14 diffs)

forth/lib/decomp.fth

@@ -55 +55 @@
 
 hidden definitions
-d# 200 2* /n* constant /positions
+d# 300 2* /n* constant /positions
 /positions buffer: positions
 0 value end-positions
@@ -71 +71 @@
    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 )
@@ -92 +92 @@
 ;
 
+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  ( )
@@ -199 +209 @@
 
 ;
-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
@@ -221 +219 @@
 : +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 -- )
@@ -284 +282 @@
 : .;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
@@ -300 +298 @@
   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
@@ -312 +310 @@
 : .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  ;
@@ -344 +342 @@
 : 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
 ;
 
@@ -355 +360 @@
 ;
 : .word         ( ip -- ip' )
+   indent
    dup token@ check-[compile]   ( ip xt )
    >name name>string            ( ip adr len )
@@ -379 +385 @@
 : 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  ;
@@ -388 +394 @@
 : .unnest     ( ip -- ip' )
    dup extent @ u>=  if
-      0 lmargin ! indent .." ; " drop   0
+      ??cr 0 lmargin ! .." ;" drop   0
    else
       .." exit " ta1+
@@ -499 +505 @@
    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 )
@@ -526 +533 @@
 ;
 \ 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