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