# 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-ah` or `env`
       3 # ignore args past 'trace' on a first reading; they're for the environment not the language
       4 # 'call-number' is just for showing intermediate progress; this is a _slow_ interpreter
       5 # side-effects if not in a test (screen-cell != 0):
       6 #   prints intermediate states of the screen to real screen
       7 #   stops if a keypress is encountered
       8 fn evaluate _in-ah: (addr handle cell), _out-ah: (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 {
       9   # stack overflow?   # disable when enabling Really-debug-print
      10   check-stack
      11   {
      12     var screen-cell/eax: (addr handle cell) <- copy screen-cell
      13     compare screen-cell, 0
      14     break-if-=
      15     var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell
      16     compare screen-cell-addr, 0
      17     break-if-=
      18     # if screen-cell exists, we're probably not in a test
      19     show-stack-state
      20   }
      21   # show intermediate progress on screen if necessary
      22   # treat input at the real keyboard as interrupting
      23   {
      24     compare screen-cell, 0
      25     break-if-=
      26     var tmp/eax: int <- copy call-number
      27     tmp <- and 0xf  # every 16 calls to evaluate
      28     compare tmp, 0
      29     break-if-!=
      30     var screen-cell/eax: (addr handle cell) <- copy screen-cell
      31     var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell
      32     compare screen-cell-addr, 0
      33     break-if-=
      34     var screen-obj-ah/eax: (addr handle screen) <- get screen-cell-addr, screen-data
      35     var screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
      36     compare screen-obj, 0
      37     break-if-=
      38     var y/ecx: int <- render-screen 0/screen, screen-obj, 0x70/xmin, 1/ymin
      39     var key/eax: byte <- read-key 0/keyboard
      40     compare key, 0
      41     break-if-=
      42     error trace, "key pressed; interrupting..."
      43   }
      44   # errors? skip
      45   {
      46     var error?/eax: boolean <- has-errors? trace
      47     compare error?, 0/false
      48     break-if-=
      49     return
      50   }
      51   var in-ah/esi: (addr handle cell) <- copy _in-ah
      52 #?   dump-cell in-ah
      53 #?   {
      54 #?     var foo/eax: byte <- read-key 0/keyboard
      55 #?     compare foo, 0
      56 #?     loop-if-=
      57 #?   }
      58 +-- 19 lines: # trace "evaluate " in " in environment " env -----------------------------------------------------------------------------------------------------------------------------
      77   trace-lower trace
      78   var in/eax: (addr cell) <- lookup *in-ah
      79   {
      80     var nil?/eax: boolean <- nil? in
      81     compare nil?, 0/false
      82     break-if-=
      83     # nil is a literal
      84     trace-text trace, "eval", "nil"
      85     copy-object _in-ah, _out-ah
      86     trace-higher trace
      87     return
      88   }
      89   var in-type/ecx: (addr int) <- get in, type
      90   compare *in-type, 1/number
      91   {
      92     break-if-!=
      93     # numbers are literals
      94     trace-text trace, "eval", "number"
      95     copy-object _in-ah, _out-ah
      96     trace-higher trace
      97     return
      98   }
      99   compare *in-type, 3/stream
     100   {
     101     break-if-!=
     102     # streams are literals
     103     trace-text trace, "eval", "stream"
     104     copy-object _in-ah, _out-ah
     105     trace-higher trace
     106     return
     107   }
     108   compare *in-type, 2/symbol
     109   {
     110     break-if-!=
     111     trace-text trace, "eval", "symbol"
     112     debug-print "a", 7/fg, 0/bg
     113     lookup-symbol in, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell
     114     debug-print "z", 7/fg, 0/bg
     115     trace-higher trace
     116     return
     117   }
     118   compare *in-type, 5/screen
     119   {
     120     break-if-!=
     121     trace-text trace, "eval", "screen"
     122     copy-object _in-ah, _out-ah
     123     trace-higher trace
     124     return
     125   }
     126   compare *in-type, 6/keyboard
     127   {
     128     break-if-!=
     129     trace-text trace, "eval", "keyboard"
     130     copy-object _in-ah, _out-ah
     131     trace-higher trace
     132     return
     133   }
     134   # 'in' is a syntax tree
     135   $evaluate:literal-function: {
     136     # trees starting with "litfn" are literals
     137     var expr/esi: (addr cell) <- copy in
     138     var in/edx: (addr cell) <- copy in
     139     var first-ah/ecx: (addr handle cell) <- get in, left
     140     var first/eax: (addr cell) <- lookup *first-ah
     141     var litfn?/eax: boolean <- litfn? first
     142     compare litfn?, 0/false
     143     break-if-=
     144     trace-text trace, "eval", "literal function"
     145     copy-object _in-ah, _out-ah
     146     trace-higher trace
     147     return
     148   }
     149   $evaluate:literal-macro: {
     150     # trees starting with "litmac" are literals
     151     var expr/esi: (addr cell) <- copy in
     152     var in/edx: (addr cell) <- copy in
     153     var first-ah/ecx: (addr handle cell) <- get in, left
     154     var first/eax: (addr cell) <- lookup *first-ah
     155     var litmac?/eax: boolean <- litmac? first
     156     compare litmac?, 0/false
     157     break-if-=
     158     trace-text trace, "eval", "literal macro"
     159     copy-object _in-ah, _out-ah
     160     trace-higher trace
     161     return
     162   }
     163   $evaluate:anonymous-function: {
     164     # trees starting with "fn" are anonymous functions
     165     var expr/esi: (addr cell) <- copy in
     166     var in/edx: (addr cell) <- copy in
     167     var first-ah/ecx: (addr handle cell) <- get in, left
     168     var first/eax: (addr cell) <- lookup *first-ah
     169     var fn?/eax: boolean <- fn? first
     170     compare fn?, 0/false
     171     break-if-=
     172     # turn (fn ...) into (litfn env ...)
     173     trace-text trace, "eval", "anonymous function"
     174     var rest-ah/eax: (addr handle cell) <- get in, right
     175     var tmp: (handle cell)
     176     var tmp-ah/edi: (addr handle cell) <- address tmp
     177     new-pair tmp-ah, env-h, *rest-ah
     178     var litfn: (handle cell)
     179     var litfn-ah/eax: (addr handle cell) <- address litfn
     180     new-symbol litfn-ah, "litfn"
     181     new-pair _out-ah, *litfn-ah, *tmp-ah
     182     trace-higher trace
     183     return
     184   }
     185   # builtins with "special" evaluation rules
     186   $evaluate:quote: {
     187     # trees starting with single quote create literals
     188     var expr/esi: (addr cell) <- copy in
     189     # if its first elem is not "'", break
     190     var first-ah/ecx: (addr handle cell) <- get in, left
     191     var rest-ah/edx: (addr handle cell) <- get in, right
     192     var first/eax: (addr cell) <- lookup *first-ah
     193     var quote?/eax: boolean <- symbol-equal? first, "'"
     194     compare quote?, 0/false
     195     break-if-=
     196     #
     197     trace-text trace, "eval", "quote"
     198     copy-object rest-ah, _out-ah
     199     trace-higher trace
     200     return
     201   }
     202   $evaluate:backquote: {
     203     # trees starting with single backquote create literals
     204     var expr/esi: (addr cell) <- copy in
     205     # if its first elem is not "'", break
     206     var first-ah/ecx: (addr handle cell) <- get in, left
     207     var rest-ah/edx: (addr handle cell) <- get in, right
     208     var first/eax: (addr cell) <- lookup *first-ah
     209     var backquote?/eax: boolean <- symbol-equal? first, "`"
     210     compare backquote?, 0/false
     211     break-if-=
     212     #
     213     trace-text trace, "eval", "backquote"
     214     debug-print "`(", 7/fg, 0/bg
     215     evaluate-backquote rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     216     debug-print ")", 7/fg, 0/bg
     217     trace-higher trace
     218     return
     219   }
     220   $evaluate:define: {
     221     # trees starting with "define" define globals
     222     var expr/esi: (addr cell) <- copy in
     223     # if its first elem is not "define", break
     224     var first-ah/ecx: (addr handle cell) <- get in, left
     225     var rest-ah/edx: (addr handle cell) <- get in, right
     226     var first/eax: (addr cell) <- lookup *first-ah
     227     var define?/eax: boolean <- symbol-equal? first, "define"
     228     compare define?, 0/false
     229     break-if-=
     230     #
     231     trace-text trace, "eval", "define"
     232     trace-text trace, "eval", "evaluating second arg"
     233     var rest/eax: (addr cell) <- lookup *rest-ah
     234     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     235     {
     236       var first-arg/eax: (addr cell) <- lookup *first-arg-ah
     237       var first-arg-type/eax: (addr int) <- get first-arg, type
     238       compare *first-arg-type, 2/symbol
     239       break-if-=
     240       error trace, "first arg to define must be a symbol"
     241       trace-higher trace
     242       return
     243     }
     244     rest-ah <- get rest, right
     245     rest <- lookup *rest-ah
     246     var second-arg-ah/edx: (addr handle cell) <- get rest, left
     247     debug-print "P", 4/fg, 0/bg
     248     increment call-number
     249     evaluate second-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     250     debug-print "Q", 4/fg, 0/bg
     251     # errors? skip
     252     {
     253       var error?/eax: boolean <- has-errors? trace
     254       compare error?, 0/false
     255       break-if-=
     256       trace-higher trace
     257       return
     258     }
     259     trace-text trace, "eval", "saving global binding"
     260     var first-arg/eax: (addr cell) <- lookup *first-arg-ah
     261     var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data
     262     var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah
     263     var tmp-string: (handle array byte)
     264     var tmp-ah/edx: (addr handle array byte) <- address tmp-string
     265     rewind-stream first-arg-data
     266     stream-to-array first-arg-data, tmp-ah
     267     var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah
     268     var out-ah/edi: (addr handle cell) <- copy _out-ah
     269     assign-or-create-global globals, first-arg-data-string, *out-ah, trace
     270     trace-higher trace
     271     return
     272   }
     273   $evaluate:set: {
     274     # trees starting with "set" mutate bindings
     275     var expr/esi: (addr cell) <- copy in
     276     # if its first elem is not "set", break
     277     var first-ah/ecx: (addr handle cell) <- get in, left
     278     var rest-ah/edx: (addr handle cell) <- get in, right
     279     var first/eax: (addr cell) <- lookup *first-ah
     280     var set?/eax: boolean <- symbol-equal? first, "set"
     281     compare set?, 0/false
     282     break-if-=
     283     #
     284     trace-text trace, "eval", "set"
     285     trace-text trace, "eval", "evaluating second arg"
     286     var rest/eax: (addr cell) <- lookup *rest-ah
     287     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     288     {
     289       var first-arg/eax: (addr cell) <- lookup *first-arg-ah
     290       var first-arg-type/eax: (addr int) <- get first-arg, type
     291       compare *first-arg-type, 2/symbol
     292       break-if-=
     293       error trace, "first arg to set must be a symbol"
     294       trace-higher trace
     295       return
     296     }
     297     rest-ah <- get rest, right
     298     rest <- lookup *rest-ah
     299     var second-arg-ah/edx: (addr handle cell) <- get rest, left
     300     debug-print "P", 4/fg, 0/bg
     301     increment call-number
     302     evaluate second-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     303     debug-print "Q", 4/fg, 0/bg
     304     # errors? skip
     305     {
     306       var error?/eax: boolean <- has-errors? trace
     307       compare error?, 0/false
     308       break-if-=
     309       trace-higher trace
     310       return
     311     }
     312     trace-text trace, "eval", "mutating binding"
     313     var first-arg/eax: (addr cell) <- lookup *first-arg-ah
     314     var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data
     315     var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah
     316     mutate-binding first-arg-data, _out-ah, env-h, globals, trace
     317     trace-higher trace
     318     return
     319   }
     320   $evaluate:and: {
     321     var expr/esi: (addr cell) <- copy in
     322     # if its first elem is not "and", break
     323     var first-ah/ecx: (addr handle cell) <- get in, left
     324     var rest-ah/edx: (addr handle cell) <- get in, right
     325     var first/eax: (addr cell) <- lookup *first-ah
     326     var and?/eax: boolean <- symbol-equal? first, "and"
     327     compare and?, 0/false
     328     break-if-=
     329     #
     330     trace-text trace, "eval", "and"
     331     trace-text trace, "eval", "evaluating first arg"
     332     var rest/eax: (addr cell) <- lookup *rest-ah
     333     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     334     debug-print "R2", 4/fg, 0/bg
     335     increment call-number
     336     evaluate first-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     337     debug-print "S2", 4/fg, 0/bg
     338     # errors? skip
     339     {
     340       var error?/eax: boolean <- has-errors? trace
     341       compare error?, 0/false
     342       break-if-=
     343       trace-higher trace
     344       return
     345     }
     346     # if first arg is nil, short-circuit
     347     var out-ah/eax: (addr handle cell) <- copy _out-ah
     348     var out/eax: (addr cell) <- lookup *out-ah
     349     var nil?/eax: boolean <- nil? out
     350     compare nil?, 0/false
     351     {
     352       break-if-=
     353       trace-higher trace
     354       return
     355     }
     356     var rest/eax: (addr cell) <- lookup *rest-ah
     357     rest-ah <- get rest, right
     358     rest <- lookup *rest-ah
     359     var second-ah/eax: (addr handle cell) <- get rest, left
     360     debug-print "T2", 4/fg, 0/bg
     361     increment call-number
     362     evaluate second-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     363     debug-print "U2", 4/fg, 0/bg
     364     trace-higher trace
     365     return
     366   }
     367   $evaluate:or: {
     368     var expr/esi: (addr cell) <- copy in
     369     # if its first elem is not "or", break
     370     var first-ah/ecx: (addr handle cell) <- get in, left
     371     var rest-ah/edx: (addr handle cell) <- get in, right
     372     var first/eax: (addr cell) <- lookup *first-ah
     373     var or?/eax: boolean <- symbol-equal? first, "or"
     374     compare or?, 0/false
     375     break-if-=
     376     #
     377     trace-text trace, "eval", "or"
     378     trace-text trace, "eval", "evaluating first arg"
     379     var rest/eax: (addr cell) <- lookup *rest-ah
     380     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     381     debug-print "R2", 4/fg, 0/bg
     382     increment call-number
     383     evaluate first-arg-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     384     debug-print "S2", 4/fg, 0/bg
     385     # errors? skip
     386     {
     387       var error?/eax: boolean <- has-errors? trace
     388       compare error?, 0/false
     389       break-if-=
     390       trace-higher trace
     391       return
     392     }
     393     # if first arg is not nil, short-circuit
     394     var out-ah/eax: (addr handle cell) <- copy _out-ah
     395     var out/eax: (addr cell) <- lookup *out-ah
     396     var nil?/eax: boolean <- nil? out
     397     compare nil?, 0/false
     398     {
     399       break-if-!=
     400       trace-higher trace
     401       return
     402     }
     403     var rest/eax: (addr cell) <- lookup *rest-ah
     404     rest-ah <- get rest, right
     405     rest <- lookup *rest-ah
     406     var second-ah/eax: (addr handle cell) <- get rest, left
     407     debug-print "T2", 4/fg, 0/bg
     408     increment call-number
     409     evaluate second-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     410     debug-print "U2", 4/fg, 0/bg
     411     # errors? skip
     412     {
     413       var error?/eax: boolean <- has-errors? trace
     414       compare error?, 0/false
     415       break-if-=
     416       trace-higher trace
     417       return
     418     }
     419     trace-higher trace
     420     return
     421   }
     422   $evaluate:if: {
     423     # trees starting with "if" are conditionals
     424     var expr/esi: (addr cell) <- copy in
     425     # if its first elem is not "if", break
     426     var first-ah/ecx: (addr handle cell) <- get in, left
     427     var rest-ah/edx: (addr handle cell) <- get in, right
     428     var first/eax: (addr cell) <- lookup *first-ah
     429     var if?/eax: boolean <- symbol-equal? first, "if"
     430     compare if?, 0/false
     431     break-if-=
     432     #
     433     trace-text trace, "eval", "if"
     434     trace-text trace, "eval", "evaluating first arg"
     435     var rest/eax: (addr cell) <- lookup *rest-ah
     436     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     437     var guard-h: (handle cell)
     438     var guard-ah/esi: (addr handle cell) <- address guard-h
     439     debug-print "R", 4/fg, 0/bg
     440     increment call-number
     441     evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     442     debug-print "S", 4/fg, 0/bg
     443     # errors? skip
     444     {
     445       var error?/eax: boolean <- has-errors? trace
     446       compare error?, 0/false
     447       break-if-=
     448       trace-higher trace
     449       return
     450     }
     451     rest-ah <- get rest, right
     452     rest <- lookup *rest-ah
     453     var branch-ah/edi: (addr handle cell) <- get rest, left
     454     var guard-a/eax: (addr cell) <- lookup *guard-ah
     455     var skip-to-third-arg?/eax: boolean <- nil? guard-a
     456     compare skip-to-third-arg?, 0/false
     457     {
     458       break-if-=
     459       trace-text trace, "eval", "skipping to third arg"
     460       var rest/eax: (addr cell) <- lookup *rest-ah
     461       rest-ah <- get rest, right
     462       rest <- lookup *rest-ah
     463       branch-ah <- get rest, left
     464     }
     465     debug-print "T", 4/fg, 0/bg
     466     increment call-number
     467     evaluate branch-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     468     debug-print "U", 4/fg, 0/bg
     469     trace-higher trace
     470     return
     471   }
     472   $evaluate:while: {
     473     # trees starting with "while" are loops
     474     var expr/esi: (addr cell) <- copy in
     475     # if its first elem is not "while", break
     476     var first-ah/ecx: (addr handle cell) <- get in, left
     477     var rest-ah/edx: (addr handle cell) <- get in, right
     478     var first/eax: (addr cell) <- lookup *first-ah
     479     var first-type/ecx: (addr int) <- get first, type
     480     compare *first-type, 2/symbol
     481     break-if-!=
     482     var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
     483     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
     484     var while?/eax: boolean <- stream-data-equal? sym-data, "while"
     485     compare while?, 0/false
     486     break-if-=
     487     #
     488     trace-text trace, "eval", "while"
     489     var rest/eax: (addr cell) <- lookup *rest-ah
     490     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
     491     rest-ah <- get rest, right
     492     var guard-h: (handle cell)
     493     var guard-ah/esi: (addr handle cell) <- address guard-h
     494     $evaluate:while:loop-execution: {
     495       {
     496         var error?/eax: boolean <- has-errors? trace
     497         compare error?, 0/false
     498         break-if-!= $evaluate:while:loop-execution
     499       }
     500       trace-text trace, "eval", "loop termination check"
     501       debug-print "V", 4/fg, 0/bg
     502       increment call-number
     503       evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     504       debug-print "W", 4/fg, 0/bg
     505       # errors? skip
     506       {
     507         var error?/eax: boolean <- has-errors? trace
     508         compare error?, 0/false
     509         break-if-=
     510         trace-higher trace
     511         return
     512       }
     513       var guard-a/eax: (addr cell) <- lookup *guard-ah
     514       var done?/eax: boolean <- nil? guard-a
     515       compare done?, 0/false
     516       break-if-!=
     517       evaluate-exprs rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     518       # errors? skip
     519       {
     520         var error?/eax: boolean <- has-errors? trace
     521         compare error?, 0/false
     522         break-if-=
     523         trace-higher trace
     524         return
     525       }
     526       loop
     527     }
     528     trace-text trace, "eval", "loop terminated"
     529     trace-higher trace
     530     return
     531   }
     532 +-- 15 lines: # trace "evaluate function call elements in " in --------------------------------------------------------------------------------------------------------------------------
     547   trace-lower trace
     548   var evaluated-list-storage: (handle cell)
     549   var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage
     550   var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah
     551   var curr/ecx: (addr cell) <- copy in
     552   $evaluate-list:loop: {
     553     allocate-pair curr-out-ah
     554     var nil?/eax: boolean <- nil? curr
     555     compare nil?, 0/false
     556     break-if-!=
     557     # eval left
     558     var curr-out/eax: (addr cell) <- lookup *curr-out-ah
     559     var left-out-ah/edi: (addr handle cell) <- get curr-out, left
     560     var left-ah/esi: (addr handle cell) <- get curr, left
     561     debug-print "A", 4/fg, 0/bg
     562     increment call-number
     563     evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     564     debug-print "B", 4/fg, 0/bg
     565     # errors? skip
     566     {
     567       var error?/eax: boolean <- has-errors? trace
     568       compare error?, 0/false
     569       break-if-=
     570       trace-higher trace
     571       trace-higher trace
     572       return
     573     }
     574     #
     575     curr-out-ah <- get curr-out, right
     576     var right-ah/eax: (addr handle cell) <- get curr, right
     577     var right/eax: (addr cell) <- lookup *right-ah
     578     curr <- copy right
     579     loop
     580   }
     581   trace-higher trace
     582   var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah
     583   var function-ah/ecx: (addr handle cell) <- get evaluated-list, left
     584   var args-ah/edx: (addr handle cell) <- get evaluated-list, right
     585   debug-print "C", 4/fg, 0/bg
     586   apply function-ah, args-ah, _out-ah, globals, trace, screen-cell, keyboard-cell, call-number
     587   debug-print "Y", 4/fg, 0/bg
     588   trace-higher trace
     589 +-- 15 lines: # trace "=> " _out-ah -----------------------------------------------------------------------------------------------------------------------------------------------------
     604   debug-print "Z", 4/fg, 0/bg
     605 }
     606
     607 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 {
     608   var f-ah/eax: (addr handle cell) <- copy _f-ah
     609   var _f/eax: (addr cell) <- lookup *f-ah
     610   var f/esi: (addr cell) <- copy _f
     611   # call primitive functions
     612   {
     613     var f-type/eax: (addr int) <- get f, type
     614     compare *f-type, 4/primitive-function
     615     break-if-!=
     616     apply-primitive f, args-ah, out, globals, trace
     617     return
     618   }
     619   # if it's not a primitive function it must be an anonymous function
     620 +-- 19 lines: # trace "apply anonymous function " f " in environment " env --------------------------------------------------------------------------------------------------------------
     639   trace-lower trace
     640   {
     641     var f-type/ecx: (addr int) <- get f, type
     642     compare *f-type, 0/pair
     643     break-if-!=
     644     var first-ah/eax: (addr handle cell) <- get f, left
     645     var first/eax: (addr cell) <- lookup *first-ah
     646     var litfn?/eax: boolean <- litfn? first
     647     compare litfn?, 0/false
     648     break-if-=
     649     var rest-ah/esi: (addr handle cell) <- get f, right
     650     var rest/eax: (addr cell) <- lookup *rest-ah
     651     var callee-env-ah/edx: (addr handle cell) <- get rest, left
     652     rest-ah <- get rest, right
     653     rest <- lookup *rest-ah
     654     var params-ah/ecx: (addr handle cell) <- get rest, left
     655     var body-ah/eax: (addr handle cell) <- get rest, right
     656     debug-print "D", 7/fg, 0/bg
     657     apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, screen-cell, keyboard-cell, call-number
     658     debug-print "Y", 7/fg, 0/bg
     659     trace-higher trace
     660     return
     661   }
     662   error trace, "unknown function"
     663 }
     664
     665 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 {
     666   # push bindings for params to env
     667   var new-env-h: (handle cell)
     668   var new-env-ah/esi: (addr handle cell) <- address new-env-h
     669   push-bindings params-ah, args-ah, env-h, new-env-ah, trace
     670   # errors? skip
     671   {
     672     var error?/eax: boolean <- has-errors? trace
     673     compare error?, 0/false
     674     break-if-=
     675     return
     676   }
     677   #
     678   evaluate-exprs body-ah, out, new-env-h, globals, trace, screen-cell, keyboard-cell, call-number
     679 }
     680
     681 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 {
     682   # eval all exprs, writing result to `out` each time
     683   var exprs-ah/ecx: (addr handle cell) <- copy _exprs-ah
     684   $evaluate-exprs:loop: {
     685     var exprs/eax: (addr cell) <- lookup *exprs-ah
     686     # stop when exprs is nil
     687     {
     688       var exprs-nil?/eax: boolean <- nil? exprs
     689       compare exprs-nil?, 0/false
     690       break-if-!= $evaluate-exprs:loop
     691     }
     692     # evaluate each expression, writing result to `out`
     693     {
     694       var curr-ah/eax: (addr handle cell) <- get exprs, left
     695       debug-print "E", 7/fg, 0/bg
     696       increment call-number
     697       evaluate curr-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
     698       debug-print "X", 7/fg, 0/bg
     699       # errors? skip
     700       {
     701         var error?/eax: boolean <- has-errors? trace
     702         compare error?, 0/false
     703         break-if-=
     704         return
     705       }
     706     }
     707     #
     708     exprs-ah <- get exprs, right
     709     loop
     710   }
     711   # `out` contains result of evaluating final expression
     712 }
     713
     714 # Bind params to corresponding args and add the bindings to old-env. Return
     715 # the result in env-ah.
     716 #
     717 # We never modify old-env, but we point to it. This way other parts of the
     718 # interpreter can continue using old-env, and everything works harmoniously
     719 # even though no cells are copied around.
     720 #
     721 # env should always be a DAG (ignoring internals of values). It doesn't have
     722 # to be a tree (some values may be shared), but there are also no cycles.
     723 #
     724 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure
     725 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) {
     726   var params-ah/edx: (addr handle cell) <- copy _params-ah
     727   var args-ah/ebx: (addr handle cell) <- copy _args-ah
     728   var _params/eax: (addr cell) <- lookup *params-ah
     729   var params/esi: (addr cell) <- copy _params
     730   {
     731     var params-nil?/eax: boolean <- nil? params
     732     compare params-nil?, 0/false
     733     break-if-=
     734     # nil is a literal
     735     trace-text trace, "eval", "done with push-bindings"
     736     copy-handle old-env-h, env-ah
     737     return
     738   }
     739   # Params can only be symbols or pairs. Args can be anything.
     740 +-- 22 lines: # trace "pushing bindings from " params " to " args -----------------------------------------------------------------------------------------------------------------------
     762   trace-lower trace
     763   var params-type/eax: (addr int) <- get params, type
     764   compare *params-type, 2/symbol
     765   {
     766     break-if-!=
     767     trace-text trace, "eval", "symbol; binding to all remaining args"
     768     # create a new binding
     769     var new-binding-storage: (handle cell)
     770     var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage
     771     new-pair new-binding-ah, *params-ah, *args-ah
     772     # push it to env
     773     new-pair env-ah, *new-binding-ah, old-env-h
     774     trace-higher trace
     775     return
     776   }
     777   compare *params-type, 0/pair
     778   {
     779     break-if-=
     780     error trace, "cannot bind a non-symbol"
     781     trace-higher trace
     782     return
     783   }
     784   var _args/eax: (addr cell) <- lookup *args-ah
     785   var args/edi: (addr cell) <- copy _args
     786   # params is now a pair, so args must be also
     787   {
     788     var args-nil?/eax: boolean <- nil? args
     789     compare args-nil?, 0/false
     790     break-if-=
     791     error trace, "not enough args to bind"
     792     return
     793   }
     794   var args-type/eax: (addr int) <- get args, type
     795   compare *args-type, 0/pair
     796   {
     797     break-if-=
     798     error trace, "args not in a proper list"
     799     trace-higher trace
     800     return
     801   }
     802   var intermediate-env-storage: (handle cell)
     803   var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage
     804   var first-param-ah/eax: (addr handle cell) <- get params, left
     805   var first-arg-ah/ecx: (addr handle cell) <- get args, left
     806   push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace
     807   # errors? skip
     808   {
     809     var error?/eax: boolean <- has-errors? trace
     810     compare error?, 0/false
     811     break-if-=
     812     trace-higher trace
     813     return
     814   }
     815   var remaining-params-ah/eax: (addr handle cell) <- get params, right
     816   var remaining-args-ah/ecx: (addr handle cell) <- get args, right
     817   push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace
     818   trace-higher trace
     819 }
     820
     821 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) {
     822   # trace sym
     823   {
     824     var should-trace?/eax: boolean <- should-trace? trace
     825     compare should-trace?, 0/false
     826     break-if-=
     827     var stream-storage: (stream byte 0x800)  # pessimistically sized just for the large alist loaded from disk in `main`
     828     var stream/ecx: (addr stream byte) <- address stream-storage
     829     write stream, "look up "
     830     var sym2/eax: (addr cell) <- copy sym
     831     var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data
     832     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
     833     rewind-stream sym-data
     834     write-stream stream, sym-data
     835     write stream, " in "
     836     var env-ah/eax: (addr handle cell) <- address env-h
     837     var nested-trace-storage: trace
     838     var nested-trace/edi: (addr trace) <- address nested-trace-storage
     839     initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
     840     print-cell env-ah, stream, nested-trace
     841     trace trace, "eval", stream
     842   }
     843   trace-lower trace
     844   var _env/eax: (addr cell) <- lookup env-h
     845   var env/ebx: (addr cell) <- copy _env
     846   # if env is not a list, error
     847   {
     848     var env-type/ecx: (addr int) <- get env, type
     849     compare *env-type, 0/pair
     850     break-if-=
     851     error trace, "eval found a non-list environment"
     852     trace-higher trace
     853     return
     854   }
     855   # if env is nil, look up in globals
     856   {
     857     var env-nil?/eax: boolean <- nil? env
     858     compare env-nil?, 0/false
     859     break-if-=
     860     debug-print "b", 7/fg, 0/bg
     861     lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell
     862     debug-print "x", 7/fg, 0/bg
     863     trace-higher trace
     864 +-- 19 lines: # trace "=> " out " (global)" ---------------------------------------------------------------------------------------------------------------------------------------------
     883     debug-print "y", 7/fg, 0/bg
     884     return
     885   }
     886   # check car
     887   var env-head-storage: (handle cell)
     888   var env-head-ah/eax: (addr handle cell) <- address env-head-storage
     889   car env, env-head-ah, trace
     890   var _env-head/eax: (addr cell) <- lookup *env-head-ah
     891   var env-head/ecx: (addr cell) <- copy _env-head
     892   # if car is not a list, abort
     893   {
     894     var env-head-type/eax: (addr int) <- get env-head, type
     895     compare *env-head-type, 0/pair
     896     break-if-=
     897     error trace, "environment is not a list of (key . value) pairs"
     898     trace-higher trace
     899     return
     900   }
     901   # check key
     902   var curr-key-storage: (handle cell)
     903   var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage
     904   car env-head, curr-key-ah, trace
     905   var curr-key/eax: (addr cell) <- lookup *curr-key-ah
     906   # if key is not a symbol, abort
     907   {
     908     var curr-key-type/eax: (addr int) <- get curr-key, type
     909     compare *curr-key-type, 2/symbol
     910     break-if-=
     911     error trace, "environment contains a binding for a non-symbol"
     912     trace-higher trace
     913     return
     914   }
     915   # if key matches sym, return val
     916   var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace
     917   compare match?, 0/false
     918   {
     919     break-if-=
     920     cdr env-head, out, trace
     921 +-- 19 lines: # trace "=> " out " (match)" ----------------------------------------------------------------------------------------------------------------------------------------------
     940     trace-higher trace
     941     return
     942   }
     943   # otherwise recurse
     944   var env-tail-storage: (handle cell)
     945   var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
     946   cdr env, env-tail-ah, trace
     947   lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell
     948   trace-higher trace
     949 +-- 19 lines: # trace "=> " out " (recurse)" --------------------------------------------------------------------------------------------------------------------------------------------
     968 }
     969
     970 fn test-lookup-symbol-in-env {
     971   # tmp = (a . 3)
     972   var val-storage: (handle cell)
     973   var val-ah/ecx: (addr handle cell) <- address val-storage
     974   new-integer val-ah, 3
     975   var key-storage: (handle cell)
     976   var key-ah/edx: (addr handle cell) <- address key-storage
     977   new-symbol key-ah, "a"
     978   var env-storage: (handle cell)
     979   var env-ah/ebx: (addr handle cell) <- address env-storage
     980   new-pair env-ah, *key-ah, *val-ah
     981   # env = ((a . 3))
     982   var nil-storage: (handle cell)
     983   var nil-ah/ecx: (addr handle cell) <- address nil-storage
     984   allocate-pair nil-ah
     985   new-pair env-ah, *env-ah, *nil-ah
     986   # lookup sym(a) in env tmp
     987   var tmp-storage: (handle cell)
     988   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
     989   new-symbol tmp-ah, "a"
     990   var in/eax: (addr cell) <- lookup *tmp-ah
     991   var trace-storage: trace
     992   var trace/edi: (addr trace) <- address trace-storage
     993   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
     994   lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard
     995   var result/eax: (addr cell) <- lookup *tmp-ah
     996   var result-type/edx: (addr int) <- get result, type
     997   check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0"
     998   var result-value-addr/eax: (addr float) <- get result, number-data
     999   var result-value/eax: int <- convert *result-value-addr
    1000   check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1"
    1001 }
    1002
    1003 fn test-lookup-symbol-in-globals {
    1004   var globals-storage: global-table
    1005   var globals/edi: (addr global-table) <- address globals-storage
    1006   initialize-globals globals
    1007   # env = nil
    1008   var nil-storage: (handle cell)
    1009   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    1010   allocate-pair nil-ah
    1011   # lookup sym(a), env
    1012   var tmp-storage: (handle cell)
    1013   var tmp-ah/ebx: (addr handle cell) <- address tmp-storage
    1014   new-symbol tmp-ah, "+"
    1015   var in/eax: (addr cell) <- lookup *tmp-ah
    1016   var trace-storage: trace
    1017   var trace/esi: (addr trace) <- address trace-storage
    1018   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
    1019   lookup-symbol in, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard
    1020   var result/eax: (addr cell) <- lookup *tmp-ah
    1021   var result-type/edx: (addr int) <- get result, type
    1022   check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0"
    1023   var result-value/eax: (addr int) <- get result, index-data
    1024   check-ints-equal *result-value, 1/add, "F - test-lookup-symbol-in-globals/1"
    1025 }
    1026
    1027 fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) {
    1028   # trace name
    1029   {
    1030     var should-trace?/eax: boolean <- should-trace? trace
    1031     compare should-trace?, 0/false
    1032     break-if-=
    1033     var stream-storage: (stream byte 0x800)  # pessimistically sized just for the large alist loaded from disk in `main`
    1034     var stream/ecx: (addr stream byte) <- address stream-storage
    1035     write stream, "bind "
    1036     rewind-stream name
    1037     write-stream stream, name
    1038     write stream, " to "
    1039     var nested-trace-storage: trace
    1040     var nested-trace/edi: (addr trace) <- address nested-trace-storage
    1041     initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
    1042     print-cell val, stream, nested-trace
    1043     write stream, " in "
    1044     var env-ah/eax: (addr handle cell) <- address env-h
    1045     clear-trace nested-trace
    1046     print-cell env-ah, stream, nested-trace
    1047     trace trace, "eval", stream
    1048   }
    1049   trace-lower trace
    1050   var _env/eax: (addr cell) <- lookup env-h
    1051   var env/ebx: (addr cell) <- copy _env
    1052   # if env is not a list, abort
    1053   {
    1054     var env-type/ecx: (addr int) <- get env, type
    1055     compare *env-type, 0/pair
    1056     break-if-=
    1057     error trace, "eval found a non-list environment"
    1058     trace-higher trace
    1059     return
    1060   }
    1061   # if env is nil, look in globals
    1062   {
    1063     var env-nil?/eax: boolean <- nil? env
    1064     compare env-nil?, 0/false
    1065     break-if-=
    1066     debug-print "b", 3/fg, 0/bg
    1067     mutate-binding-in-globals name, val, globals, trace
    1068     debug-print "x", 3/fg, 0/bg
    1069     trace-higher trace
    1070 +-- 19 lines: # trace "=> " val " (global)" ---------------------------------------------------------------------------------------------------------------------------------------------
    1089     debug-print "y", 3/fg, 0/bg
    1090     return
    1091   }
    1092   # check car
    1093   var env-head-storage: (handle cell)
    1094   var env-head-ah/eax: (addr handle cell) <- address env-head-storage
    1095   car env, env-head-ah, trace
    1096   var _env-head/eax: (addr cell) <- lookup *env-head-ah
    1097   var env-head/ecx: (addr cell) <- copy _env-head
    1098   # if car is not a list, abort
    1099   {
    1100     var env-head-type/eax: (addr int) <- get env-head, type
    1101     compare *env-head-type, 0/pair
    1102     break-if-=
    1103     error trace, "environment is not a list of (key . value) pairs"
    1104     trace-higher trace
    1105     return
    1106   }
    1107   # check key
    1108   var curr-key-storage: (handle cell)
    1109   var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage
    1110   car env-head, curr-key-ah, trace
    1111   var curr-key/eax: (addr cell) <- lookup *curr-key-ah
    1112   # if key is not a symbol, abort
    1113   {
    1114     var curr-key-type/eax: (addr int) <- get curr-key, type
    1115     compare *curr-key-type, 2/symbol
    1116     break-if-=
    1117     error trace, "environment contains a binding for a non-symbol"
    1118     trace-higher trace
    1119     return
    1120   }
    1121   # if key matches name, return val
    1122   var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data
    1123   var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah
    1124   var match?/eax: boolean <- streams-data-equal? curr-key-data, name
    1125   compare match?, 0/false
    1126   {
    1127     break-if-=
    1128     var dest/eax: (addr handle cell) <- get env-head, right
    1129     copy-object val, dest
    1130     trace-text trace, "eval", "=> done"
    1131     trace-higher trace
    1132     return
    1133   }
    1134   # otherwise recurse
    1135   var env-tail-storage: (handle cell)
    1136   var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
    1137   cdr env, env-tail-ah, trace
    1138   mutate-binding name, val, *env-tail-ah, globals, trace
    1139   trace-higher trace
    1140 }
    1141
    1142 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
    1143   trace-text trace, "eval", "car"
    1144   trace-lower trace
    1145   var in/eax: (addr cell) <- copy _in
    1146   # if in is not a list, abort
    1147   {
    1148     var in-type/ecx: (addr int) <- get in, type
    1149     compare *in-type, 0/pair
    1150     break-if-=
    1151     error trace, "car on a non-list"
    1152     trace-higher trace
    1153     return
    1154   }
    1155   # if in is nil, abort
    1156   {
    1157     var in-nil?/eax: boolean <- nil? in
    1158     compare in-nil?, 0/false
    1159     break-if-=
    1160     error trace, "car on nil"
    1161     trace-higher trace
    1162     return
    1163   }
    1164   var in-left/eax: (addr handle cell) <- get in, left
    1165   copy-object in-left, out
    1166   trace-higher trace
    1167   return
    1168 }
    1169
    1170 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
    1171   trace-text trace, "eval", "cdr"
    1172   trace-lower trace
    1173   var in/eax: (addr cell) <- copy _in
    1174   # if in is not a list, abort
    1175   {
    1176     var in-type/ecx: (addr int) <- get in, type
    1177     compare *in-type, 0/pair
    1178     break-if-=
    1179     error trace, "car on a non-list"
    1180     trace-higher trace
    1181     return
    1182   }
    1183   # if in is nil, abort
    1184   {
    1185     var in-nil?/eax: boolean <- nil? in
    1186     compare in-nil?, 0/false
    1187     break-if-=
    1188     error trace, "car on nil"
    1189     trace-higher trace
    1190     return
    1191   }
    1192   var in-right/eax: (addr handle cell) <- get in, right
    1193   copy-object in-right, out
    1194   trace-higher trace
    1195   return
    1196 }
    1197
    1198 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean {
    1199   trace-text trace, "eval", "cell-isomorphic?"
    1200   trace-lower trace
    1201   var a/esi: (addr cell) <- copy _a
    1202   var b/edi: (addr cell) <- copy _b
    1203   # if types don't match, return false
    1204   var a-type-addr/eax: (addr int) <- get a, type
    1205   var b-type-addr/ecx: (addr int) <- get b, type
    1206   var b-type/ecx: int <- copy *b-type-addr
    1207   compare b-type, *a-type-addr
    1208   {
    1209     break-if-=
    1210     trace-higher trace
    1211     trace-text trace, "eval", "=> false (type)"
    1212     return 0/false
    1213   }
    1214   # if types are number, compare number-data
    1215   # TODO: exactly comparing floats is a bad idea
    1216   compare b-type, 1/number
    1217   {
    1218     break-if-!=
    1219     var a-val-addr/eax: (addr float) <- get a, number-data
    1220     var b-val-addr/ecx: (addr float) <- get b, number-data
    1221     var a-val/xmm0: float <- copy *a-val-addr
    1222     compare a-val, *b-val-addr
    1223     {
    1224       break-if-=
    1225       trace-higher trace
    1226       trace-text trace, "eval", "=> false (numbers)"
    1227       return 0/false
    1228     }
    1229     trace-higher trace
    1230     trace-text trace, "eval", "=> true (numbers)"
    1231     return 1/true
    1232   }
    1233   $cell-isomorphic?:text-data: {
    1234     {
    1235       compare b-type, 2/symbol
    1236       break-if-=
    1237       compare b-type, 3/stream
    1238       break-if-=
    1239       break $cell-isomorphic?:text-data
    1240     }
    1241     var b-val-ah/eax: (addr handle stream byte) <- get b, text-data
    1242     var _b-val/eax: (addr stream byte) <- lookup *b-val-ah
    1243     var b-val/ecx: (addr stream byte) <- copy _b-val
    1244     var a-val-ah/eax: (addr handle stream byte) <- get a, text-data
    1245     var a-val/eax: (addr stream byte) <- lookup *a-val-ah
    1246     var tmp-array: (handle array byte)
    1247     var tmp-ah/edx: (addr handle array byte) <- address tmp-array
    1248     rewind-stream a-val
    1249     stream-to-array a-val, tmp-ah
    1250     var tmp/eax: (addr array byte) <- lookup *tmp-ah
    1251     var match?/eax: boolean <- stream-data-equal? b-val, tmp
    1252     trace-higher trace
    1253     {
    1254       compare match?, 0/false
    1255       break-if-=
    1256       trace-text trace, "eval", "=> true (symbols)"
    1257     }
    1258     {
    1259       compare match?, 0/false
    1260       break-if-!=
    1261       trace-text trace, "eval", "=> false (symbols)"
    1262     }
    1263     return match?
    1264   }
    1265   # if objects are primitive functions, compare index-data
    1266   compare b-type, 4/primitive
    1267   {
    1268     break-if-!=
    1269     var a-val-addr/eax: (addr int) <- get a, index-data
    1270     var b-val-addr/ecx: (addr int) <- get b, index-data
    1271     var a-val/eax: int <- copy *a-val-addr
    1272     compare a-val, *b-val-addr
    1273     {
    1274       break-if-=
    1275       trace-higher trace
    1276       trace-text trace, "eval", "=> false (primitives)"
    1277       return 0/false
    1278     }
    1279     trace-higher trace
    1280     trace-text trace, "eval", "=> true (primitives)"
    1281     return 1/true
    1282   }
    1283   # if objects are screens, check if they're the same object
    1284   compare b-type, 5/screen
    1285   {
    1286     break-if-!=
    1287     var a-val-addr/eax: (addr handle screen) <- get a, screen-data
    1288     var b-val-addr/ecx: (addr handle screen) <- get b, screen-data
    1289     var result/eax: boolean <- handle-equal? *a-val-addr, *b-val-addr
    1290     compare result, 0/false
    1291     return result
    1292   }
    1293   # if objects are keyboards, check if they have the same contents
    1294   compare b-type, 6/keyboard
    1295   {
    1296     break-if-!=
    1297     var a-val-addr/ecx: (addr handle gap-buffer) <- get a, keyboard-data
    1298     var _a/eax: (addr gap-buffer) <- lookup *a-val-addr
    1299     var a/ecx: (addr gap-buffer) <- copy _a
    1300     var b-val-addr/eax: (addr handle gap-buffer) <- get b, keyboard-data
    1301     var b/eax: (addr gap-buffer) <- lookup *b-val-addr
    1302     var result/eax: boolean <- gap-buffers-equal? a, b
    1303     return result
    1304   }
    1305   # if a is nil, b should be nil
    1306   {
    1307     # (assumes nil? returns 0 or 1)
    1308     var _b-nil?/eax: boolean <- nil? b
    1309     var b-nil?/ecx: boolean <- copy _b-nil?
    1310     var a-nil?/eax: boolean <- nil? a
    1311     # a == nil and b == nil => return true
    1312     {
    1313       compare a-nil?, 0/false
    1314       break-if-=
    1315       compare b-nil?, 0/false
    1316       break-if-=
    1317       trace-higher trace
    1318       trace-text trace, "eval", "=> true (nils)"
    1319       return 1/true
    1320     }
    1321     # a == nil => return false
    1322     {
    1323       compare a-nil?, 0/false
    1324       break-if-=
    1325       trace-higher trace
    1326       trace-text trace, "eval", "=> false (b != nil)"
    1327       return 0/false
    1328     }
    1329     # b == nil => return false
    1330     {
    1331       compare b-nil?, 0/false
    1332       break-if-=
    1333       trace-higher trace
    1334       trace-text trace, "eval", "=> false (a != nil)"
    1335       return 0/false
    1336     }
    1337   }
    1338   # a and b are pairs
    1339   var a-tmp-storage: (handle cell)
    1340   var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage
    1341   var b-tmp-storage: (handle cell)
    1342   var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage
    1343   # if cars aren't equal, return false
    1344   car a, a-tmp-ah, trace
    1345   car b, b-tmp-ah, trace
    1346   {
    1347     var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
    1348     var a-tmp/ecx: (addr cell) <- copy _a-tmp
    1349     var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
    1350     var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
    1351     compare result, 0/false
    1352     break-if-!=
    1353     trace-higher trace
    1354     trace-text trace, "eval", "=> false (car mismatch)"
    1355     return 0/false
    1356   }
    1357   # recurse on cdrs
    1358   cdr a, a-tmp-ah, trace
    1359   cdr b, b-tmp-ah, trace
    1360   var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
    1361   var a-tmp/ecx: (addr cell) <- copy _a-tmp
    1362   var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
    1363   var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
    1364   trace-higher trace
    1365   return result
    1366 }
    1367
    1368 fn fn? _x: (addr cell) -> _/eax: boolean {
    1369   var x/esi: (addr cell) <- copy _x
    1370   var type/eax: (addr int) <- get x, type
    1371   compare *type, 2/symbol
    1372   {
    1373     break-if-=
    1374     return 0/false
    1375   }
    1376   var contents-ah/eax: (addr handle stream byte) <- get x, text-data
    1377   var contents/eax: (addr stream byte) <- lookup *contents-ah
    1378   var result/eax: boolean <- stream-data-equal? contents, "fn"
    1379   return result
    1380 }
    1381
    1382 fn litfn? _x: (addr cell) -> _/eax: boolean {
    1383   var x/esi: (addr cell) <- copy _x
    1384   var type/eax: (addr int) <- get x, type
    1385   compare *type, 2/symbol
    1386   {
    1387     break-if-=
    1388     return 0/false
    1389   }
    1390   var contents-ah/eax: (addr handle stream byte) <- get x, text-data
    1391   var contents/eax: (addr stream byte) <- lookup *contents-ah
    1392   var result/eax: boolean <- stream-data-equal? contents, "litfn"
    1393   return result
    1394 }
    1395
    1396 fn litmac? _x: (addr cell) -> _/eax: boolean {
    1397   var x/esi: (addr cell) <- copy _x
    1398   var type/eax: (addr int) <- get x, type
    1399   compare *type, 2/symbol
    1400   {
    1401     break-if-=
    1402     return 0/false
    1403   }
    1404   var contents-ah/eax: (addr handle stream byte) <- get x, text-data
    1405   var contents/eax: (addr stream byte) <- lookup *contents-ah
    1406   var result/eax: boolean <- stream-data-equal? contents, "litmac"
    1407   return result
    1408 }
    1409
    1410 fn test-evaluate-is-well-behaved {
    1411   var t-storage: trace
    1412   var t/esi: (addr trace) <- address t-storage
    1413   initialize-trace t, 0x100/max-depth, 0x10/capacity, 0/visible  # we don't use trace UI
    1414   # env = nil
    1415   var env-storage: (handle cell)
    1416   var env-ah/ecx: (addr handle cell) <- address env-storage
    1417   allocate-pair env-ah
    1418   # eval sym(a), nil env
    1419   var tmp-storage: (handle cell)
    1420   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    1421   new-symbol tmp-ah, "a"
    1422   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/call-number
    1423   # doesn't die
    1424   check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved"
    1425 }
    1426
    1427 fn test-evaluate-number {
    1428   # env = nil
    1429   var env-storage: (handle cell)
    1430   var env-ah/ecx: (addr handle cell) <- address env-storage
    1431   allocate-pair env-ah
    1432   # tmp = 3
    1433   var tmp-storage: (handle cell)
    1434   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    1435   new-integer tmp-ah, 3
    1436   var trace-storage: trace
    1437   var trace/edi: (addr trace) <- address trace-storage
    1438   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
    1439   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
    1440   #
    1441   var result/eax: (addr cell) <- lookup *tmp-ah
    1442   var result-type/edx: (addr int) <- get result, type
    1443   check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0"
    1444   var result-value-addr/eax: (addr float) <- get result, number-data
    1445   var result-value/eax: int <- convert *result-value-addr
    1446   check-ints-equal result-value, 3, "F - test-evaluate-number/1"
    1447 }
    1448
    1449 fn test-evaluate-symbol {
    1450   # tmp = (a . 3)
    1451   var val-storage: (handle cell)
    1452   var val-ah/ecx: (addr handle cell) <- address val-storage
    1453   new-integer val-ah, 3
    1454   var key-storage: (handle cell)
    1455   var key-ah/edx: (addr handle cell) <- address key-storage
    1456   new-symbol key-ah, "a"
    1457   var env-storage: (handle cell)
    1458   var env-ah/ebx: (addr handle cell) <- address env-storage
    1459   new-pair env-ah, *key-ah, *val-ah
    1460   # env = ((a . 3))
    1461   var nil-storage: (handle cell)
    1462   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    1463   allocate-pair nil-ah
    1464   new-pair env-ah, *env-ah, *nil-ah
    1465   # eval sym(a), env
    1466   var tmp-storage: (handle cell)
    1467   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    1468   new-symbol tmp-ah, "a"
    1469   var trace-storage: trace
    1470   var trace/edi: (addr trace) <- address trace-storage
    1471   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
    1472   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
    1473   var result/eax: (addr cell) <- lookup *tmp-ah
    1474   var result-type/edx: (addr int) <- get result, type
    1475   check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0"
    1476   var result-value-addr/eax: (addr float) <- get result, number-data
    1477   var result-value/eax: int <- convert *result-value-addr
    1478   check-ints-equal result-value, 3, "F - test-evaluate-symbol/1"
    1479 }
    1480
    1481 fn test-evaluate-quote {
    1482   # env = nil
    1483   var nil-storage: (handle cell)
    1484   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    1485   allocate-pair nil-ah
    1486   # eval `a, env
    1487   var tmp-storage: (handle cell)
    1488   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    1489   new-symbol tmp-ah, "'"
    1490   var tmp2-storage: (handle cell)
    1491   var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage
    1492   new-symbol tmp2-ah, "a"
    1493   new-pair tmp-ah, *tmp-ah, *tmp2-ah
    1494   var trace-storage: trace
    1495   var trace/edi: (addr trace) <- address trace-storage
    1496   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
    1497   evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
    1498   var result/eax: (addr cell) <- lookup *tmp-ah
    1499   var result-type/edx: (addr int) <- get result, type
    1500   check-ints-equal *result-type, 2/symbol, "F - test-evaluate-quote/0"
    1501   var sym?/eax: boolean <- symbol-equal? result, "a"
    1502   check sym?, "F - test-evaluate-quote/1"
    1503 }
    1504
    1505 fn test-evaluate-primitive-function {
    1506   var globals-storage: global-table
    1507   var globals/edi: (addr global-table) <- address globals-storage
    1508   initialize-globals globals
    1509   var nil-storage: (handle cell)
    1510   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    1511   allocate-pair nil-ah
    1512   var add-storage: (handle cell)
    1513   var add-ah/ebx: (addr handle cell) <- address add-storage
    1514   new-symbol add-ah, "+"
    1515   # eval +, nil env
    1516   var tmp-storage: (handle cell)
    1517   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
    1518   var trace-storage: trace
    1519   var trace/edx: (addr trace) <- address trace-storage
    1520   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
    1521   evaluate add-ah, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
    1522   #
    1523   var result/eax: (addr cell) <- lookup *tmp-ah
    1524   var result-type/edx: (addr int) <- get result, type
    1525   check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0"
    1526   var result-value/eax: (addr int) <- get result, index-data
    1527   check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1"
    1528 }
    1529
    1530 fn test-evaluate-primitive-function-call {
    1531   var t-storage: trace
    1532   var t/edi: (addr trace) <- address t-storage
    1533   initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible  # we don't use trace UI
    1534   #
    1535   var nil-storage: (handle cell)
    1536   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    1537   allocate-pair nil-ah
    1538   var one-storage: (handle cell)
    1539   var one-ah/edx: (addr handle cell) <- address one-storage
    1540   new-integer one-ah, 1
    1541   var add-storage: (handle cell)
    1542   var add-ah/ebx: (addr handle cell) <- address add-storage
    1543   new-symbol add-ah, "+"
    1544   # input is (+ 1 1)
    1545   var tmp-storage: (handle cell)
    1546   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
    1547   new-pair tmp-ah, *one-ah, *nil-ah
    1548   new-pair tmp-ah, *one-ah, *tmp-ah
    1549   new-pair tmp-ah, *add-ah, *tmp-ah
    1550 #?   dump-cell tmp-ah
    1551   #
    1552   var globals-storage: global-table
    1553   var globals/edx: (addr global-table) <- address globals-storage
    1554   initialize-globals globals
    1555   #
    1556   evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/call-number
    1557 #?   dump-trace t
    1558   #
    1559   var result/eax: (addr cell) <- lookup *tmp-ah
    1560   var result-type/edx: (addr int) <- get result, type
    1561   check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0"
    1562   var result-value-addr/eax: (addr float) <- get result, number-data
    1563   var result-value/eax: int <- convert *result-value-addr
    1564   check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1"
    1565 }
    1566
    1567 fn test-evaluate-backquote {
    1568   # env = nil
    1569   var nil-storage: (handle cell)
    1570   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    1571   allocate-pair nil-ah
    1572   # eval `a, env
    1573   var tmp-storage: (handle cell)
    1574   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
    1575   new-symbol tmp-ah, "`"
    1576   var tmp2-storage: (handle cell)
    1577   var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage
    1578   new-symbol tmp2-ah, "a"
    1579   new-pair tmp-ah, *tmp-ah, *tmp2-ah
    1580   clear-object tmp2-ah
    1581   var trace-storage: trace
    1582   var trace/edi: (addr trace) <- address trace-storage
    1583   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
    1584   evaluate tmp-ah, tmp2-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
    1585   var result/eax: (addr cell) <- lookup *tmp2-ah
    1586   var result-type/edx: (addr int) <- get result, type
    1587   check-ints-equal *result-type, 2/symbol, "F - test-evaluate-backquote/0"
    1588   var sym?/eax: boolean <- symbol-equal? result, "a"
    1589   check sym?, "F - test-evaluate-backquote/1"
    1590 }
    1591
    1592 fn evaluate-backquote _in-ah: (addr handle cell), _out-ah: (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 {
    1593   # stack overflow?   # disable when enabling Really-debug-print
    1594 #?   dump-cell-from-cursor-over-full-screen _in-ah
    1595   check-stack
    1596   {
    1597     var screen-cell/eax: (addr handle cell) <- copy screen-cell
    1598     compare screen-cell, 0
    1599     break-if-=
    1600     var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell
    1601     compare screen-cell-addr, 0
    1602     break-if-=
    1603     # if screen-cell exists, we're probably not in a test
    1604     show-stack-state
    1605   }
    1606   # errors? skip
    1607   {
    1608     var error?/eax: boolean <- has-errors? trace
    1609     compare error?, 0/false
    1610     break-if-=
    1611     return
    1612   }
    1613   trace-lower trace
    1614   var in-ah/esi: (addr handle cell) <- copy _in-ah
    1615   var in/eax: (addr cell) <- lookup *in-ah
    1616   {
    1617     var nil?/eax: boolean <- nil? in
    1618     compare nil?, 0/false
    1619     break-if-=
    1620     # nil is a literal
    1621     trace-text trace, "eval", "backquote nil"
    1622     copy-object _in-ah, _out-ah
    1623     trace-higher trace
    1624     return
    1625   }
    1626   var in-type/ecx: (addr int) <- get in, type
    1627   compare *in-type, 0/pair
    1628   {
    1629     break-if-=
    1630     # copy non-pairs directly
    1631     # TODO: streams might need to be copied
    1632     trace-text trace, "eval", "backquote atom"
    1633     copy-object _in-ah, _out-ah
    1634     trace-higher trace
    1635     return
    1636   }
    1637   # 'in' is a pair
    1638   debug-print "()", 4/fg, 0/bg
    1639   var in-ah/esi: (addr handle cell) <- copy _in-ah
    1640   var _in/eax: (addr cell) <- lookup *in-ah
    1641   var in/ebx: (addr cell) <- copy _in
    1642   var in-left-ah/ecx: (addr handle cell) <- get in, left
    1643   debug-print "10", 4/fg, 0/bg
    1644   # check for unquote
    1645   $macroexpand-iter:unquote: {
    1646     var in-left/eax: (addr cell) <- lookup *in-left-ah
    1647     var unquote?/eax: boolean <- symbol-equal? in-left, ","
    1648     compare unquote?, 0/false
    1649     break-if-=
    1650     trace-text trace, "eval", "unquote"
    1651     var rest-ah/eax: (addr handle cell) <- get in, right
    1652     increment call-number
    1653     debug-print ",", 3/fg, 0/bg
    1654     evaluate rest-ah, _out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
    1655     debug-print ",)", 3/fg, 0/bg
    1656     trace-higher trace
    1657     return
    1658   }
    1659   # check for unquote-splice in in-left
    1660   debug-print "11", 4/fg, 0/bg
    1661   var out-ah/edi: (addr handle cell) <- copy _out-ah
    1662   $macroexpand-iter:unquote-splice: {
    1663 #?     dump-cell-from-cursor-over-full-screen in-left-ah
    1664     var in-left/eax: (addr cell) <- lookup *in-left-ah
    1665     {
    1666       debug-print "12", 4/fg, 0/bg
    1667       {
    1668         var in-left-is-nil?/eax: boolean <- nil? in-left
    1669         compare in-left-is-nil?, 0/false
    1670       }
    1671       break-if-!= $macroexpand-iter:unquote-splice
    1672       var in-left-type/ecx: (addr int) <- get in-left, type
    1673       debug-print "13", 4/fg, 0/bg
    1674       compare *in-left-type, 0/pair
    1675       break-if-!= $macroexpand-iter:unquote-splice
    1676       var in-left-left-ah/eax: (addr handle cell) <- get in-left, left
    1677       debug-print "14", 4/fg, 0/bg
    1678       var in-left-left/eax: (addr cell) <- lookup *in-left-left-ah
    1679       debug-print "15", 4/fg, 0/bg
    1680       var in-left-left-type/ecx: (addr int) <- get in-left-left, type
    1681       var left-is-unquote-splice?/eax: boolean <- symbol-equal? in-left-left, ",@"
    1682       debug-print "16", 4/fg, 0/bg
    1683       compare left-is-unquote-splice?, 0/false
    1684     }
    1685     break-if-=
    1686     debug-print "17", 4/fg, 0/bg
    1687     trace-text trace, "eval", "unquote-splice"
    1688     var in-unquote-payload-ah/eax: (addr handle cell) <- get in-left, right
    1689     increment call-number
    1690     evaluate in-unquote-payload-ah, out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
    1691     # errors? skip
    1692     {
    1693       var error?/eax: boolean <- has-errors? trace
    1694       compare error?, 0/false
    1695       break-if-=
    1696       trace-higher trace
    1697       return
    1698     }
    1699     # while (*out-ah != null) out-ah = cdr(out-ah)
    1700     {
    1701       var out/eax: (addr cell) <- lookup *out-ah
    1702       {
    1703         var done?/eax: boolean <- nil? out
    1704         compare done?, 0/false
    1705       }
    1706       break-if-!=
    1707       out-ah <- get out, right
    1708       loop
    1709     }
    1710     # append result of in-right
    1711     var in-right-ah/ecx: (addr handle cell) <- get in, right
    1712     evaluate-backquote in-right-ah, out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
    1713     trace-higher trace
    1714     return
    1715   }
    1716   debug-print "19", 4/fg, 0/bg
    1717   # otherwise continue copying
    1718   trace-text trace, "eval", "backquote: copy"
    1719   var out-ah/edi: (addr handle cell) <- copy _out-ah
    1720   allocate-pair out-ah
    1721   debug-print "20", 7/fg, 0/bg
    1722 #?   dump-cell-from-cursor-over-full-screen out-ah
    1723   var out/eax: (addr cell) <- lookup *out-ah
    1724   var out-left-ah/edx: (addr handle cell) <- get out, left
    1725   debug-print "`(l", 3/fg, 0/bg
    1726   evaluate-backquote in-left-ah, out-left-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
    1727   debug-print "`r)", 3/fg, 0/bg
    1728   # errors? skip
    1729   {
    1730     var error?/eax: boolean <- has-errors? trace
    1731     compare error?, 0/false
    1732     break-if-=
    1733     trace-higher trace
    1734     return
    1735   }
    1736   var in-right-ah/ecx: (addr handle cell) <- get in, right
    1737   var out-right-ah/edx: (addr handle cell) <- get out, right
    1738   debug-print "`r(", 3/fg, 0/bg
    1739   evaluate-backquote in-right-ah, out-right-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
    1740   debug-print "`r)", 3/fg, 0/bg
    1741   trace-higher trace
    1742 }
    1743
    1744 fn test-evaluate-backquote-list {
    1745   var nil-storage: (handle cell)
    1746   var nil-ah/ecx: (addr handle cell) <- address nil-storage
    1747   allocate-pair nil-ah
    1748   var backquote-storage: (handle cell)
    1749   var backquote-ah/edx: (addr handle cell) <- address backquote-storage
    1750   new-symbol backquote-ah, "`"
    1751   # input is `(a b)
    1752   var a-storage: (handle cell)
    1753   var a-ah/ebx: (addr handle cell) <- address a-storage
    1754   new-symbol a-ah, "a"
    1755   var b-storage: (handle cell)
    1756   var b-ah/esi: (addr handle cell) <- address b-storage
    1757   new-symbol b-ah, "b"
    1758   var tmp-storage: (handle cell)
    1759   var tmp-ah/eax: (addr handle cell) <- address tmp-storage
    1760   new-pair tmp-ah, *b-ah, *nil-ah
    1761   new-pair tmp-ah, *a-ah, *tmp-ah
    1762   new-pair tmp-ah, *backquote-ah, *tmp-ah
    1763   #
    1764   var trace-storage: trace
    1765   var trace/edi: (addr trace) <- address trace-storage
    1766   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
    1767   evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
    1768   # result is (a b)
    1769   var result/eax: (addr cell) <- lookup *tmp-ah
    1770   {
    1771     var result-type/eax: (addr int) <- get result, type
    1772     check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list/0"
    1773   }
    1774   {
    1775     var a1-ah/eax: (addr handle cell) <- get result, left
    1776     var a1/eax: (addr cell) <- lookup *a1-ah
    1777     var check1/eax: boolean <- symbol-equal? a1, "a"
    1778     check check1, "F - test-evaluate-backquote-list/1"
    1779   }
    1780   var rest-ah/eax: (addr handle cell) <- get result, right
    1781   var rest/eax: (addr cell) <- lookup *rest-ah
    1782   {
    1783     var a2-ah/eax: (addr handle cell) <- get rest, left
    1784     var a2/eax: (addr cell) <- lookup *a2-ah
    1785     var check2/eax: boolean <- symbol-equal? a2, "b"
    1786     check check2, "F - test-evaluate-backquote-list/2"
    1787   }
    1788   var rest-ah/eax: (addr handle cell) <- get rest, right
    1789   var rest/eax: (addr cell) <- lookup *rest-ah
    1790   var check3/eax: boolean <- nil? rest
    1791   check check3, "F - test-evaluate-backquote-list/3"
    1792 }
    1793
    1794 fn test-evaluate-backquote-list-with-unquote {
    1795   var nil-h: (handle cell)
    1796   var nil-ah/eax: (addr handle cell) <- address nil-h
    1797   allocate-pair nil-ah
    1798   var backquote-h: (handle cell)
    1799   var backquote-ah/eax: (addr handle cell) <- address backquote-h
    1800   new-symbol backquote-ah, "`"
    1801   var unquote-h: (handle cell)
    1802   var unquote-ah/eax: (addr handle cell) <- address unquote-h
    1803   new-symbol unquote-ah, ","
    1804   var a-h: (handle cell)
    1805   var a-ah/eax: (addr handle cell) <- address a-h
    1806   new-symbol a-ah, "a"
    1807   var b-h: (handle cell)
    1808   var b-ah/eax: (addr handle cell) <- address b-h
    1809   new-symbol b-ah, "b"
    1810   # env = ((b . 3))
    1811   var val-h: (handle cell)
    1812   var val-ah/eax: (addr handle cell) <- address val-h
    1813   new-integer val-ah, 3
    1814   var env-h: (handle cell)
    1815   var env-ah/eax: (addr handle cell) <- address env-h
    1816   new-pair env-ah, b-h, val-h
    1817   new-pair env-ah, env-h, nil-h
    1818   # input is `(a ,b)
    1819   var tmp-h: (handle cell)
    1820   var tmp-ah/eax: (addr handle cell) <- address tmp-h
    1821   # tmp = cons(unquote, b)
    1822   new-pair tmp-ah, unquote-h, b-h
    1823   # tmp = cons(tmp, nil)
    1824   new-pair tmp-ah, tmp-h, nil-h
    1825   # tmp = cons(a, tmp)
    1826   new-pair tmp-ah, a-h, tmp-h
    1827   # tmp = cons(backquote, tmp)
    1828   new-pair tmp-ah, backquote-h, tmp-h
    1829   #
    1830   var trace-storage: trace
    1831   var trace/edi: (addr trace) <- address trace-storage
    1832   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
    1833   evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
    1834   # result is (a 3)
    1835   var result/eax: (addr cell) <- lookup *tmp-ah
    1836   {
    1837     var result-type/eax: (addr int) <- get result, type
    1838     check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote/0"
    1839   }
    1840   {
    1841     var a1-ah/eax: (addr handle cell) <- get result, left
    1842     var a1/eax: (addr cell) <- lookup *a1-ah
    1843     var check1/eax: boolean <- symbol-equal? a1, "a"
    1844     check check1, "F - test-evaluate-backquote-list-with-unquote/1"
    1845   }
    1846   var rest-ah/eax: (addr handle cell) <- get result, right
    1847   var rest/eax: (addr cell) <- lookup *rest-ah
    1848   {
    1849     var a2-ah/eax: (addr handle cell) <- get rest, left
    1850     var a2/eax: (addr cell) <- lookup *a2-ah
    1851     var a2-value-addr/eax: (addr float) <- get a2, number-data
    1852     var a2-value/eax: int <- convert *a2-value-addr
    1853     check-ints-equal a2-value, 3, "F - test-evaluate-backquote-list-with-unquote/2"
    1854   }
    1855   var rest-ah/eax: (addr handle cell) <- get rest, right
    1856   var rest/eax: (addr cell) <- lookup *rest-ah
    1857   var check3/eax: boolean <- nil? rest
    1858   check check3, "F - test-evaluate-backquote-list-with-unquote/3"
    1859 }
    1860
    1861 fn test-evaluate-backquote-list-with-unquote-splice {
    1862   var nil-h: (handle cell)
    1863   var nil-ah/eax: (addr handle cell) <- address nil-h
    1864   allocate-pair nil-ah
    1865   var backquote-h: (handle cell)
    1866   var backquote-ah/eax: (addr handle cell) <- address backquote-h
    1867   new-symbol backquote-ah, "`"
    1868   var unquote-splice-h: (handle cell)
    1869   var unquote-splice-ah/eax: (addr handle cell) <- address unquote-splice-h
    1870   new-symbol unquote-splice-ah, ",@"
    1871   var a-h: (handle cell)
    1872   var a-ah/eax: (addr handle cell) <- address a-h
    1873   new-symbol a-ah, "a"
    1874   var b-h: (handle cell)
    1875   var b-ah/eax: (addr handle cell) <- address b-h
    1876   new-symbol b-ah, "b"
    1877   # env = ((b . (a 3)))
    1878   var val-h: (handle cell)
    1879   var val-ah/eax: (addr handle cell) <- address val-h
    1880   new-integer val-ah, 3
    1881   new-pair val-ah, val-h, nil-h
    1882   new-pair val-ah, a-h, val-h
    1883   var env-h: (handle cell)
    1884   var env-ah/eax: (addr handle cell) <- address env-h
    1885   new-pair env-ah, b-h, val-h
    1886   new-pair env-ah, env-h, nil-h
    1887   # input is `(a ,@b b)
    1888   var tmp-h: (handle cell)
    1889   var tmp-ah/eax: (addr handle cell) <- address tmp-h
    1890   # tmp = cons(b, nil)
    1891   new-pair tmp-ah, b-h, nil-h
    1892   # tmp2 = cons(unquote-splice, b)
    1893   var tmp2-h: (handle cell)
    1894   var tmp2-ah/ecx: (addr handle cell) <- address tmp2-h
    1895   new-pair tmp2-ah, unquote-splice-h, b-h
    1896   # tmp = cons(tmp2, tmp)
    1897   new-pair tmp-ah, tmp2-h, tmp-h
    1898   # tmp = cons(a, tmp)
    1899   new-pair tmp-ah, a-h, tmp-h
    1900   # tmp = cons(backquote, tmp)
    1901   new-pair tmp-ah, backquote-h, tmp-h
    1902 #?   dump-cell-from-cursor-over-full-screen tmp-ah
    1903   #
    1904   var trace-storage: trace
    1905   var trace/edi: (addr trace) <- address trace-storage
    1906   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
    1907   evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/call-number
    1908   # result is (a a 3 b)
    1909 #?   dump-cell-from-cursor-over-full-screen tmp-ah
    1910   var result/eax: (addr cell) <- lookup *tmp-ah
    1911   {
    1912     var result-type/eax: (addr int) <- get result, type
    1913     check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote-splice/0"
    1914   }
    1915   {
    1916     var a1-ah/eax: (addr handle cell) <- get result, left
    1917     var a1/eax: (addr cell) <- lookup *a1-ah
    1918     var check1/eax: boolean <- symbol-equal? a1, "a"
    1919     check check1, "F - test-evaluate-backquote-list-with-unquote-splice/1"
    1920   }
    1921   var rest-ah/eax: (addr handle cell) <- get result, right
    1922   var rest/eax: (addr cell) <- lookup *rest-ah
    1923   {
    1924     var a2-ah/eax: (addr handle cell) <- get rest, left
    1925     var a2/eax: (addr cell) <- lookup *a2-ah
    1926     var check2/eax: boolean <- symbol-equal? a2, "a"
    1927     check check2, "F - test-evaluate-backquote-list-with-unquote-splice/2"
    1928   }
    1929   var rest-ah/eax: (addr handle cell) <- get rest, right
    1930   var rest/eax: (addr cell) <- lookup *rest-ah
    1931   {
    1932     var a3-ah/eax: (addr handle cell) <- get rest, left
    1933     var a3/eax: (addr cell) <- lookup *a3-ah
    1934     var a3-value-addr/eax: (addr float) <- get a3, number-data
    1935     var a3-value/eax: int <- convert *a3-value-addr
    1936     check-ints-equal a3-value, 3, "F - test-evaluate-backquote-list-with-unquote-splice/3"
    1937   }
    1938   var rest-ah/eax: (addr handle cell) <- get rest, right
    1939   var rest/eax: (addr cell) <- lookup *rest-ah
    1940   {
    1941     var a4-ah/eax: (addr handle cell) <- get rest, left
    1942     var a4/eax: (addr cell) <- lookup *a4-ah
    1943     var check4/eax: boolean <- symbol-equal? a4, "b"
    1944     check check4, "F - test-evaluate-backquote-list-with-unquote-splice/4"
    1945   }
    1946   var rest-ah/eax: (addr handle cell) <- get rest, right
    1947   var rest/eax: (addr cell) <- lookup *rest-ah
    1948   var check5/eax: boolean <- nil? rest
    1949   check check5, "F - test-evaluate-backquote-list-with-unquote-splice/5"
    1950 }