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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
|
fn evaluate functions: (addr handle function), bindings: (addr table), scratch: (addr line), end: (addr word), out: (addr value-stack) {
var line/eax: (addr line) <- copy scratch
var word-ah/eax: (addr handle word) <- get line, data
var curr/eax: (addr word) <- lookup *word-ah
var curr-stream-storage: (stream byte 0x10)
var curr-stream/edi: (addr stream byte) <- address curr-stream-storage
clear-value-stack out
$evaluate:loop: {
# precondition (should never hit)
compare curr, 0
break-if-=
# update curr-stream
emit-word curr, curr-stream
#? print-stream-to-real-screen curr-stream
#? print-string-to-real-screen "\n"
$evaluate:process-word: {
# if curr-stream is an operator, perform it
{
var is-add?/eax: boolean <- stream-data-equal? curr-stream, "+"
compare is-add?, 0
break-if-=
var _b/eax: int <- pop-int-from-value-stack out
var b/edx: int <- copy _b
var a/eax: int <- pop-int-from-value-stack out
a <- add b
push-int-to-value-stack out, a
break $evaluate:process-word
}
{
var is-sub?/eax: boolean <- stream-data-equal? curr-stream, "-"
compare is-sub?, 0
break-if-=
var _b/eax: int <- pop-int-from-value-stack out
var b/edx: int <- copy _b
var a/eax: int <- pop-int-from-value-stack out
a <- subtract b
push-int-to-value-stack out, a
break $evaluate:process-word
}
{
var is-mul?/eax: boolean <- stream-data-equal? curr-stream, "*"
compare is-mul?, 0
break-if-=
var _b/eax: int <- pop-int-from-value-stack out
var b/edx: int <- copy _b
var a/eax: int <- pop-int-from-value-stack out
a <- multiply b
push-int-to-value-stack out, a
break $evaluate:process-word
}
# if curr-stream defines a binding, save top of stack to bindings
{
var done?/eax: boolean <- stream-empty? curr-stream
compare done?, 0 # false
break-if-!=
var new-byte/eax: byte <- read-byte curr-stream
compare new-byte, 0x3d # '='
break-if-!=
var key-h: (handle array byte)
var key/ecx: (addr handle array byte) <- address key-h
stream-to-string curr-stream, key
var foo/eax: (addr array byte) <- lookup *key
var val/eax: int <- pop-int-from-value-stack out
bind-int-in-table bindings, key, val
var line/eax: (addr line) <- copy scratch
var next-line-ah/eax: (addr handle line) <- get line, next
var next-line/eax: (addr line) <- lookup *next-line-ah
compare next-line, 0
break-if-= $evaluate:process-word
evaluate functions, bindings, next-line, end, out
break $evaluate:process-word
}
rewind-stream curr-stream
# if curr-stream is a known function name, call it appropriately
{
var callee-h: (handle function)
var callee-ah/eax: (addr handle function) <- address callee-h
find-function functions, curr-stream, callee-ah
var callee/eax: (addr function) <- lookup *callee-ah
compare callee, 0
break-if-=
perform-call callee, out, functions
break $evaluate:process-word
}
# if it's a name, push its value
{
compare bindings, 0
break-if-=
var tmp: (handle array byte)
var curr-string-ah/edx: (addr handle array byte) <- address tmp
stream-to-string curr-stream, curr-string-ah # unfortunate leak
var curr-string/eax: (addr array byte) <- lookup *curr-string-ah
var val-storage: (handle value)
var val-ah/edi: (addr handle value) <- address val-storage
lookup-binding bindings, curr-string, val-ah
var val/eax: (addr value) <- lookup *val-ah
compare val, 0
break-if-=
push-value-stack out, val
break $evaluate:process-word
}
# if the word starts with a quote and ends with a quote, return it directly
{
var start/eax: byte <- stream-first curr-stream
compare start, 0x22 # double-quote
break-if-!=
var end/eax: byte <- stream-final curr-stream
compare end, 0x22 # double-quote
break-if-!=
var h: (handle array byte)
var s/eax: (addr handle array byte) <- address h
unquote-stream-to-string curr-stream, s # leak
push-string-to-value-stack out, *s
break $evaluate:process-word
}
# otherwise assume it's a literal int and push it
{
var n/eax: int <- parse-decimal-int-from-stream curr-stream
push-int-to-value-stack out, n
}
}
# termination check
compare curr, end
break-if-=
# update
var next-word-ah/edx: (addr handle word) <- get curr, next
curr <- lookup *next-word-ah
#
loop
}
}
fn test-evaluate {
var line-storage: line
var line/esi: (addr line) <- address line-storage
var first-word-ah/eax: (addr handle word) <- get line-storage, data
allocate-word-with first-word-ah, "3"
append-word-with *first-word-ah, "=a"
var next-line-ah/eax: (addr handle line) <- get line-storage, next
allocate next-line-ah
var next-line/eax: (addr line) <- lookup *next-line-ah
var first-word-ah/eax: (addr handle word) <- get next-line, data
allocate-word-with first-word-ah, "a"
var functions-storage: (handle function)
var functions/ecx: (addr handle function) <- address functions-storage
var table-storage: table
var table/ebx: (addr table) <- address table-storage
initialize-table table, 0x10
var stack-storage: value-stack
var stack/edi: (addr value-stack) <- address stack-storage
initialize-value-stack stack, 0x10
evaluate functions, table, line, 0, stack
var x/eax: int <- pop-int-from-value-stack stack
check-ints-equal x, 3, "F - test-evaluate"
}
fn find-function first: (addr handle function), name: (addr stream byte), out: (addr handle function) {
var curr/esi: (addr handle function) <- copy first
$find-function:loop: {
var _f/eax: (addr function) <- lookup *curr
var f/ecx: (addr function) <- copy _f
compare f, 0
break-if-=
var curr-name-ah/eax: (addr handle array byte) <- get f, name
var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
var done?/eax: boolean <- stream-data-equal? name, curr-name
compare done?, 0 # false
{
break-if-=
copy-handle *curr, out
break $find-function:loop
}
curr <- get f, next
loop
}
}
fn perform-call _callee: (addr function), caller-stack: (addr value-stack), functions: (addr handle function) {
var callee/ecx: (addr function) <- copy _callee
# create bindings for args
var table-storage: table
var table/esi: (addr table) <- address table-storage
initialize-table table, 0x10
bind-args callee, caller-stack, table
# obtain body
var body-ah/eax: (addr handle line) <- get callee, body
var body/eax: (addr line) <- lookup *body-ah
# perform call
var stack-storage: value-stack
var stack/edi: (addr value-stack) <- address stack-storage
initialize-value-stack stack, 0x10
#? print-string-to-real-screen "about to enter recursive eval\n"
evaluate functions, table, body, 0, stack
#? print-string-to-real-screen "exited recursive eval\n"
# stitch result from stack into caller
var result/eax: int <- pop-int-from-value-stack stack
push-int-to-value-stack caller-stack, result
}
# pop args from the caller-stack and bind them to successive args
# implies: function args are stored in reverse order
fn bind-args _callee: (addr function), caller-stack: (addr value-stack), table: (addr table) {
var callee/ecx: (addr function) <- copy _callee
var curr-arg-ah/eax: (addr handle word) <- get callee, args
var curr-arg/eax: (addr word) <- lookup *curr-arg-ah
#
var curr-key-storage: (handle array byte)
var curr-key/edx: (addr handle array byte) <- address curr-key-storage
{
compare curr-arg, 0
break-if-=
# create binding
word-to-string curr-arg, curr-key
{
#? var tmp/eax: (addr array byte) <- lookup *curr-key
#? print-string-to-real-screen "binding "
#? print-string-to-real-screen tmp
#? print-string-to-real-screen " to "
var curr-val/eax: int <- pop-int-from-value-stack caller-stack
#? print-int32-decimal-to-real-screen curr-val
#? print-string-to-real-screen "\n"
bind-int-in-table table, curr-key, curr-val
}
#
var next-arg-ah/edx: (addr handle word) <- get curr-arg, next
curr-arg <- lookup *next-arg-ah
loop
}
}
# Copy of 'simplify' that just tracks the maximum stack depth needed
# Doesn't actually need to simulate the stack, since every word has a predictable effect.
fn max-stack-depth first-word: (addr word), final-word: (addr word) -> result/edi: int {
var curr-word/eax: (addr word) <- copy first-word
var curr-depth/ecx: int <- copy 0
result <- copy 0
$max-stack-depth:loop: {
$max-stack-depth:process-word: {
# handle operators
{
var is-add?/eax: boolean <- word-equal? curr-word, "+"
compare is-add?, 0
break-if-=
curr-depth <- decrement
break $max-stack-depth:process-word
}
{
var is-sub?/eax: boolean <- word-equal? curr-word, "-"
compare is-sub?, 0
break-if-=
curr-depth <- decrement
break $max-stack-depth:process-word
}
{
var is-mul?/eax: boolean <- word-equal? curr-word, "*"
compare is-mul?, 0
break-if-=
curr-depth <- decrement
break $max-stack-depth:process-word
}
# otherwise it's an int (do we need error-checking?)
curr-depth <- increment
# update max depth if necessary
{
compare curr-depth, result
break-if-<=
result <- copy curr-depth
}
}
# if curr-word == final-word break
compare curr-word, final-word
break-if-=
# curr-word = curr-word->next
var next-word-ah/edx: (addr handle word) <- get curr-word, next
curr-word <- lookup *next-word-ah
#
loop
}
}
|