src/lib_9_decompiler.4th

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