7 : CLOSESTLINK ( addr vcfa -- lfa )
9 vcfa>latest dup ( addr link link )
10 rot dup -rot ( link addr link addr )
17 0 -rot ( 0 addr link )
20 rot drop ( addr link )
21 dup -rot @ ( link addr nextlink )
22 2dup ( link addr nextlink addr nextlink)
36 : BODYLEN ( cfa -- len )
38 here swap ( clink addr )
39 context dup #context @ + swap
43 closestlink ( clink addr clink' )
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) )
61 BL WORD FIND ( find the dictionary entry to decompile )
66 ." Word '" COUNT TYPE ." ' not found in dictionary."
70 DUP DUP BODYLEN + SWAP >LINK
75 [CHAR] : EMIT SPACE DUP 1+ .NAME SPACE
76 DUP ?IMMEDIATE IF ." IMMEDIATE " THEN CR
80 ." Variable " DUP 1+ .NAME CR
85 ." Constant " DUP 1+ .NAME CR
90 ." Primitive or word with unrecognized codeword." CR
96 LINK> >BODY ( get the data address, ie. points after DOCOL | end-of-word start-of-data )
98 ( now we start decompiling until we hit the end of the word )
102 DUP @ ( end start codeword )
105 ['] LIT OF ( is it LIT ? )
106 1+ DUP @ ( get next word which is the integer constant )
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 )
118 ['] 0BRANCH OF ( is it 0BRANCH ? )
120 1+ DUP @ ( print the offset )
124 ['] BRANCH OF ( is it BRANCH ? )
126 1+ DUP @ ( print the offset )
130 ['] ['] OF ( is it ['] ? )
132 1+ DUP @ ( get the next codeword )
133 >NAME ( and force it to be printed as a dictionary entry )
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 )
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 )
157 2DROP ( restore stack )