4 : CLOSESTLINK ( addr vcfa -- lfa )
6 vocab>latest dup ( addr link link )
7 rot dup -rot ( link addr link addr )
14 0 -rot ( 0 addr link )
17 rot drop ( addr link )
18 dup -rot @ ( link addr nextlink )
19 2dup ( link addr nextlink addr nextlink)
33 : BODYLEN ( cfa -- len )
35 here swap ( clink addr )
36 context dup #context @ + swap
40 closestlink ( clink addr clink' )
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) )
58 BL WORD FIND ( find the dictionary entry to decompile )
63 ." Word '" COUNT TYPE ." ' not found in dictionary."
67 DUP DUP BODYLEN + SWAP >LINK
72 [CHAR] : EMIT SPACE DUP 1+ .NAME SPACE
73 DUP ?IMMEDIATE IF ." IMMEDIATE " THEN CR
77 ." Variable " DUP 1+ .NAME CR
82 ." Constant " DUP 1+ .NAME CR
87 ." Primitive or word with unrecognized codeword." CR
93 LINK> >BODY ( get the data address, ie. points after DOCOL | end-of-word start-of-data )
95 ( now we start decompiling until we hit the end of the word )
99 DUP @ ( end start codeword )
102 ['] LIT OF ( is it LIT ? )
103 1+ DUP @ ( get next word which is the integer constant )
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 )
115 ['] 0BRANCH OF ( is it 0BRANCH ? )
117 1+ DUP @ ( print the offset )
121 ['] BRANCH OF ( is it BRANCH ? )
123 1+ DUP @ ( print the offset )
127 ['] ['] OF ( is it ['] ? )
129 1+ DUP @ ( get the next codeword )
130 >NAME ( and force it to be printed as a dictionary entry )
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 )
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 )
154 2DROP ( restore stack )