Updated library code to use IB and QUERY-INPUT.
[forth.jl.git] / src / lib_8_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