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