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.