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 : SEE
  37         BL WORD FIND    ( find the dictionary entry to decompile )
  38
  39         CR
  40
  41         0= IF
  42                 ." Word '" COUNT TYPE ." ' not found in dictionary."
  43                 EXIT
  44         THEN
  45
  46         >LINK
  47
  48         ( Now we search again, looking for the next word in the dictionary.  This gives us
  49           the length of the word that we will be decompiling.  (Well, mostly it does). )
  50         HERE          ( address of the end of the last compiled word )
  51         LATEST @        ( word last curr )
  52         BEGIN
  53                 2 PICK          ( word last curr word )
  54                 OVER            ( word last curr word curr )
  55                 <>              ( word last curr word<>curr? )
  56         WHILE                   ( word last curr )
  57                 NIP             ( word curr )
  58                 DUP @           ( word curr prev (which becomes: word last curr) )
  59         REPEAT
  60
  61         DROP            ( at this point, the stack is: start-of-word end-of-word )
  62         SWAP            ( end-of-word start-of-word )
  63
  64         DUP LINK> @ CASE
  65                 DOCOL OF
  66                         \ Colon definition
  67                         [CHAR] : EMIT SPACE DUP 1+ .NAME SPACE
  68                         DUP ?IMMEDIATE IF ." IMMEDIATE " THEN CR
  69                 ENDOF
  70                 DOVAR OF
  71                         \ Variable definition
  72                         ." Variable " DUP 1+ .NAME CR
  73                         2DROP EXIT
  74                 ENDOF
  75                 DOCON OF
  76                         \ Constant definition
  77                         ." Constant " DUP 1+ .NAME CR
  78                         2DROP EXIT
  79                 ENDOF
  80
  81                 \ Unknown codeword
  82                 ." Primitive or word with unrecognized codeword." CR
  83                 DROP 2DROP EXIT
  84         ENDCASE
  85
  86         4 SPACES
  87
  88         LINK> >BODY            ( get the data address, ie. points after DOCOL | end-of-word start-of-data )
  89
  90         ( now we start decompiling until we hit the end of the word )
  91         BEGIN           ( end start )
  92                 2DUP >
  93         WHILE
  94                 DUP @           ( end start codeword )
  95
  96                 CASE
  97                 ['] LIT OF                ( is it LIT ? )
  98                         1+ DUP @                ( get next word which is the integer constant )
  99                         .                       ( and print it )
 100                 ENDOF
 101                 ['] LITSTRING OF          ( is it LITSTRING ? )
 102                         [CHAR] S EMIT [CHAR] " EMIT SPACE ( print S"<space> )
 103                         1+ DUP @                ( get the length word )
 104                         SWAP 1+ SWAP            ( end start+1 length )
 105                         2DUP TYPE               ( print the string )
 106                         [CHAR] " EMIT SPACE          ( finish the string with a final quote )
 107                         +                       ( end start+1+len, aligned )
 108                         1-                     ( because we're about to add 4 below )
 109                 ENDOF
 110                 ['] 0BRANCH OF            ( is it 0BRANCH ? )
 111                         ." 0BRANCH ( "
 112                         1+ DUP @               ( print the offset )
 113                         .
 114                         ." ) "
 115                 ENDOF
 116                 ['] BRANCH OF             ( is it BRANCH ? )
 117                         ." BRANCH ( "
 118                         1+ DUP @               ( print the offset )
 119                         .
 120                         ." ) "
 121                 ENDOF
 122                 ['] ['] OF                  ( is it ['] ? )
 123                         ." ['] "
 124                         1+ DUP @               ( get the next codeword )
 125                         >NAME                    ( and force it to be printed as a dictionary entry )
 126                         .NAME SPACE
 127                 ENDOF
 128                 ['] EXIT OF               ( is it EXIT? )
 129                         ( We expect the last word to be EXIT, and if it is then we don't print it
 130                           because EXIT is normally implied by ;.  EXIT can also appear in the middle
 131                           of words, and then it needs to be printed. )
 132                         2DUP                    ( end start end start )
 133                         1+                     ( end start end start+1 )
 134                         <> IF                   ( end start | we're not at the end )
 135                                 ." EXIT "
 136                         THEN
 137                 ENDOF
 138                                         ( default case: )
 139                         DUP                     ( in the default case we always need to DUP before using )
 140                         >NAME                    ( look up the codeword to get the dictionary entry )
 141                         .NAME SPACE               ( and print it )
 142                 ENDCASE
 143
 144                 1+             ( end start+1 )
 145         REPEAT
 146
 147         [CHAR] ; EMIT CR
 148
 149         2DROP           ( restore stack )
 150 ;
 151