1 # env is an alist of ((sym . val) (sym . val) ...)
  2 # we never modify `in` or `env`
  3 # ignore 'screen-cell' on a first reading; it's a hack for sandboxes
  4 fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
  5   var in/esi: (addr handle cell) <- copy _in
  6 #?   dump-cell in
  7 #?   {
  8 #?     var foo/eax: byte <- read-key 0/keyboard
  9 #?     compare foo, 0
 10 #?     loop-if-=
 11 #?   }
 12 +-- 12 lines: # trace "evaluate " in " in environment " env -----------------------------------------------------------------------------------------------------------------------------
 24   trace-lower trace
 25   var in-addr/eax: (addr cell) <- lookup *in
 26   {
 27     var nil?/eax: boolean <- nil? in-addr
 28     compare nil?, 0/false
 29     break-if-=
 30     # nil is a literal
 31     trace-text trace, "eval", "nil"
 32     copy-object _in, out
 33     trace-higher trace
 34     return
 35   }
 36   var in-type/ecx: (addr int) <- get in-addr, type
 37   compare *in-type, 1/number
 38   {
 39     break-if-!=
 40     # numbers are literals
 41     trace-text trace, "eval", "number"
 42     copy-object _in, out
 43     trace-higher trace
 44     return
 45   }
 46   compare *in-type, 2/symbol
 47   {
 48     break-if-!=
 49     trace-text trace, "eval", "symbol"
 50     lookup-symbol in-addr, out, env-h, globals, trace, screen-cell, keyboard-cell
 51     trace-higher trace
 52     return
 53   }
 54   # in-addr is a syntax tree
 55   $evaluate:anonymous-function: {
 56     # trees starting with "fn" are anonymous functions and therefore literals
 57     var expr/esi: (addr cell) <- copy in-addr
 58     # if its first elem is not "fn", break
 59     var in-addr/edx: (addr cell) <- copy in-addr
 60     var first-ah/ecx: (addr handle cell) <- get in-addr, left
 61     var first/eax: (addr cell) <- lookup *first-ah
 62     var fn?/eax: boolean <- fn? first
 63     compare fn?, 0/false
 64     break-if-=
 65     # turn (fn ...) into (fn env ...)
 66     trace-text trace, "eval", "anonymous function"
 67     var rest-ah/eax: (addr handle cell) <- get in-addr, right
 68     var tmp: (handle cell)
 69     var tmp-ah/edi: (addr handle cell) <- address tmp
 70     new-pair tmp-ah, env-h, *rest-ah
 71     new-pair out, *first-ah, *tmp-ah
 72     trace-higher trace
 73     return
 74   }
 75   # builtins with "special" evaluation rules
 76   $evaluate:quote: {
 77     # trees starting with single quote create literals
 78     var expr/esi: (addr cell) <- copy in-addr
 79     # if its first elem is not "'", break
 80     var first-ah/ecx: (addr handle cell) <- get in-addr, left
 81     var rest-ah/edx: (addr handle cell) <- get in-addr, right
 82     var first/eax: (addr cell) <- lookup *first-ah
 83     var first-type/ecx: (addr int) <- get first, type
 84     compare *first-type, 2/symbol
 85     break-if-!=
 86     var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
 87     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
 88     var quote?/eax: boolean <- stream-data-equal? sym-data, "'"
 89     compare quote?, 0/false
 90     break-if-=
 91     #
 92     trace-text trace, "eval", "quote"
 93     copy-object rest-ah, out
 94     trace-higher trace
 95     return
 96   }
 97   $evaluate:set: {
 98     # trees starting with "set" define globals
 99     var expr/esi: (addr cell) <- copy in-addr
100     # if its first elem is not "set", break
101     var first-ah/ecx: (addr handle cell) <- get in-addr, left
102     var rest-ah/edx: (addr handle cell) <- get in-addr, right
103     var first/eax: (addr cell) <- lookup *first-ah
104     var first-type/ecx: (addr int) <- get first, type
105     compare *first-type, 2/symbol
106     break-if-!=
107     var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
108     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
109     var set?/eax: boolean <- stream-data-equal? sym-data, "set"
110     compare set?, 0/false
111     break-if-=
112     #
113     trace-text trace, "eval", "set"
114     trace-text trace, "eval", "evaluating second arg"
115     var rest/eax: (addr cell) <- lookup *rest-ah
116     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
117     {
118       var first-arg/eax: (addr cell) <- lookup *first-arg-ah
119       var first-arg-type/eax: (addr int) <- get first-arg, type
120       compare *first-arg-type, 2/symbol
121       break-if-=
122       error trace, "first arg to set must be a symbol"
123       trace-higher trace
124       return
125     }
126     rest-ah <- get rest, right
127     rest <- lookup *rest-ah
128     var second-arg-ah/edx: (addr handle cell) <- get rest, left
129     evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell
130     trace-text trace, "eval", "saving global binding"
131     var first-arg/eax: (addr cell) <- lookup *first-arg-ah
132     var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data
133     var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah
134     var tmp-string: (handle array byte)
135     var tmp-ah/edx: (addr handle array byte) <- address tmp-string
136     rewind-stream first-arg-data
137     stream-to-array first-arg-data, tmp-ah
138     var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah
139     var out2/edi: (addr handle cell) <- copy out
140     append-global globals, first-arg-data-string, *out2
141     trace-higher trace
142     return
143   }
144   $evaluate:if: {
145     # trees starting with "if" are conditionals
146     var expr/esi: (addr cell) <- copy in-addr
147     # if its first elem is not "if", break
148     var first-ah/ecx: (addr handle cell) <- get in-addr, left
149     var rest-ah/edx: (addr handle cell) <- get in-addr, right
150     var first/eax: (addr cell) <- lookup *first-ah
151     var first-type/ecx: (addr int) <- get first, type
152     compare *first-type, 2/symbol
153     break-if-!=
154     var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
155     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
156     var if?/eax: boolean <- stream-data-equal? sym-data, "if"
157     compare if?, 0/false
158     break-if-=
159     #
160     trace-text trace, "eval", "if"
161     trace-text trace, "eval", "evaluating first arg"
162     var rest/eax: (addr cell) <- lookup *rest-ah
163     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
164     var guard-h: (handle cell)
165     var guard-ah/esi: (addr handle cell) <- address guard-h
166     evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell
167     rest-ah <- get rest, right
168     rest <- lookup *rest-ah
169     var branch-ah/edi: (addr handle cell) <- get rest, left
170     var guard-a/eax: (addr cell) <- lookup *guard-ah
171     var skip-to-third-arg?/eax: boolean <- nil? guard-a
172     compare skip-to-third-arg?, 0/false
173     {
174       break-if-=
175       trace-text trace, "eval", "skipping to third arg"
176       var rest/eax: (addr cell) <- lookup *rest-ah
177       rest-ah <- get rest, right
178       rest <- lookup *rest-ah
179       branch-ah <- get rest, left
180     }
181     evaluate branch-ah, out, env-h, globals, trace, screen-cell, keyboard-cell
182     trace-higher trace
183     return
184   }
185   trace-text trace, "eval", "function call"
186   trace-text trace, "eval", "evaluating list elements"
187   var evaluated-list-storage: (handle cell)
188   var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage
189   var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah
190   var curr/ecx: (addr cell) <- copy in-addr
191   $evaluate-list:loop: {
192     allocate-pair curr-out-ah
193     var nil?/eax: boolean <- nil? curr
194     compare nil?, 0/false
195     break-if-!=
196     # eval left
197     var curr-out/eax: (addr cell) <- lookup *curr-out-ah
198     var left-out-ah/edi: (addr handle cell) <- get curr-out, left
199     var left-ah/esi: (addr handle cell) <- get curr, left
200     evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell
201     #
202     curr-out-ah <- get curr-out, right
203     var right-ah/eax: (addr handle cell) <- get curr, right
204     var right/eax: (addr cell) <- lookup *right-ah
205     curr <- copy right
206     loop
207   }
208   var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah
209   var function-ah/ecx: (addr handle cell) <- get evaluated-list, left
210   var args-ah/edx: (addr handle cell) <- get evaluated-list, right
211 #?   dump-cell args-ah
212 #?   abort "aaa"
213   apply function-ah, args-ah, out, globals, trace, screen-cell, keyboard-cell
214   trace-higher trace
215 +--  9 lines: # trace "=> " out ---------------------------------------------------------------------------------------------------------------------------------------------------------
224 }
225 
226 fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
227   var f-ah/eax: (addr handle cell) <- copy _f-ah
228   var _f/eax: (addr cell) <- lookup *f-ah
229   var f/esi: (addr cell) <- copy _f
230   # call primitive functions
231   {
232     var f-type/eax: (addr int) <- get f, type
233     compare *f-type, 4/primitive-function
234     break-if-!=
235     apply-primitive f, args-ah, out, globals, trace
236     return
237   }
238   # if it's not a primitive function it must be an anonymous function
239 +-- 12 lines: # trace "apply anonymous function " f " in environment " env --------------------------------------------------------------------------------------------------------------
251   trace-lower trace
252   {
253     var f-type/ecx: (addr int) <- get f, type
254     compare *f-type, 0/pair
255     break-if-!=
256     var first-ah/eax: (addr handle cell) <- get f, left
257     var first/eax: (addr cell) <- lookup *first-ah
258     var fn?/eax: boolean <- fn? first
259     compare fn?, 0/false
260     break-if-=
261     var rest-ah/esi: (addr handle cell) <- get f, right
262     var rest/eax: (addr cell) <- lookup *rest-ah
263     var callee-env-ah/edx: (addr handle cell) <- get rest, left
264     rest-ah <- get rest, right
265     rest <- lookup *rest-ah
266     var params-ah/ecx: (addr handle cell) <- get rest, left
267     var body-ah/eax: (addr handle cell) <- get rest, right
268     apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, screen-cell, keyboard-cell
269     trace-higher trace
270     return
271   }
272   error trace, "unknown function"
273 }
274 
275 fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), _body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
276   # push bindings for params to env
277   var new-env-storage: (handle cell)
278   var new-env-ah/esi: (addr handle cell) <- address new-env-storage
279   push-bindings params-ah, args-ah, env-h, new-env-ah, trace
280   # eval all expressions in body, writing result to `out` each time
281   var body-ah/ecx: (addr handle cell) <- copy _body-ah
282   $apply-function:body: {
283     var body/eax: (addr cell) <- lookup *body-ah
284     # stop when body is nil
285     {
286       var body-nil?/eax: boolean <- nil? body
287       compare body-nil?, 0/false
288       break-if-!= $apply-function:body
289     }
290     # evaluate each expression, writing result to `out`
291     {
292       var curr-ah/eax: (addr handle cell) <- get body, left
293       evaluate curr-ah, out, *new-env-ah, globals, trace, screen-cell, keyboard-cell
294     }
295     #
296     body-ah <- get body, right
297     loop
298   }
299   # `out` contains result of evaluating final expression
300 }
301 
302 # Bind params to corresponding args and add the bindings to old-env. Return
303 # the result in env-ah.
304 #
305 # We never modify old-env, but we point to it. This way other parts of the
306 # interpreter can continue using old-env, and everything works harmoniously
307 # even though no cells are copied around.
308 #
309 # env should always be a DAG (ignoring internals of values). It doesn't have
310 # to be a tree (some values may be shared), but there are also no cycles.
311 #
312 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure
313 fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), old-env-h: (handle cell), env-ah: (addr handle cell), trace: (addr trace) {
314   var params-ah/edx: (addr handle cell) <- copy _params-ah
315   var args-ah/ebx: (addr handle cell) <- copy _args-ah
316   var _params/eax: (addr cell) <- lookup *params-ah
317   var params/esi: (addr cell) <- copy _params
318   {
319     var params-nil?/eax: boolean <- nil? params
320     compare params-nil?, 0/false
321     break-if-=
322     # nil is a literal
323     trace-text trace, "eval", "done with push-bindings"
324     copy-handle old-env-h, env-ah
325     return
326   }
327   # Params can only be symbols or pairs. Args can be anything.
328 +-- 14 lines: # trace "pushing bindings from " params " to " args -----------------------------------------------------------------------------------------------------------------------
342   trace-lower trace
343   var params-type/eax: (addr int) <- get params, type
344   compare *params-type, 2/symbol
345   {
346     break-if-!=
347     trace-text trace, "eval", "symbol; binding to all remaining args"
348     # create a new binding
349     var new-binding-storage: (handle cell)
350     var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage
351     new-pair new-binding-ah, *params-ah, *args-ah
352     # push it to env
353     new-pair env-ah, *new-binding-ah, old-env-h
354     trace-higher trace
355     return
356   }
357   compare *params-type, 0/pair
358   {
359     break-if-=
360     error trace, "cannot bind a non-symbol"
361     trace-higher trace
362     return
363   }
364   var _args/eax: (addr cell) <- lookup *args-ah
365   var args/edi: (addr cell) <- copy _args
366   # params is now a pair, so args must be also
367   var args-type/eax: (addr int) <- get args, type
368   compare *args-type, 0/pair
369   {
370     break-if-=
371     error trace, "args not in a proper list"
372     trace-higher trace
373     return
374   }
375   var intermediate-env-storage: (handle cell)
376   var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage
377   var first-param-ah/eax: (addr handle cell) <- get params, left
378   var first-arg-ah/ecx: (addr handle cell) <- get args, left
379   push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace
380   var remaining-params-ah/eax: (addr handle cell) <- get params, right
381   var remaining-args-ah/ecx: (addr handle cell) <- get args, right
382   push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace
383   trace-higher trace
384 }
385 
386 fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
387   # trace sym
388   {
389     var stream-storage: (stream byte 0x40)
390     var stream/ecx: (addr stream byte) <- address stream-storage
391     write stream, "look up "
392     var sym2/eax: (addr cell) <- copy sym
393     var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data
394     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
395     rewind-stream sym-data
396     write-stream stream, sym-data
397     write stream, " in "
398     var env-ah/eax: (addr handle cell) <- address env-h
399     print-cell env-ah, stream, 0/no-trace
400     trace trace, "eval", stream
401   }
402   trace-lower trace
403   var _env/eax: (addr cell) <- lookup env-h
404   var env/ebx: (addr cell) <- copy _env
405   # if env is not a list, abort
406   {
407     var env-type/ecx: (addr int) <- get env, type
408     compare *env-type, 0/pair
409     break-if-=
410     error trace, "eval found a non-list environment"
411     trace-higher trace
412     return
413   }
414   # if env is nil, look up in globals
415   {
416     var env-nil?/eax: boolean <- nil? env
417     compare env-nil?, 0/false
418     break-if-=
419     lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell
420     trace-higher trace
421 +-- 13 lines: # trace "=> " out " (global)" ---------------------------------------------------------------------------------------------------------------------------------------------
434     return
435   }
436   # check car
437   var env-head-storage: (handle cell)
438   var env-head-ah/eax: (addr handle cell) <- address env-head-storage
439   car env, env-head-ah, 0/no-trace
440   var _env-head/eax: (addr cell) <- lookup *env-head-ah
441   var env-head/ecx: (addr cell) <- copy _env-head
442   # if car is not a list, abort
443   {
444     var env-head-type/eax: (addr int) <- get env-head, type
445     compare *env-head-type, 0/pair
446     break-if-=
447     error trace, "environment is not a list of (key . value) pairs"
448     trace-higher trace
449     return
450   }
451   # check key
452   var curr-key-storage: (handle cell)
453   var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage
454   car env-head, curr-key-ah, trace
455   var curr-key/eax: (addr cell) <- lookup *curr-key-ah
456   # if key is not a symbol, abort
457   {
458     var curr-key-type/eax: (addr int) <- get curr-key, type
459     compare *curr-key-type, 2/symbol
460     break-if-=
461     error trace, "environment contains a binding for a non-symbol"
462     trace-higher trace
463     return
464   }
465   # if key matches sym, return val
466   var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace
467   compare match?, 0/false
468   {
469     break-if-=
470     cdr env-head, out, 0/no-trace
471 +-- 13 lines: # trace "=> " out " (match)" ----------------------------------------------------------------------------------------------------------------------------------------------
484     trace-higher trace
485     return
486   }
487   # otherwise recurse
488   var env-tail-storage: (handle cell)
489   var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
490   cdr env, env-tail-ah, trace
491   lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell
492   trace-higher trace
493 +-- 13 lines: # trace "=> " out " (recurse)" --------------------------------------------------------------------------------------------------------------------------------------------
506 }
507 
508 fn test-lookup-symbol-in-env {
509   # tmp = (a . 3)
510   var val-storage: (handle cell)
511   var val-ah/ecx: (addr handle cell) <- address val-storage
512   new-integer val-ah, 3
513   var key-storage: (handle cell)
514   var key-ah/edx: (addr handle cell) <- address key-storage
515   new-symbol key-ah, "a"
516   var env-storage: (handle cell)
517   var env-ah/ebx: (addr handle cell) <- address env-storage
518   new-pair env-ah, *key-ah, *val-ah
519   # env = ((a . 3))
520   var nil-storage: (handle cell)
521   var nil-ah/ecx: (addr handle cell) <- address nil-storage
522   allocate-pair nil-ah
523   new-pair env-ah, *env-ah, *nil-ah
524   # lookup sym(a) in env tmp
525   var tmp-storage: (handle cell)
526   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
527   new-symbol tmp-ah, "a"
528   var in/eax: (addr cell) <- lookup *tmp-ah
529   lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
530   var result/eax: (addr cell) <- lookup *tmp-ah
531   var result-type/edx: (addr int) <- get result, type
532   check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0"
533   var result-value-addr/eax: (addr float) <- get result, number-data
534   var result-value/eax: int <- convert *result-value-addr
535   check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1"
536 }
537 
538 fn test-lookup-symbol-in-globals {
539   var globals-storage: global-table
540   var globals/edi: (addr global-table) <- address globals-storage
541   initialize-globals globals
542   # env = nil
543   var nil-storage: (handle cell)
544   var nil-ah/ecx: (addr handle cell) <- address nil-storage
545   allocate-pair nil-ah
546   # lookup sym(a), env
547   var tmp-storage: (handle cell)
548   var tmp-ah/ebx: (addr handle cell) <- address tmp-storage
549   new-symbol tmp-ah, "+"
550   var in/eax: (addr cell) <- lookup *tmp-ah
551   lookup-symbol in, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard
552   var result/eax: (addr cell) <- lookup *tmp-ah
553   var result-type/edx: (addr int) <- get result, type
554   check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0"
555   var result-value/eax: (addr int) <- get result, index-data
556   check-ints-equal *result-value, 2/add, "F - test-lookup-symbol-in-globals/1"
557 }
558 
559 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
560   trace-text trace, "eval", "car"
561   trace-lower trace
562   var in/eax: (addr cell) <- copy _in
563   # if in is not a list, abort
564   {
565     var in-type/ecx: (addr int) <- get in, type
566     compare *in-type, 0/pair
567     break-if-=
568     error trace, "car on a non-list"
569     trace-higher trace
570     return
571   }
572   # if in is nil, abort
573   {
574     var in-nil?/eax: boolean <- nil? in
575     compare in-nil?, 0/false
576     break-if-=
577     error trace, "car on nil"
578     trace-higher trace
579     return
580   }
581   var in-left/eax: (addr handle cell) <- get in, left
582   copy-object in-left, out
583   trace-higher trace
584   return
585 }
586 
587 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
588   trace-text trace, "eval", "cdr"
589   trace-lower trace
590   var in/eax: (addr cell) <- copy _in
591   # if in is not a list, abort
592   {
593     var in-type/ecx: (addr int) <- get in, type
594     compare *in-type, 0/pair
595     break-if-=
596     error trace, "car on a non-list"
597     trace-higher trace
598     return
599   }
600   # if in is nil, abort
601   {
602     var in-nil?/eax: boolean <- nil? in
603     compare in-nil?, 0/false
604     break-if-=
605     error trace, "car on nil"
606     trace-higher trace
607     return
608   }
609   var in-right/eax: (addr handle cell) <- get in, right
610   copy-object in-right, out
611   trace-higher trace
612   return
613 }
614 
615 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean {
616   trace-text trace, "eval", "cell-isomorphic?"
617   trace-lower trace
618   var a/esi: (addr cell) <- copy _a
619   var b/edi: (addr cell) <- copy _b
620   # if types don't match, return false
621   var a-type-addr/eax: (addr int) <- get a, type
622   var b-type-addr/ecx: (addr int) <- get b, type
623   var b-type/ecx: int <- copy *b-type-addr
624   compare b-type, *a-type-addr
625   {
626     break-if-=
627     trace-higher trace
628     trace-text trace, "eval", "=> false (type)"
629     return 0/false
630   }
631   # if types are number, compare number-data
632   # TODO: exactly comparing floats is a bad idea
633   compare b-type, 1/number
634   {
635     break-if-!=
636     var a-val-addr/eax: (addr float) <- get a, number-data
637     var b-val-addr/ecx: (addr float) <- get b, number-data
638     var a-val/xmm0: float <- copy *a-val-addr
639     compare a-val, *b-val-addr
640     {
641       break-if-=
642       trace-higher trace
643       trace-text trace, "eval", "=> false (numbers)"
644       return 0/false
645     }
646     trace-higher trace
647     trace-text trace, "eval", "=> true (numbers)"
648     return 1/true
649   }
650   compare b-type, 2/symbol
651   {
652     break-if-!=
653     var b-val-ah/eax: (addr handle stream byte) <- get b, text-data
654     var _b-val/eax: (addr stream byte) <- lookup *b-val-ah
655     var b-val/ecx: (addr stream byte) <- copy _b-val
656     var a-val-ah/eax: (addr handle stream byte) <- get a, text-data
657     var a-val/eax: (addr stream byte) <- lookup *a-val-ah
658     var tmp-array: (handle array byte)
659     var tmp-ah/edx: (addr handle array byte) <- address tmp-array
660     rewind-stream a-val
661     stream-to-array a-val, tmp-ah
662     var tmp/eax: (addr array byte) <- lookup *tmp-ah
663     var match?/eax: boolean <- stream-data-equal? b-val, tmp
664     trace-higher trace
665     {
666       compare match?, 0/false
667       break-if-=
668       trace-text trace, "eval", "=> true (symbols)"
669     }
670     {
671       compare match?, 0/false
672       break-if-!=
673       trace-text trace, "eval", "=> false (symbols)"
674     }
675     return match?
676   }
677   # if a is nil, b should be nil
678   {
679     # (assumes nil? returns 0 or 1)
680     var _b-nil?/eax: boolean <- nil? b
681     var b-nil?/ecx: boolean <- copy _b-nil?
682     var a-nil?/eax: boolean <- nil? a
683     # a == nil and b == nil => return true
684     {
685       compare a-nil?, 0/false
686       break-if-=
687       compare b-nil?, 0/false
688       break-if-=
689       trace-higher trace
690       trace-text trace, "eval", "=> true (nils)"
691       return 1/true
692     }
693     # a == nil => return false
694     {
695       compare a-nil?, 0/false
696       break-if-=
697       trace-higher trace
698       trace-text trace, "eval", "=> false (b != nil)"
699       return 0/false
700     }
701     # b == nil => return false
702     {
703       compare b-nil?, 0/false
704       break-if-=
705       trace-higher trace
706       trace-text trace, "eval", "=> false (a != nil)"
707       return 0/false
708     }
709   }
710   # a and b are pairs
711   var a-tmp-storage: (handle cell)
712   var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage
713   var b-tmp-storage: (handle cell)
714   var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage
715   # if cars aren't equal, return false
716   car a, a-tmp-ah, trace
717   car b, b-tmp-ah, trace
718   {
719     var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
720     var a-tmp/ecx: (addr cell) <- copy _a-tmp
721     var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
722     var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
723     compare result, 0/false
724     break-if-!=
725     trace-higher trace
726     trace-text trace, "eval", "=> false (car mismatch)"
727     return 0/false
728   }
729   # recurse on cdrs
730   cdr a, a-tmp-ah, trace
731   cdr b, b-tmp-ah, trace
732   var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
733   var a-tmp/ecx: (addr cell) <- copy _a-tmp
734   var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
735   var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
736   trace-higher trace
737   return result
738 }
739 
740 fn fn? _x: (addr cell) -> _/eax: boolean {
741   var x/esi: (addr cell) <- copy _x
742   var type/eax: (addr int) <- get x, type
743   compare *type, 2/symbol
744   {
745     break-if-=
746     return 0/false
747   }
748   var contents-ah/eax: (addr handle stream byte) <- get x, text-data
749   var contents/eax: (addr stream byte) <- lookup *contents-ah
750   var result/eax: boolean <- stream-data-equal? contents, "fn"
751   return result
752 }
753 
754 fn test-evaluate-is-well-behaved {
755   var t-storage: trace
756   var t/esi: (addr trace) <- address t-storage
757   initialize-trace t, 0x10, 0/visible  # we don't use trace UI
758   # env = nil
759   var env-storage: (handle cell)
760   var env-ah/ecx: (addr handle cell) <- address env-storage
761   allocate-pair env-ah
762   # eval sym(a), nil env
763   var tmp-storage: (handle cell)
764   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
765   new-symbol tmp-ah, "a"
766   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard
767   # doesn't die
768   check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved"
769 }
770 
771 fn test-evaluate-number {
772   # env = nil
773   var env-storage: (handle cell)
774   var env-ah/ecx: (addr handle cell) <- address env-storage
775   allocate-pair env-ah
776   # tmp = 3
777   var tmp-storage: (handle cell)
778   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
779   new-integer tmp-ah, 3
780   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
781   #
782   var result/eax: (addr cell) <- lookup *tmp-ah
783   var result-type/edx: (addr int) <- get result, type
784   check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0"
785   var result-value-addr/eax: (addr float) <- get result, number-data
786   var result-value/eax: int <- convert *result-value-addr
787   check-ints-equal result-value, 3, "F - test-evaluate-number/1"
788 }
789 
790 fn test-evaluate-symbol {
791   # tmp = (a . 3)
792   var val-storage: (handle cell)
793   var val-ah/ecx: (addr handle cell) <- address val-storage
794   new-integer val-ah, 3
795   var key-storage: (handle cell)
796   var key-ah/edx: (addr handle cell) <- address key-storage
797   new-symbol key-ah, "a"
798   var env-storage: (handle cell)
799   var env-ah/ebx: (addr handle cell) <- address env-storage
800   new-pair env-ah, *key-ah, *val-ah
801   # env = ((a . 3))
802   var nil-storage: (handle cell)
803   var nil-ah/ecx: (addr handle cell) <- address nil-storage
804   allocate-pair nil-ah
805   new-pair env-ah, *env-ah, *nil-ah
806   # eval sym(a), env
807   var tmp-storage: (handle cell)
808   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
809   new-symbol tmp-ah, "a"
810   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
811   var result/eax: (addr cell) <- lookup *tmp-ah
812   var result-type/edx: (addr int) <- get result, type
813   check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0"
814   var result-value-addr/eax: (addr float) <- get result, number-data
815   var result-value/eax: int <- convert *result-value-addr
816   check-ints-equal result-value, 3, "F - test-evaluate-symbol/1"
817 }
818 
819 fn test-evaluate-primitive-function {
820   var globals-storage: global-table
821   var globals/edi: (addr global-table) <- address globals-storage
822   initialize-globals globals
823   var nil-storage: (handle cell)
824   var nil-ah/ecx: (addr handle cell) <- address nil-storage
825   allocate-pair nil-ah
826   var add-storage: (handle cell)
827   var add-ah/ebx: (addr handle cell) <- address add-storage
828   new-symbol add-ah, "+"
829   # eval +, nil env
830   var tmp-storage: (handle cell)
831   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
832   evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard
833   #
834   var result/eax: (addr cell) <- lookup *tmp-ah
835   var result-type/edx: (addr int) <- get result, type
836   check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0"
837   var result-value/eax: (addr int) <- get result, index-data
838   check-ints-equal *result-value, 2/add, "F - test-evaluate-primitive-function/1"
839 }
840 
841 fn test-evaluate-primitive-function-call {
842   var t-storage: trace
843   var t/edi: (addr trace) <- address t-storage
844   initialize-trace t, 0x100, 0/visible  # we don't use trace UI
845   #
846   var nil-storage: (handle cell)
847   var nil-ah/ecx: (addr handle cell) <- address nil-storage
848   allocate-pair nil-ah
849   var one-storage: (handle cell)
850   var one-ah/edx: (addr handle cell) <- address one-storage
851   new-integer one-ah, 1
852   var add-storage: (handle cell)
853   var add-ah/ebx: (addr handle cell) <- address add-storage
854   new-symbol add-ah, "+"
855   # input is (+ 1 1)
856   var tmp-storage: (handle cell)
857   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
858   new-pair tmp-ah, *one-ah, *nil-ah
859   new-pair tmp-ah, *one-ah, *tmp-ah
860   new-pair tmp-ah, *add-ah, *tmp-ah
861 #?   dump-cell tmp-ah
862   #
863   var globals-storage: global-table
864   var globals/edx: (addr global-table) <- address globals-storage
865   initialize-globals globals
866   #
867   evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard
868 #?   dump-trace t
869   #
870   var result/eax: (addr cell) <- lookup *tmp-ah
871   var result-type/edx: (addr int) <- get result, type
872   check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0"
873   var result-value-addr/eax: (addr float) <- get result, number-data
874   var result-value/eax: int <- convert *result-value-addr
875   check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1"
876 }