1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
: L:
' L' entry-to-execution-token execute
{ ' set-label entry-to-execution-token , }
{ set-label } if-else
; make-immediate
~ TODO probably needs to do more
8 allocate s" transform-state" variable
0 transform-state !
~ We allow immediate words to run, which means for example that flow-control
~ hexdump-between words such as if-else expect to be able to mutate the heap,
~ and they expect to find the stuff they've been compiling present on it. We
~ make this possible by swapping out the value of "here" during the execution
~ of transformed code. By focusing on "here", we get to keep the existing
~ ",".
~
~ (-- done)
: transform-inner
word
." wrapped here " here @ .hex64 newline
~ If no word was returned, exit.
dup 0 = { drop 0 exit } if
~ The string is on the top of the stack, so to get a pointer to it we get
~ the stack address.
~ (string)
value@
~ If it's the magic word, end the transformation.
dup s" pyrzqxgl" stringcmp 0 = { drop dropstring 1 exit } if
." flags " interpreter-flags @ . newline
." transformed: " dup emitstring newline
~ Otherwise, look it up to see what it means.
find
~ Check whether the word was found in the dictionary.
dup 0 != {
~ If the word is in the dictionary, check what mode we're in, then...
dropstring-with-result
~ (entry pointer)
interpreter-flags @ 0x01 & {
~ ... if we're in compile mode, there's still a chance it's an immediate
~ word, in which case we fall through to interpret mode...
dup entry-flags@ 1 & 0 =
~ ... but it's a regular word, so append it to the heap.
{ entry-to-execution-token . 0 exit } if
} if
~ ... if we're in interpret mode, or the word is immediate, run it.
." stack before immediate word " stackhex
entry-to-execution-token execute 0 exit
} if
~ If it's not in the dictionary, check whether it's a decimal number.
drop
~ As before, we get the stack address and use it as a string pointer.
~ (string)
value@ read-integer 0 = {
~ It's a number.
interpreter-flags @ 0x01 & {
~ We're in compile mode; append first "lit", then the number, to the
~ heap. The version of "lit" we use is the one that's current when we
~ ourselves are compiled, hardcoded; doing a dynamic lookup would
~ require dealing with what happens if it's not found.
dropstring-with-result
[ ' lit entry-to-execution-token literal ]
, ,
0 exit
} if
~ We're in interpret mode; push the number to the stack. Or at least, that's
~ what the code we're interpreting will see. Really it's already on the
~ stack, just clean everything else up and leave it there.
dropstring-with-result 0 exit
} if
~ If it's neither in the dictionary nor a number, just print an error.
s" No such word: " emitstring value@ emitstring dropstring 0 ;
~ (output point -- output point, done)
: transform-one
~ Save the old value of "here", and set it to our output point.
here @ transform-state ! here !
~ Now the stack has nothing of ours on it, so client code can do its thing.
~ Invoke client code.
transform-inner
~ (done)
~ Swap them back.
here @ transform-state @ here !
~ While we don't actually use transform-state outside of this invocation,
~ for tidiness we zero it out.
0 transform-state !
swap ;
~ (output point -- output point)
: transform { transform-one { exit } if } forever ;
1024 allocate dup
transform
: za ." ZA" 12 13 - . ;
: ' word value@ find dropstring-with-result
interpreter-flags @ 1 & { literal } if ; make-immediate
~ ' za . newline
pyrzqxgl
." stack after " stackhex
2dup swap hexdump-between
~ : piz ." PIZ" ' za . newline ; piz
bye
|