src/lib_8_decompiler.4th

   1 \ Decompilation
   2
   3 : VCFA>LATEST
   4         1+ @
   5 ;
   6
   7 : CLOSESTLINK ( addr vcfa -- lfa )
   8
   9         vcfa>latest dup         ( addr link link )
  10         rot dup -rot            ( link addr link addr )
  11         < if
  12                 2drop
  13                 0 exit
  14         then
  15
  16         swap    ( addr link )
  17         0 -rot  ( 0 addr link )
  18
  19         begin
  20                 rot drop        ( addr link )
  21                 dup -rot @      ( link addr nextlink )
  22                 2dup            ( link addr nextlink addr nextlink)
  23         > until
  24
  25         2drop
  26 ;
  27
  28 : MIN           ( n m -- max )
  29         2dup - 0> if
  30                 swap drop
  31         else
  32                 drop
  33         then
  34 ;
  35
  36 : BODYLEN ( cfa -- len )
  37
  38         here swap ( clink addr )
  39         context dup #context @ + swap
  40         do
  41                 dup i @
  42
  43                 closestlink ( clink addr clink' )
  44
  45                 ?dup 0> if
  46                         rot min
  47                         swap
  48                 then
  49         loop
  50
  51         -
  52 ;
  53
  54 : ?IMMEDIATE
  55         1+              ( skip over the link pointer )
  56         @               ( get the flags/length byte )
  57         F_IMMED AND     ( mask the F_IMMED flag and return it (as a truth value) )
  58 ;
  59
  60 : SEE
  61         BL WORD FIND    ( find the dictionary entry to decompile )
  62
  63         CR
  64
  65         0= IF
  66                 ." Word '" COUNT TYPE ." ' not found in dictionary."
  67                 EXIT
  68         THEN
  69
  70         DUP DUP BODYLEN + SWAP >LINK
  71
  72         DUP LINK> @ CASE
  73                 DOCOL OF
  74                         \ Colon definition
  75                         [CHAR] : EMIT SPACE DUP 1+ .NAME SPACE
  76                         DUP ?IMMEDIATE IF ." IMMEDIATE " THEN CR
  77                 ENDOF
  78                 DOVAR OF
  79                         \ Variable definition
  80                         ." Variable " DUP 1+ .NAME CR
  81                         2DROP EXIT
  82                 ENDOF
  83                 DOCON OF
  84                         \ Constant definition
  85                         ." Constant " DUP 1+ .NAME CR
  86                         2DROP EXIT
  87                 ENDOF
  88
  89                 \ Unknown codeword
  90                 ." Primitive or word with unrecognized codeword." CR
  91                 DROP 2DROP EXIT
  92         ENDCASE
  93
  94         4 SPACES
  95
  96         LINK> >BODY            ( get the data address, ie. points after DOCOL | end-of-word start-of-data )
  97
  98         ( now we start decompiling until we hit the end of the word )
  99         BEGIN           ( end start )
 100                 2DUP >
 101         WHILE
 102                 DUP @           ( end start codeword )
 103
 104                 CASE
 105                 ['] LIT OF                ( is it LIT ? )
 106                         1+ DUP @                ( get next word which is the integer constant )
 107                         .                       ( and print it )
 108                 ENDOF
 109                 ['] LITSTRING OF          ( is it LITSTRING ? )
 110                         [CHAR] S EMIT [CHAR] " EMIT SPACE ( print S"<space> )
 111                         1+ DUP @                ( get the length word )
 112                         SWAP 1+ SWAP            ( end start+1 length )
 113                         2DUP TYPE               ( print the string )
 114                         [CHAR] " EMIT SPACE          ( finish the string with a final quote )
 115                         +                       ( end start+1+len, aligned )
 116                         1-                     ( because we're about to add 4 below )
 117                 ENDOF
 118                 ['] 0BRANCH OF            ( is it 0BRANCH ? )
 119                         ." 0BRANCH ( "
 120                         1+ DUP @               ( print the offset )
 121                         .
 122                         ." ) "
 123                 ENDOF
 124                 ['] BRANCH OF             ( is it BRANCH ? )
 125                         ." BRANCH ( "
 126                         1+ DUP @               ( print the offset )
 127                         .
 128                         ." ) "
 129                 ENDOF
 130                 ['] ['] OF                  ( is it ['] ? )
 131                         ." ['] "
 132                         1+ DUP @               ( get the next codeword )
 133                         >NAME                    ( and force it to be printed as a dictionary entry )
 134                         .NAME SPACE
 135                 ENDOF
 136                 ['] EXIT OF               ( is it EXIT? )
 137                         ( We expect the last word to be EXIT, and if it is then we don't print it
 138                           because EXIT is normally implied by ;.  EXIT can also appear in the middle
 139                           of words, and then it needs to be printed. )
 140                         2DUP                    ( end start end start )
 141                         1+                     ( end start end start+1 )
 142                         <> IF                   ( end start | we're not at the end )
 143                                 ." EXIT "
 144                         THEN
 145                 ENDOF
 146                                         ( default case: )
 147                         DUP                     ( in the default case we always need to DUP before using )
 148                         >NAME                    ( look up the codeword to get the dictionary entry )
 149                         .NAME SPACE               ( and print it )
 150                 ENDCASE
 151
 152                 1+             ( end start+1 )
 153         REPEAT
 154
 155         [CHAR] ; EMIT CR
 156
 157         2DROP           ( restore stack )
 158 ;
 159