src/lib_7_decompiler.4th

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