# Mu - shell/evaluate.mu

https://github.com/akkartik/mu/blob/main/shell/evaluate.mu

       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 # 'call-number' is just for showing intermediate progress; this is a _slow_ interpreter
       5 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), call-number: int {
       6   # stack overflow?   # disable when enabling Really-debug-print
       7   check-stack
       8   {
       9     var screen-cell/eax: (addr handle cell) <- copy screen-cell
      10     compare screen-cell, 0
      11     break-if-=
      12     var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell
      13     compare screen-cell-addr, 0
      14     break-if-=
      15     # if screen-cell exists, we're probably not in a test
      16     show-stack-state
      17   }
      18   # errors? skip
      19   {
      20     compare trace, 0
      21     break-if-=
      22     var error?/eax: boolean <- has-errors? trace
      23     compare error?, 0/false
      24     break-if-=
      25     return
      26   }
      27   var in/esi: (addr handle cell) <- copy _in
      28   # show intermediate progress on screen if necessary
      29   {
      30     compare screen-cell, 0
      31     break-if-=
      32     var tmp/eax: int <- copy call-number
      33     tmp <- and 0xf  # every 16 calls to evaluate
      34     compare tmp, 0
      35     break-if-!=
      36     var screen-cell/eax: (addr handle cell) <- copy screen-cell
      37     var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell
      38     compare screen-cell-addr, 0
      39     break-if-=
      40     var screen-obj-ah/eax: (addr handle screen) <- get screen-cell-addr, screen-data
      41     var screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
      42     compare screen-obj, 0
      43     break-if-=
      44     var y/ecx: int <- render-screen 0/screen, screen-obj, 0x70/xmin, 1/ymin
      45   }
      46 #?   dump-cell in
      47 #?   {
      48 #?     var foo/eax: byte <- read-key 0/keyboard
      49 #?     compare foo, 0
      50 #?     loop-if-=
      51 #?   }
      52 +-- 14 lines: # trace "evaluate " in " in environment " env -----------------------------------------------------------------------------------------------------------------------------
      66   trace-lower trace
      67   var in-addr/eax: (addr cell) <- lookup *in
      68   {
      69     var nil?/eax: boolean <- nil? in-addr
      70     compare nil?, 0/false
      71     break-if-=
      72     # nil is a literal
      73     trace-text trace, "eval", "nil"
      74     copy-object _in, out
      75     trace-higher trace
      76     return
      77   }
      78   var in-type/ecx: (addr int) <- get in-addr, type
      79   compare *in-type, 1/number
      80   {
      81     break-if-!=
      82     # numbers are literals
      83     trace-text trace, "eval", "number"
      84     copy-object _in, out
      85     trace-higher trace
      86     return
      87   }
      88   compare *in-type, 3/stream
      89   {
      90     break-if-!=
      91     # streams are literals
      92     trace-text trace, "eval", "stream"
      93     copy-object _in, out
      94     trace-higher trace
      95     return
      96   }
      97   compare *in-type, 2/symbol
      98   {
      99     break-if-!=
     100     trace-text trace, "eval", "symbol"
     101     debug-print "a", 7/fg, 0xc5/bg=blue-bg
     102     lookup-symbol in-addr, out, env-h, globals, trace, screen-cell, keyboard-cell
     103     debug-print "z", 7/fg, 0xc5/bg=blue-bg
     104     trace-higher trace
     105     return
     106   }
     107   compare *in-type, 5/screen
     108   {
     109     break-if-!=
     110     trace-text trace, "eval", "screen"
     111     copy-object _in, out
     112     trace-higher trace
     113     return
     114   }
     115   compare *in-type, 6/keyboard
     116   {
     117     break-if-!=
     118     trace-text trace, "eval", "keyboard"
     119     copy-object _in, out
     120     trace-higher trace
     121     return
     122   }
     123   # in-addr is a syntax tree
     124   $evaluate:anonymous-function: {
     125     # trees starting with "fn" are anonymous functions
     126     var expr/esi: (addr cell) <- copy in-addr
     127     # if its first elem is not "fn", break
     128     var in-addr/edx: (addr cell) <- copy in-addr
     129     var first-ah/ecx: (addr handle cell) <- get in-addr, left
     130     var first/eax: (addr cell) <- lookup *first-ah
     131     var fn?/eax: boolean <- fn? first
     132     compare fn?, 0/false
     133     break-if-=
     134     # turn (fn ...) into (fn env ...)
     135     trace-text trace, "eval", "anonymous function"
     136     var rest-ah/eax: (addr handle cell) <- get in-addr, right
     137     var tmp: (handle cell)
     138     var tmp-ah/edi: (addr handle cell) <- address tmp
     139     new-pair tmp-ah, env-h, *rest-ah
     140     new-pair out, *first-ah, *tmp-ah
     141     trace-higher trace
     142     return
     143   }
     144   # builtins with "special" evaluation rules
     145   $evaluate:quote: {
     146     # trees starting with single quote create literals
     147     var expr/esi: (addr cell) <- copy in-addr
     148     # if its first elem is not "'", break
     149     var first-ah/ecx: (addr handle cell) <- get in-addr, left
     150     var rest-ah/edx: (addr handle cell) <- get in-addr, right
     151     var first/eax: (addr cell) <- lookup *first-ah
     152     var quote?/eax: boolean <- symbol-equal? first, "'"
     153     compare quote?, 0/false
     154     break-if-=
     155     #
     156     trace-text trace, "eval", "quote"
     157     copy-object rest-ah, out
     158     trace-higher trace
     159     return
     160   }
     161   $evaluate:def: {
     162     # trees starting with "def" define globals
     163     var expr/esi: (addr cell) <- copy in-addr
     164     # if its first elem is not "def", break
     165     var first-ah/ecx: (addr handle cell) <- get in-addr, left
     166     var rest-ah/edx: (addr handle cell) <- get in-addr, right
     167     var first/eax: (addr cell) <- lookup *first-ah
     168     var def?/eax: boolean <- symbol-equal? first, "def"
     169     compare def?, 0/false
     170     break-if-=
     171     #
     172     trace-text trace, "eval", "def"
     173     trace-text trace, "eval", "evaluating second arg"
     174     var rest/eax: (addr cell) <- lookup *rest-ah
     175     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     176     {
     177       var first-arg/eax: (addr cell) <- lookup *first-arg-ah
     178       var first-arg-type/eax: (addr int) <- get first-arg, type
     179       compare *first-arg-type, 2/symbol
     180       break-if-=
     181       error trace, "first arg to def must be a symbol"
     182       trace-higher trace
     183       return
     184     }
     185     rest-ah <- get rest, right
     186     rest <- lookup *rest-ah
     187     var second-arg-ah/edx: (addr handle cell) <- get rest, left
     188     debug-print "P", 4/fg, 0xc5/bg=blue-bg
     189     increment call-number
     190     evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     191     debug-print "Q", 4/fg, 0xc5/bg=blue-bg
     192     trace-text trace, "eval", "saving global binding"
     193     var first-arg/eax: (addr cell) <- lookup *first-arg-ah
     194     var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data
     195     var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah
     196     var tmp-string: (handle array byte)
     197     var tmp-ah/edx: (addr handle array byte) <- address tmp-string
     198     rewind-stream first-arg-data
     199     stream-to-array first-arg-data, tmp-ah
     200     var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah
     201     var out2/edi: (addr handle cell) <- copy out
     202     assign-or-create-global globals, first-arg-data-string, *out2, trace
     203     trace-higher trace
     204     return
     205   }
     206   $evaluate:set: {
     207     # trees starting with "set" mutate bindings
     208     var expr/esi: (addr cell) <- copy in-addr
     209     # if its first elem is not "set", break
     210     var first-ah/ecx: (addr handle cell) <- get in-addr, left
     211     var rest-ah/edx: (addr handle cell) <- get in-addr, right
     212     var first/eax: (addr cell) <- lookup *first-ah
     213     var set?/eax: boolean <- symbol-equal? first, "set"
     214     compare set?, 0/false
     215     break-if-=
     216     #
     217     trace-text trace, "eval", "set"
     218     trace-text trace, "eval", "evaluating second arg"
     219     var rest/eax: (addr cell) <- lookup *rest-ah
     220     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     221     {
     222       var first-arg/eax: (addr cell) <- lookup *first-arg-ah
     223       var first-arg-type/eax: (addr int) <- get first-arg, type
     224       compare *first-arg-type, 2/symbol
     225       break-if-=
     226       error trace, "first arg to set must be a symbol"
     227       trace-higher trace
     228       return
     229     }
     230     rest-ah <- get rest, right
     231     rest <- lookup *rest-ah
     232     var second-arg-ah/edx: (addr handle cell) <- get rest, left
     233     debug-print "P", 4/fg, 0xc5/bg=blue-bg
     234     increment call-number
     235     evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     236     debug-print "Q", 4/fg, 0xc5/bg=blue-bg
     237     trace-text trace, "eval", "mutating binding"
     238     var first-arg/eax: (addr cell) <- lookup *first-arg-ah
     239     var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data
     240     var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah
     241     mutate-binding first-arg-data, out, env-h, globals, trace
     242     trace-higher trace
     243     return
     244   }
     245   $evaluate:and: {
     246     var expr/esi: (addr cell) <- copy in-addr
     247     # if its first elem is not "and", break
     248     var first-ah/ecx: (addr handle cell) <- get in-addr, left
     249     var rest-ah/edx: (addr handle cell) <- get in-addr, right
     250     var first/eax: (addr cell) <- lookup *first-ah
     251     var and?/eax: boolean <- symbol-equal? first, "and"
     252     compare and?, 0/false
     253     break-if-=
     254     #
     255     trace-text trace, "eval", "and"
     256     trace-text trace, "eval", "evaluating first arg"
     257     var rest/eax: (addr cell) <- lookup *rest-ah
     258     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     259     debug-print "R2", 4/fg, 0xc5/bg=blue-bg
     260     increment call-number
     261     evaluate first-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     262     debug-print "S2", 4/fg, 0xc5/bg=blue-bg
     263     # if first arg is nil, short-circuit
     264     var out-ah/eax: (addr handle cell) <- copy out
     265     var out-a/eax: (addr cell) <- lookup *out-ah
     266     var nil?/eax: boolean <- nil? out-a
     267     compare nil?, 0/false
     268     {
     269       break-if-=
     270       return
     271     }
     272     var rest/eax: (addr cell) <- lookup *rest-ah
     273     rest-ah <- get rest, right
     274     rest <- lookup *rest-ah
     275     var second-ah/eax: (addr handle cell) <- get rest, left
     276     debug-print "T2", 4/fg, 0xc5/bg=blue-bg
     277     increment call-number
     278     evaluate second-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     279     debug-print "U2", 4/fg, 0xc5/bg=blue-bg
     280     trace-higher trace
     281     return
     282   }
     283   $evaluate:or: {
     284     var expr/esi: (addr cell) <- copy in-addr
     285     # if its first elem is not "or", break
     286     var first-ah/ecx: (addr handle cell) <- get in-addr, left
     287     var rest-ah/edx: (addr handle cell) <- get in-addr, right
     288     var first/eax: (addr cell) <- lookup *first-ah
     289     var or?/eax: boolean <- symbol-equal? first, "or"
     290     compare or?, 0/false
     291     break-if-=
     292     #
     293     trace-text trace, "eval", "or"
     294     trace-text trace, "eval", "evaluating first arg"
     295     var rest/eax: (addr cell) <- lookup *rest-ah
     296     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     297     debug-print "R2", 4/fg, 0xc5/bg=blue-bg
     298     increment call-number
     299     evaluate first-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     300     debug-print "S2", 4/fg, 0xc5/bg=blue-bg
     301     # if first arg is not nil, short-circuit
     302     var out-ah/eax: (addr handle cell) <- copy out
     303     var out-a/eax: (addr cell) <- lookup *out-ah
     304     var nil?/eax: boolean <- nil? out-a
     305     compare nil?, 0/false
     306     {
     307       break-if-!=
     308       return
     309     }
     310     var rest/eax: (addr cell) <- lookup *rest-ah
     311     rest-ah <- get rest, right
     312     rest <- lookup *rest-ah
     313     var second-ah/eax: (addr handle cell) <- get rest, left
     314     debug-print "T2", 4/fg, 0xc5/bg=blue-bg
     315     increment call-number
     316     evaluate second-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     317     debug-print "U2", 4/fg, 0xc5/bg=blue-bg
     318     trace-higher trace
     319     return
     320   }
     321   $evaluate:if: {
     322     # trees starting with "if" are conditionals
     323     var expr/esi: (addr cell) <- copy in-addr
     324     # if its first elem is not "if", break
     325     var first-ah/ecx: (addr handle cell) <- get in-addr, left
     326     var rest-ah/edx: (addr handle cell) <- get in-addr, right
     327     var first/eax: (addr cell) <- lookup *first-ah
     328     var if?/eax: boolean <- symbol-equal? first, "if"
     329     compare if?, 0/false
     330     break-if-=
     331     #
     332     trace-text trace, "eval", "if"
     333     trace-text trace, "eval", "evaluating first arg"
     334     var rest/eax: (addr cell) <- lookup *rest-ah
     335     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     336     var guard-h: (handle cell)
     337     var guard-ah/esi: (addr handle cell) <- address guard-h
     338     debug-print "R", 4/fg, 0xc5/bg=blue-bg
     339     increment call-number
     340     evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     341     debug-print "S", 4/fg, 0xc5/bg=blue-bg
     342     rest-ah <- get rest, right
     343     rest <- lookup *rest-ah
     344     var branch-ah/edi: (addr handle cell) <- get rest, left
     345     var guard-a/eax: (addr cell) <- lookup *guard-ah
     346     var skip-to-third-arg?/eax: boolean <- nil? guard-a
     347     compare skip-to-third-arg?, 0/false
     348     {
     349       break-if-=
     350       trace-text trace, "eval", "skipping to third arg"
     351       var rest/eax: (addr cell) <- lookup *rest-ah
     352       rest-ah <- get rest, right
     353       rest <- lookup *rest-ah
     354       branch-ah <- get rest, left
     355     }
     356     debug-print "T", 4/fg, 0xc5/bg=blue-bg
     357     increment call-number
     358     evaluate branch-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     359     debug-print "U", 4/fg, 0xc5/bg=blue-bg
     360     trace-higher trace
     361     return
     362   }
     363   $evaluate:while: {
     364     # trees starting with "while" are loops
     365     var expr/esi: (addr cell) <- copy in-addr
     366     # if its first elem is not "while", break
     367     var first-ah/ecx: (addr handle cell) <- get in-addr, left
     368     var rest-ah/edx: (addr handle cell) <- get in-addr, right
     369     var first/eax: (addr cell) <- lookup *first-ah
     370     var first-type/ecx: (addr int) <- get first, type
     371     compare *first-type, 2/symbol
     372     break-if-!=
     373     var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
     374     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
     375     var while?/eax: boolean <- stream-data-equal? sym-data, "while"
     376     compare while?, 0/false
     377     break-if-=
     378     #
     379     trace-text trace, "eval", "while"
     380     var rest/eax: (addr cell) <- lookup *rest-ah
     381     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     382     rest-ah <- get rest, right
     383     var guard-h: (handle cell)
     384     var guard-ah/esi: (addr handle cell) <- address guard-h
     385     $evaluate:while:loop-execution: {
     386       {
     387         compare trace, 0
     388         break-if-=
     389         var error?/eax: boolean <- has-errors? trace
     390         compare error?, 0/false
     391         break-if-!= $evaluate:while:loop-execution
     392       }
     393       trace-text trace, "eval", "loop termination check"
     394       debug-print "V", 4/fg, 0xc5/bg=blue-bg
     395       increment call-number
     396       evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     397       debug-print "W", 4/fg, 0xc5/bg=blue-bg
     398       var guard-a/eax: (addr cell) <- lookup *guard-ah
     399       var done?/eax: boolean <- nil? guard-a
     400       compare done?, 0/false
     401       break-if-!=
     402       evaluate-exprs rest-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     403       loop
     404     }
     405     trace-text trace, "eval", "loop terminated"
     406     trace-higher trace
     407     return
     408   }
     409   trace-text trace, "eval", "function call"
     410   trace-text trace, "eval", "evaluating list elements"
     411   trace-lower trace
     412   var evaluated-list-storage: (handle cell)
     413   var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage
     414   var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah
     415   var curr/ecx: (addr cell) <- copy in-addr
     416   $evaluate-list:loop: {
     417     allocate-pair curr-out-ah
     418     var nil?/eax: boolean <- nil? curr
     419     compare nil?, 0/false
     420     break-if-!=
     421     # eval left
     422     var curr-out/eax: (addr cell) <- lookup *curr-out-ah
     423     var left-out-ah/edi: (addr handle cell) <- get curr-out, left
     424     var left-ah/esi: (addr handle cell) <- get curr, left
     425     debug-print "A", 4/fg, 0xc5/bg=blue-bg
     426     increment call-number
     427     evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     428     debug-print "B", 4/fg, 0xc5/bg=blue-bg
     429     #
     430     curr-out-ah <- get curr-out, right
     431     var right-ah/eax: (addr handle cell) <- get curr, right
     432     var right/eax: (addr cell) <- lookup *right-ah
     433     curr <- copy right
     434     loop
     435   }
     436   trace-higher trace
     437   var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah
     438   var function-ah/ecx: (addr handle cell) <- get evaluated-list, left
     439   var args-ah/edx: (addr handle cell) <- get evaluated-list, right
     440   debug-print "C", 4/fg, 0xc5/bg=blue-bg
     441   apply function-ah, args-ah, out, globals, trace, screen-cell, keyboard-cell, call-number
     442   debug-print "Y", 4/fg, 0xc5/bg=blue-bg
     443   trace-higher trace
     444 +-- 11 lines: # trace "=> " out ---------------------------------------------------------------------------------------------------------------------------------------------------------
     455   debug-print "Z", 4/fg, 0xc5/bg=blue-bg
     456 }
     457
     458 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), call-number: int {
     459   var f-ah/eax: (addr handle cell) <- copy _f-ah
     460   var _f/eax: (addr cell) <- lookup *f-ah
     461   var f/esi: (addr cell) <- copy _f
     462   # call primitive functions
     463   {
     464     var f-type/eax: (addr int) <- get f, type
     465     compare *f-type, 4/primitive-function
     466     break-if-!=
     467     apply-primitive f, args-ah, out, globals, trace
     468     return
     469   }
     470   # if it's not a primitive function it must be an anonymous function
     471 +-- 14 lines: # trace "apply anonymous function " f " in environment " env --------------------------------------------------------------------------------------------------------------
     485   trace-lower trace
     486   {
     487     var f-type/ecx: (addr int) <- get f, type
     488     compare *f-type, 0/pair
     489     break-if-!=
     490     var first-ah/eax: (addr handle cell) <- get f, left
     491     var first/eax: (addr cell) <- lookup *first-ah
     492     var fn?/eax: boolean <- fn? first
     493     compare fn?, 0/false
     494     break-if-=
     495     var rest-ah/esi: (addr handle cell) <- get f, right
     496     var rest/eax: (addr cell) <- lookup *rest-ah
     497     var callee-env-ah/edx: (addr handle cell) <- get rest, left
     498     rest-ah <- get rest, right
     499     rest <- lookup *rest-ah
     500     var params-ah/ecx: (addr handle cell) <- get rest, left
     501     var body-ah/eax: (addr handle cell) <- get rest, right
     502     debug-print "D", 7/fg, 0xc5/bg=blue-bg
     503     apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, screen-cell, keyboard-cell, call-number
     504     debug-print "Y", 7/fg, 0xc5/bg=blue-bg
     505     trace-higher trace
     506     return
     507   }
     508   error trace, "unknown function"
     509 }
     510
     511 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), call-number: int {
     512   # push bindings for params to env
     513   var new-env-h: (handle cell)
     514   var new-env-ah/esi: (addr handle cell) <- address new-env-h
     515   push-bindings params-ah, args-ah, env-h, new-env-ah, trace
     516   #
     517   evaluate-exprs body-ah, out, new-env-h, globals, trace, screen-cell, keyboard-cell, call-number
     518 }
     519
     520 fn evaluate-exprs _exprs-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), call-number: int {
     521   # eval all exprs, writing result to `out` each time
     522   var exprs-ah/ecx: (addr handle cell) <- copy _exprs-ah
     523   $evaluate-exprs:loop: {
     524     var exprs/eax: (addr cell) <- lookup *exprs-ah
     525     # stop when exprs is nil
     526     {
     527       var exprs-nil?/eax: boolean <- nil? exprs
     528       compare exprs-nil?, 0/false
     529       break-if-!= $evaluate-exprs:loop
     530     }
     531     # evaluate each expression, writing result to `out`
     532     {
     533       var curr-ah/eax: (addr handle cell) <- get exprs, left
     534       debug-print "E", 7/fg, 0xc5/bg=blue-bg
     535       increment call-number
     536       evaluate curr-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     537       debug-print "X", 7/fg, 0xc5/bg=blue-bg
     538     }
     539     #
     540     exprs-ah <- get exprs, right
     541     loop
     542   }
     543   # `out` contains result of evaluating final expression
     544 }
     545
     546 # Bind params to corresponding args and add the bindings to old-env. Return
     547 # the result in env-ah.
     548 #
     549 # We never modify old-env, but we point to it. This way other parts of the
     550 # interpreter can continue using old-env, and everything works harmoniously
     551 # even though no cells are copied around.
     552 #
     553 # env should always be a DAG (ignoring internals of values). It doesn't have
     554 # to be a tree (some values may be shared), but there are also no cycles.
     555 #
     556 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure
     557 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) {
     558   var params-ah/edx: (addr handle cell) <- copy _params-ah
     559   var args-ah/ebx: (addr handle cell) <- copy _args-ah
     560   var _params/eax: (addr cell) <- lookup *params-ah
     561   var params/esi: (addr cell) <- copy _params
     562   {
     563     var params-nil?/eax: boolean <- nil? params
     564     compare params-nil?, 0/false
     565     break-if-=
     566     # nil is a literal
     567     trace-text trace, "eval", "done with push-bindings"
     568     copy-handle old-env-h, env-ah
     569     return
     570   }
     571   # Params can only be symbols or pairs. Args can be anything.
     572 +-- 16 lines: # trace "pushing bindings from " params " to " args -----------------------------------------------------------------------------------------------------------------------
     588   trace-lower trace
     589   var params-type/eax: (addr int) <- get params, type
     590   compare *params-type, 2/symbol
     591   {
     592     break-if-!=
     593     trace-text trace, "eval", "symbol; binding to all remaining args"
     594     # create a new binding
     595     var new-binding-storage: (handle cell)
     596     var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage
     597     new-pair new-binding-ah, *params-ah, *args-ah
     598     # push it to env
     599     new-pair env-ah, *new-binding-ah, old-env-h
     600     trace-higher trace
     601     return
     602   }
     603   compare *params-type, 0/pair
     604   {
     605     break-if-=
     606     error trace, "cannot bind a non-symbol"
     607     trace-higher trace
     608     return
     609   }
     610   var _args/eax: (addr cell) <- lookup *args-ah
     611   var args/edi: (addr cell) <- copy _args
     612   # params is now a pair, so args must be also
     613   var args-type/eax: (addr int) <- get args, type
     614   compare *args-type, 0/pair
     615   {
     616     break-if-=
     617     error trace, "args not in a proper list"
     618     trace-higher trace
     619     return
     620   }
     621   var intermediate-env-storage: (handle cell)
     622   var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage
     623   var first-param-ah/eax: (addr handle cell) <- get params, left
     624   var first-arg-ah/ecx: (addr handle cell) <- get args, left
     625   push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace
     626   var remaining-params-ah/eax: (addr handle cell) <- get params, right
     627   var remaining-args-ah/ecx: (addr handle cell) <- get args, right
     628   push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace
     629   trace-higher trace
     630 }
     631
     632 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) {
     633   # trace sym
     634   {
     635     compare trace, 0
     636     break-if-=
     637     var stream-storage: (stream byte 0x800)  # pessimistically sized just for the large alist loaded from disk in `main`
     638     var stream/ecx: (addr stream byte) <- address stream-storage
     639     write stream, "look up "
     640     var sym2/eax: (addr cell) <- copy sym
     641     var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data
     642     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
     643     rewind-stream sym-data
     644     write-stream stream, sym-data
     645     write stream, " in "
     646     var env-ah/eax: (addr handle cell) <- address env-h
     647     print-cell env-ah, stream, 0/no-trace
     648     trace trace, "eval", stream
     649   }
     650   trace-lower trace
     651   var _env/eax: (addr cell) <- lookup env-h
     652   var env/ebx: (addr cell) <- copy _env
     653   # if env is not a list, abort
     654   {
     655     var env-type/ecx: (addr int) <- get env, type
     656     compare *env-type, 0/pair
     657     break-if-=
     658     error trace, "eval found a non-list environment"
     659     trace-higher trace
     660     return
     661   }
     662   # if env is nil, look up in globals
     663   {
     664     var env-nil?/eax: boolean <- nil? env
     665     compare env-nil?, 0/false
     666     break-if-=
     667     debug-print "b", 7/fg, 0xc5/bg=blue-bg
     668     lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell
     669     debug-print "x", 7/fg, 0xc5/bg=blue-bg
     670     trace-higher trace
     671 +-- 15 lines: # trace "=> " out " (global)" ---------------------------------------------------------------------------------------------------------------------------------------------
     686     debug-print "y", 7/fg, 0xc5/bg=blue-bg
     687     return
     688   }
     689   # check car
     690   var env-head-storage: (handle cell)
     691   var env-head-ah/eax: (addr handle cell) <- address env-head-storage
     692   car env, env-head-ah, 0/no-trace
     693   var _env-head/eax: (addr cell) <- lookup *env-head-ah
     694   var env-head/ecx: (addr cell) <- copy _env-head
     695   # if car is not a list, abort
     696   {
     697     var env-head-type/eax: (addr int) <- get env-head, type
     698     compare *env-head-type, 0/pair
     699     break-if-=
     700     error trace, "environment is not a list of (key . value) pairs"
     701     trace-higher trace
     702     return
     703   }
     704   # check key
     705   var curr-key-storage: (handle cell)
     706   var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage
     707   car env-head, curr-key-ah, trace
     708   var curr-key/eax: (addr cell) <- lookup *curr-key-ah
     709   # if key is not a symbol, abort
     710   {
     711     var curr-key-type/eax: (addr int) <- get curr-key, type
     712     compare *curr-key-type, 2/symbol
     713     break-if-=
     714     error trace, "environment contains a binding for a non-symbol"
     715     trace-higher trace
     716     return
     717   }
     718   # if key matches sym, return val
     719   var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace
     720   compare match?, 0/false
     721   {
     722     break-if-=
     723     cdr env-head, out, 0/no-trace
     724 +-- 15 lines: # trace "=> " out " (match)" ----------------------------------------------------------------------------------------------------------------------------------------------
     739     trace-higher trace
     740     return
     741   }
     742   # otherwise recurse
     743   var env-tail-storage: (handle cell)
     744   var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
     745   cdr env, env-tail-ah, trace
     746   lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell
     747   trace-higher trace
     748 +-- 15 lines: # trace "=> " out " (recurse)" --------------------------------------------------------------------------------------------------------------------------------------------
     763 }
     764
     765 fn test-lookup-symbol-in-env {
     766   # tmp = (a . 3)
     767   var val-storage: (handle cell)
     768   var val-ah/ecx: (addr handle cell) <- address val-storage
     769   new-integer val-ah, 3
     770   var key-storage: (handle cell)
     771   var key-ah/edx: (addr handle cell) <- address key-storage
     772   new-symbol key-ah, "a"
     773   var env-storage: (handle cell)
     774   var env-ah/ebx: (addr handle cell) <- address env-storage
     775   new-pair env-ah, *key-ah, *val-ah
     776   # env = ((a . 3))
     777   var nil-storage: (handle cell)
     778   var nil-ah/ecx: (addr handle cell) <- address nil-storage
     779   allocate-pair nil-ah
     780   new-pair env-ah, *env-ah, *nil-ah
     781   # lookup sym(a) in env tmp
     782   var tmp-storage: (handle cell)
     783   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
     784   new-symbol tmp-ah, "a"
     785   var in/eax: (addr cell) <- lookup *tmp-ah
     786   lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
     787   var result/eax: (addr cell) <- lookup *tmp-ah
     788   var result-type/edx: (addr int) <- get result, type
     789   check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0"
     790   var result-value-addr/eax: (addr float) <- get result, number-data
     791   var result-value/eax: int <- convert *result-value-addr
     792   check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1"
     793 }
     794
     795 fn test-lookup-symbol-in-globals {
     796   var globals-storage: global-table
     797   var globals/edi: (addr global-table) <- address globals-storage
     798   initialize-globals globals
     799   # env = nil
     800   var nil-storage: (handle cell)
     801   var nil-ah/ecx: (addr handle cell) <- address nil-storage
     802   allocate-pair nil-ah
     803   # lookup sym(a), env
     804   var tmp-storage: (handle cell)
     805   var tmp-ah/ebx: (addr handle cell) <- address tmp-storage
     806   new-symbol tmp-ah, "+"
     807   var in/eax: (addr cell) <- lookup *tmp-ah
     808   lookup-symbol in, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard
     809   var result/eax: (addr cell) <- lookup *tmp-ah
     810   var result-type/edx: (addr int) <- get result, type
     811   check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0"
     812   var result-value/eax: (addr int) <- get result, index-data
     813   check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-globals/1"
     814 }
     815
     816 fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) {
     817   # trace name
     818   {
     819     compare trace, 0
     820     break-if-=
     821     var stream-storage: (stream byte 0x800)  # pessimistically sized just for the large alist loaded from disk in `main`
     822     var stream/ecx: (addr stream byte) <- address stream-storage
     823     write stream, "bind "
     824     rewind-stream name
     825     write-stream stream, name
     826     write stream, " to "
     827     print-cell val, stream, 0/no-trace
     828     write stream, " in "
     829     var env-ah/eax: (addr handle cell) <- address env-h
     830     print-cell env-ah, stream, 0/no-trace
     831     trace trace, "eval", stream
     832   }
     833   trace-lower trace
     834   var _env/eax: (addr cell) <- lookup env-h
     835   var env/ebx: (addr cell) <- copy _env
     836   # if env is not a list, abort
     837   {
     838     var env-type/ecx: (addr int) <- get env, type
     839     compare *env-type, 0/pair
     840     break-if-=
     841     error trace, "eval found a non-list environment"
     842     trace-higher trace
     843     return
     844   }
     845   # if env is nil, look in globals
     846   {
     847     var env-nil?/eax: boolean <- nil? env
     848     compare env-nil?, 0/false
     849     break-if-=
     850     debug-print "b", 3/fg, 0xc5/bg=blue-bg
     851     mutate-binding-in-globals name, val, globals, trace
     852     debug-print "x", 3/fg, 0xc5/bg=blue-bg
     853     trace-higher trace
     854 +-- 15 lines: # trace "=> " val " (global)" ---------------------------------------------------------------------------------------------------------------------------------------------
     869     debug-print "y", 3/fg, 0xc5/bg=blue-bg
     870     return
     871   }
     872   # check car
     873   var env-head-storage: (handle cell)
     874   var env-head-ah/eax: (addr handle cell) <- address env-head-storage
     875   car env, env-head-ah, 0/no-trace
     876   var _env-head/eax: (addr cell) <- lookup *env-head-ah
     877   var env-head/ecx: (addr cell) <- copy _env-head
     878   # if car is not a list, abort
     879   {
     880     var env-head-type/eax: (addr int) <- get env-head, type
     881     compare *env-head-type, 0/pair
     882     break-if-=
     883     error trace, "environment is not a list of (key . value) pairs"
     884     trace-higher trace
     885     return
     886   }
     887   # check key
     888   var curr-key-storage: (handle cell)
     889   var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage
     890   car env-head, curr-key-ah, trace
     891   var curr-key/eax: (addr cell) <- lookup *curr-key-ah
     892   # if key is not a symbol, abort
     893   {
     894     var curr-key-type/eax: (addr int) <- get curr-key, type
     895     compare *curr-key-type, 2/symbol
     896     break-if-=
     897     error trace, "environment contains a binding for a non-symbol"
     898     trace-higher trace
     899     return
     900   }
     901   # if key matches name, return val
     902   var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data
     903   var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah
     904   var match?/eax: boolean <- streams-data-equal? curr-key-data, name
     905   compare match?, 0/false
     906   {
     907     break-if-=
     908     var dest/eax: (addr handle cell) <- get env-head, right
     909     copy-object val, dest
     910     trace-text trace, "eval", "=> done"
     911     trace-higher trace
     912     return
     913   }
     914   # otherwise recurse
     915   var env-tail-storage: (handle cell)
     916   var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
     917   cdr env, env-tail-ah, trace
     918   mutate-binding name, val, *env-tail-ah, globals, trace
     919   trace-higher trace
     920 }
     921
     922 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
     923   trace-text trace, "eval", "car"
     924   trace-lower trace
     925   var in/eax: (addr cell) <- copy _in
     926   # if in is not a list, abort
     927   {
     928     var in-type/ecx: (addr int) <- get in, type
     929     compare *in-type, 0/pair
     930     break-if-=
     931     error trace, "car on a non-list"
     932     trace-higher trace
     933     return
     934   }
     935   # if in is nil, abort
     936   {
     937     var in-nil?/eax: boolean <- nil? in
     938     compare in-nil?, 0/false
     939     break-if-=
     940     error trace, "car on nil"
     941     trace-higher trace
     942     return
     943   }
     944   var in-left/eax: (addr handle cell) <- get in, left
     945   copy-object in-left, out
     946   trace-higher trace
     947   return
     948 }
     949
     950 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
     951   trace-text trace, "eval", "cdr"
     952   trace-lower trace
     953   var in/eax: (addr cell) <- copy _in
     954   # if in is not a list, abort
     955   {
     956     var in-type/ecx: (addr int) <- get in, type
     957     compare *in-type, 0/pair
     958     break-if-=
     959     error trace, "car on a non-list"
     960     trace-higher trace
     961     return
     962   }
     963   # if in is nil, abort
     964   {
     965     var in-nil?/eax: boolean <- nil? in
     966     compare in-nil?, 0/false
     967     break-if-=
     968     error trace, "car on nil"
     969     trace-higher trace
     970     return
     971   }
     972   var in-right/eax: (addr handle cell) <- get in, right
     973   copy-object in-right, out
     974   trace-higher trace
     975   return
     976 }
     977
     978 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean {
     979   trace-text trace, "eval", "cell-isomorphic?"
     980   trace-lower trace
     981   var a/esi: (addr cell) <- copy _a
     982   var b/edi: (addr cell) <- copy _b
     983   # if types don't match, return false
     984   var a-type-addr/eax: (addr int) <- get a, type
     985   var b-type-addr/ecx: (addr int) <- get b, type
     986   var b-type/ecx: int <- copy *b-type-addr
     987   compare b-type, *a-type-addr
     988   {
     989     break-if-=
     990     trace-higher trace
     991     trace-text trace, "eval", "=> false (type)"
     992     return 0/false
     993   }
     994   # if types are number, compare number-data
     995   # TODO: exactly comparing floats is a bad idea
     996   compare b-type, 1/number
     997   {
     998     break-if-!=
     999     var a-val-addr/eax: (addr float) <- get a, number-data
    1000     var b-val-addr/ecx: (addr float) <- get b, number-data
    1001     var a-val/xmm0: float <- copy *a-val-addr
    1002     compare a-val, *b-val-addr
    1003     {
    1004       break-if-=
    1005       trace-higher trace
    1006       trace-text trace, "eval", "=> false (numbers)"
    1007       return 0/false
    1008     }
    1009     trace-higher trace
    1010     trace-text trace, "eval", "=> true (numbers)"
    1011     return 1/true
    1012   }
    1013   compare b-type, 2/symbol
    1014   {
    1015     break-if-!=
    1016     var b-val-ah/eax: (addr handle stream byte) <- get b, text-data
    1017     var _b-val/eax: (addr stream byte) <- lookup *b-val-ah
    1018     var b-val/ecx: (addr stream byte) <- copy _b-val
    1019     var a-val-ah/eax: (addr handle stream byte) <- get a, text-data
    1020     var a-val/eax: (addr stream byte) <- lookup *a-val-ah
    1021     var tmp-array: (handle array byte)
    1022     var tmp-ah/edx: (addr handle array byte) <- address tmp-array
    1023     rewind-stream a-val
    1024     stream-to-array a-val, tmp-ah
    1025     var tmp/eax: (addr array byte) <- lookup *tmp-ah
    1026     var match?/eax: boolean <- stream-data-equal? b-val, tmp
    1027     trace-higher trace
    1028     {
    1029       compare match?, 0/false
    1030       break-if-=
    1031       trace-text trace, "eval", "=> true (symbols)"
    1032     }
    1033     {
    1034       compare match?, 0/false
    1035       break-if-!=
    1036       trace-text trace, "eval", "=> false (symbols)"
    1037     }
    1038     return match?
    1039   }
    1040   # if a is nil, b should be nil
    1041   {
    1042     # (assumes nil? returns 0 or 1)
    1043     var _b-nil?/eax: boolean <- nil? b
    1044     var b-nil?/ecx: boolean <- copy _b-nil?
    1045     var a-nil?/eax: boolean <- nil? a
    1046     # a == nil and b == nil => return true
    1047     {
    1048       compare a-nil?, 0/false
    1049       break-if-=
    1050       compare b-nil?, 0/false
    1051       break-if-=
    1052       trace-higher trace
    1053       trace-text trace, "eval", "=> true (nils)"
    1054       return 1/true
    1055     }
    1056     # a == nil => return false
    1057     {
    1058       compare a-nil?, 0/false
    1059       break-if-=
    1060       trace-higher trace
    1061       trace-text trace, "eval", "=> false (b != nil)"
    1062       return 0/false
    1063     }
    1064     # b == nil => return false
    1065     {
    1066       compare b-nil?, 0/false
    1067       break-if-=
    1068       trace-higher trace
    1069       trace-text trace, "eval", "=> false (a != nil)"
    1070       return 0/false
    1071     }
    1072   }
    1073   # a and b are pairs
    1074   var a-tmp-storage: (handle cell)
    1075   var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage
    1076   var b-tmp-storage: (handle cell)
    1077   var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage
    1078   # if cars aren't equal, return false
    1079   car a, a-tmp-ah, trace
    1080   car b, b-tmp-ah, trace
    1081   {
    1082     var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
    1083     var a-tmp/ecx: (addr cell) <- copy _a-tmp
    1084     var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
    1085     var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
    1086     compare result, 0/false
    1087     break-if-!=
    1088     trace-higher trace
    1089     trace-text trace, "eval", "=> false (car mismatch)"
    1090     return 0/false
    1091   }
    1092   # recurse on cdrs
    1093   cdr a, a-tmp-ah, trace
    1094   cdr b, b-tmp-ah, trace
    1095   var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
    1096   var a-tmp/ecx: (addr cell) <- copy _a-tmp
    1097   var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
    1098   var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
    1099   trace-higher trace
    1100   return result
    1101 }
    1102
    1103 fn fn? _x: (addr cell) -> _/eax: boolean {
    1104   var x/esi: (addr cell) <- copy _x
    1105   var type/eax: (addr int) <- get x, type
    1106   compare *type, 2/symbol
    1107   {
    1108     break-if-=
    1109     return 0/false
    1110   }
    1111   var contents-ah/eax: (addr handle stream byte) <- get x, text-data
    1112   var contents/eax: (addr stream byte) <- lookup *contents-ah
    1113   var result/eax: boolean <- stream-data-equal? contents, "fn"
    1114   return result
    1115 }
    1116
    1117 fn test-evaluate-is-well-behaved {
    1118   var t-storage: trace
    1119   var t/esi: (addr trace) <- address t-storage
    1120   initialize-trace t, 0x10, 0/visible  # we don't use trace UI
    1121   # env = nil
    1122   var env-storage: (handle cell)
    1123   var env-ah/ecx: (addr handle cell) <- address env-storage
    1124   allocate-pair env-ah
    1125   # eval sym(a), nil env
    1126   var tmp-storage: (handle cell)
    1127   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    1128   new-symbol tmp-ah, "a"
    1129   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/call-number
    1130   # doesn't die
    1131   check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved"
    1132 }
    1133
    1134 fn test-evaluate-number {
    1135   # env = nil
    1136   var env-storage: (handle cell)
    1137   var env-ah/ecx: (addr handle cell) <- address env-storage
    1138   allocate-pair env-ah
    1139   # tmp = 3
    1140   var tmp-storage: (handle cell)
    1141   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    1142   new-integer tmp-ah, 3
    1143   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number
    1144   #
    1145   var result/eax: (addr cell) <- lookup *tmp-ah
    1146   var result-type/edx: (addr int) <- get result, type
    1147   check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0"
    1148   var result-value-addr/eax: (addr float) <- get result, number-data
    1149   var result-value/eax: int <- convert *result-value-addr
    1150   check-ints-equal result-value, 3, "F - test-evaluate-number/1"
    1151 }
    1152
    1153 fn test-evaluate-symbol {
    1154   # tmp = (a . 3)
    1155   var val-storage: (handle cell)
    1156   var val-ah/ecx: (addr handle cell) <- address val-storage
    1157   new-integer val-ah, 3
    1158   var key-storage: (handle cell)
    1159   var key-ah/edx: (addr handle cell) <- address key-storage
    1160   new-symbol key-ah, "a"
    1161   var env-storage: (handle cell)
    1162   var env-ah/ebx: (addr handle cell) <- address env-storage
    1163   new-pair env-ah, *key-ah, *val-ah
    1164   # env = ((a . 3))
    1165   var nil-storage: (handle cell)
    1166   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    1167   allocate-pair nil-ah
    1168   new-pair env-ah, *env-ah, *nil-ah
    1169   # eval sym(a), env
    1170   var tmp-storage: (handle cell)
    1171   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    1172   new-symbol tmp-ah, "a"
    1173   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number
    1174   var result/eax: (addr cell) <- lookup *tmp-ah
    1175   var result-type/edx: (addr int) <- get result, type
    1176   check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0"
    1177   var result-value-addr/eax: (addr float) <- get result, number-data
    1178   var result-value/eax: int <- convert *result-value-addr
    1179   check-ints-equal result-value, 3, "F - test-evaluate-symbol/1"
    1180 }
    1181
    1182 fn test-evaluate-primitive-function {
    1183   var globals-storage: global-table
    1184   var globals/edi: (addr global-table) <- address globals-storage
    1185   initialize-globals globals
    1186   var nil-storage: (handle cell)
    1187   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    1188   allocate-pair nil-ah
    1189   var add-storage: (handle cell)
    1190   var add-ah/ebx: (addr handle cell) <- address add-storage
    1191   new-symbol add-ah, "+"
    1192   # eval +, nil env
    1193   var tmp-storage: (handle cell)
    1194   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
    1195   evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number
    1196   #
    1197   var result/eax: (addr cell) <- lookup *tmp-ah
    1198   var result-type/edx: (addr int) <- get result, type
    1199   check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0"
    1200   var result-value/eax: (addr int) <- get result, index-data
    1201   check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1"
    1202 }
    1203
    1204 fn test-evaluate-primitive-function-call {
    1205   var t-storage: trace
    1206   var t/edi: (addr trace) <- address t-storage
    1207   initialize-trace t, 0x100, 0/visible  # we don't use trace UI
    1208   #
    1209   var nil-storage: (handle cell)
    1210   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    1211   allocate-pair nil-ah
    1212   var one-storage: (handle cell)
    1213   var one-ah/edx: (addr handle cell) <- address one-storage
    1214   new-integer one-ah, 1
    1215   var add-storage: (handle cell)
    1216   var add-ah/ebx: (addr handle cell) <- address add-storage
    1217   new-symbol add-ah, "+"
    1218   # input is (+ 1 1)
    1219   var tmp-storage: (handle cell)
    1220   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
    1221   new-pair tmp-ah, *one-ah, *nil-ah
    1222   new-pair tmp-ah, *one-ah, *tmp-ah
    1223   new-pair tmp-ah, *add-ah, *tmp-ah
    1224 #?   dump-cell tmp-ah
    1225   #
    1226   var globals-storage: global-table
    1227   var globals/edx: (addr global-table) <- address globals-storage
    1228   initialize-globals globals
    1229   #
    1230   evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/call-number
    1231 #?   dump-trace t
    1232   #
    1233   var result/eax: (addr cell) <- lookup *tmp-ah
    1234   var result-type/edx: (addr int) <- get result, type
    1235   check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0"
    1236   var result-value-addr/eax: (addr float) <- get result, number-data
    1237   var result-value/eax: int <- convert *result-value-addr
    1238   check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1"
    1239 }