Changeset 2909


Ignore:
Timestamp:
Mar 21, 2012, 11:14:01 PM (3 years 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:
1 edited

Legend:

Unmodified
Added
Removed
  • forth/lib/decomp.fth

    r2904 r2909  
    5555 
    5656hidden definitions 
    57 d# 200 2* /n* constant /positions 
     57d# 300 2* /n* constant /positions 
    5858/positions buffer: positions 
    59590 value end-positions 
     
    7171   drop true                      ( true ) 
    7272; 
    73 0 value the-ip 
     730 value decompiler-ip 
    7474: add-position  ( ip -- ) 
    75    the-ip find-position  if                        ( ) 
     75   decompiler-ip find-position  if                 ( ) 
    7676      end-positions  positions /positions +  >=    ( flag ) 
    7777      abort" Decompiler position table overflow"   ( ) 
    7878      end-positions  dup 2 na+  is end-positions   ( adr ) 
    7979   then                                            ( adr ) 
    80    #out @ #line @ wljoin  the-ip  rot 2!           ( ) 
     80   #out @ #line @ wljoin  decompiler-ip  rot 2!    ( ) 
    8181; 
    8282: ip>position  ( ip -- true | #out #line false ) 
     
    9292; 
    9393 
     94headers 
     95defer indent 
     96: (indent)  ( -- )  lmargin @ #out @ - 0 max spaces  ; 
     97' (indent) is indent 
     98headerless 
     99 
     100: +indent  ( -- )   3 lmargin +!  cr  ; 
     101: -indent  ( -- )  ??cr -3 lmargin +!  ; 
     102\ : <indent  ( -- )  ??cr -3 lmargin +!  indent  3 lmargin +!   ; 
     103 
    94104headerless 
    95105\ Like ." but goes to a new line if needed. 
    96106: cr".  ( adr len -- ) 
    97    dup ?line                    ( adr len ) 
     107   dup ?line  indent            ( adr len ) 
    98108   add-position                 ( adr len ) 
    99109   magenta-letters type cancel  ( ) 
     
    199209 
    200210; 
    201 headers 
    202 defer indent 
    203 : (indent)  ( -- ) 
    204   #out @ lmargin @ >  if  cr  then 
    205   lmargin @ #out @ - spaces 
    206 ; 
    207 ' (indent) is indent 
    208 headerless 
    209  
    210 : +indent  ( -- )   3 lmargin +!  indent  ; 
    211 : -indent  ( -- )  -3 lmargin +!  indent  ; 
    212 : <indent  ( -- )  -3 lmargin +!  indent  3 lmargin +!   ; 
    213211 
    214212: .begin  ( -- )  .." begin " +indent  ; 
    215 : .then   ( -- )  -indent .." then  "  ; 
     213: .then   ( -- )  -indent .." then"  cr  ; 
    216214 
    217215\ Extent holds the largest known extent of the current word, as determined 
     
    221219: +extent  ( possible-new-extent -- )  extent @ umax extent !  ; 
    222220: +branch  ( ip-of-branch -- next-ip )  ta1+ /branch +  ; 
    223 : .endof  ( ip -- ip' )  .." endof" indent +branch  ; 
    224 : .endcase  ( ip -- ip' )  indent .." endcase" indent ta1+  ; 
    225 : .$endof  ( ip -- ip' )  .." $endof" indent +branch  ; 
    226 : .$endcase  ( ip -- ip' )  indent .." $endcase" indent ta1+  ; 
     221: .endof  ( ip -- ip' )  .." endof" cr +branch  ; 
     222: .endcase  ( ip -- ip' )  .." endcase" cr ta1+  ; 
     223: .$endof  ( ip -- ip' )  .." $endof" cr +branch  ; 
     224: .$endcase  ( ip -- ip' )  .." $endcase" cr ta1+  ; 
    227225 
    228226: add-break  ( break-address break-type -- ) 
     
    284282: .;code    (s ip -- ip' ) 
    285283   does-ip?  if 
    286       cr lmargin @ spaces ." does> " 
     284      ??cr .." does> " 
    287285   else 
    288       0 lmargin ! indent .." ;code "  cr disassemble     0 
     286      ??cr 0 lmargin ! .." ;code "  cr disassemble     0 
    289287   then 
    290288; 
    291289: .branch  ( ip -- ip' ) 
    292290   dup forward-branch?  if 
    293       <indent .." else" indent 
     291      -indent .." else" +indent 
    294292   else 
    295       -indent .." repeat " 
     293      -indent .." repeat" cr 
    296294   then 
    297295   +branch 
     
    300298  dup forward-branch?  if 
    301299     dup while?  if 
    302         <indent .." while" indent 
     300        -indent .." while" +indent 
    303301     else 
    304         .." if    "  +indent 
     302        .." if"  +indent 
    305303     then 
    306304  else 
    307      -indent .." until " 
     305     -indent .." until " cr 
    308306  then 
    309307  +branch 
     
    312310: .do     ( ip -- ip' )  .." do    " +indent  +branch  ; 
    313311: .?do    ( ip -- ip' )  .." ?do   " +indent  +branch  ; 
    314 : .loop   ( ip -- ip' )  -indent .." loop  " +branch  ; 
    315 : .+loop  ( ip -- ip' )  -indent .." +loop " +branch  ; 
     312: .loop   ( ip -- ip' )  .." loop  " cr +branch  ; 
     313: .+loop  ( ip -- ip' )  -indent .." +loop " cr +branch  ; 
    316314: .of     ( ip -- ip' )  .." of   " +branch  ; 
    317315: .$of    ( ip -- ip' )  .." $of  " +branch  ; 
     
    344342: pretty-. ( n -- ) 
    345343   base @ d# 10 =  if  (.)  else  (u.)  then   ( adr len ) 
    346    dup ?line  add-position 
    347    green-letters type cancel  space 
     344   dup 3 + ?line  indent  add-position 
     345   green-letters  
     346   base @ case 
     347      d# 10 of  ." d# "  endof 
     348      d# 16 of  ." h# "  endof 
     349      d#  8 of  ." o# "  endof 
     350      d#  2 of  ." b# "  endof 
     351   endcase 
     352   type cancel  space 
    348353; 
    349354 
     
    355360; 
    356361: .word         ( ip -- ip' ) 
     362   indent 
    357363   dup token@ check-[compile]   ( ip xt ) 
    358364   >name name>string            ( ip adr len ) 
     
    379385: skip-(')      ( ip -- ip' )  ta1+ ta1+  ; 
    380386headerless 
    381 : .is           ( ip -- ip' )  .." to "  ta1+ dup token@ .name  ta1+ ; 
     387: .is           ( ip -- ip' )  .." to "  ta1+ dup token@ .name  ta1+  ; 
    382388: .string       ( ip -- ip' )  cword-name              .string-tail +str   ; 
    383389: .nstring      ( ip -- ip' )  ta1+  dup ncount " n""" .string-tail +nstr  ; 
     
    388394: .unnest     ( ip -- ip' ) 
    389395   dup extent @ u>=  if 
    390       0 lmargin ! indent .." ; " drop   0 
     396      ??cr 0 lmargin ! .." ;" drop   0 
    391397   else 
    392398      .." exit " ta1+ 
     
    499505   dup scan-pf next-break 3 lmargin ! indent          ( apf ) 
    500506   begin                                              ( adr ) 
    501       dup is the-ip                                   ( adr ) 
    502       ?cr  break-addr @ over =  if                    ( adr ) 
     507      dup is decompiler-ip                            ( adr ) 
     508      ?cr                                             ( adr ) 
     509      break-addr @ over =  if                         ( adr ) 
    503510         begin                                        ( adr ) 
    504511            break-type @ execute                      ( adr ) 
     
    526533; 
    527534\ Display category of word 
    528 : .:           ( acf definer -- )  .definer space space >body  .pf   ; 
     535: .:           ( acf definer -- )  .definer cr ( space space ) >body  .pf   ; 
    529536: debug-see    ( apf -- ) 
    530537   page-mode? >r  no-page 
Note: See TracChangeset for help on using the changeset viewer.