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   $cell-isomorphic?:text-data: {
1281     {
1282       compare b-type, 2/symbol
1283       break-if-=
1284       compare b-type, 3/stream
1285       break-if-=
1286       break $cell-isomorphic?:text-data
1287     }
1288     var b-val-ah/eax: (addr handle stream byte) <- get b, text-data
1289     var _b-val/eax: (addr stream byte) <- lookup *b-val-ah
1290     var b-val/ecx: (addr stream byte) <- copy _b-val
1291     var a-val-ah/eax: (addr handle stream byte) <- get a, text-data
1292     var a-val/eax: (addr stream byte) <- lookup *a-val-ah
1293     var tmp-array: (handle array byte)
1294     var tmp-ah/edx: (addr handle array byte) <- address tmp-array
1295     rewind-stream a-val
1296     stream-to-array a-val, tmp-ah
1297     var tmp/eax: (addr array byte) <- lookup *tmp-ah
1298     var match?/eax: boolean <- stream-data-equal? b-val, tmp
1299     trace-higher trace
1300     {
1301       compare match?, 0/false
1302       break-if-=
1303       trace-text trace, "eval", "=> true (symbols)"
1304     }
1305     {
1306       compare match?, 0/false
1307       break-if-!=
1308       trace-text trace, "eval", "=> false (symbols)"
1309     }
1310     return match?
1311   }
1312   # if objects are primitive functions, compare index-data
1313   compare b-type, 4/primitive
1314   {
1315     break-if-!=
1316     var a-val-addr/eax: (addr int) <- get a, index-data
1317     var b-val-addr/ecx: (addr int) <- get b, index-data
1318     var a-val/eax: int <- copy *a-val-addr
1319     compare a-val, *b-val-addr
1320     {
1321       break-if-=
1322       trace-higher trace
1323       trace-text trace, "eval", "=> false (primitives)"
1324       return 0/false
1325     }
1326     trace-higher trace
1327     trace-text trace, "eval", "=> true (primitives)"
1328     return 1/true
1329   }
1330   # if objects are screens, check if they're the same object
1331   compare b-type, 5/screen
1332   {
1333     break-if-!=
1334     var a-val-addr/eax: (addr handle screen) <- get a, screen-data
1335     var b-val-addr/ecx: (addr handle screen) <- get b, screen-data
1336     var result/eax: boolean <- handle-equal? *a-val-addr, *b-val-addr
1337     compare result, 0/false
1338     return result
1339   }
1340   # if objects are keyboards, check if they have the same contents
1341   compare b-type, 6/keyboard
1342   {
1343     break-if-!=
1344     var a-val-addr/ecx: (addr handle gap-buffer) <- get a, keyboard-data
1345     var _a/eax: (addr gap-buffer) <- lookup *a-val-addr
1346     var a/ecx: (addr gap-buffer) <- copy _a
1347     var b-val-addr/eax: (addr handle gap-buffer) <- get b, keyboard-data
1348     var b/eax: (addr gap-buffer) <- lookup *b-val-addr
1349     var result/eax: boolean <- gap-buffers-equal? a, b
1350     return result
1351   }
1352   # if a is nil, b should be nil
1353   {
1354     # (assumes nil? returns 0 or 1)
1355     var _b-nil?/eax: boolean <- nil? b
1356     var b-nil?/ecx: boolean <- copy _b-nil?
1357     var a-nil?/eax: boolean <- nil? a
1358     # a == nil and b == nil => return true
1359     {
1360       compare a-nil?, 0/false
1361       break-if-=
1362       compare b-nil?, 0/false
1363       break-if-=
1364       trace-higher trace
1365       trace-text trace, "eval", "=> true (nils)"
1366       return 1/true
1367     }
1368     # a == nil => return false
1369     {
1370       compare a-nil?, 0/false
1371       break-if-=
1372       trace-higher trace
1373       trace-text trace, "eval", "=> false (b != nil)"
1374       return 0/false
1375     }
1376     # b == nil => return false
1377     {
1378       compare b-nil?, 0/false
1379       break-if-=
1380       trace-higher trace
1381       trace-text trace, "eval", "=> false (a != nil)"
1382       return 0/false
1383     }
1384   }
1385   # a and b are pairs
1386   var a-tmp-storage: (handle cell)
1387   var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage
1388   var b-tmp-storage: (handle cell)
1389   var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage
1390   # if cars aren't equal, return false
1391   car a, a-tmp-ah, trace
1392   car b, b-tmp-ah, trace
1393   {
1394     var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
1395     var a-tmp/ecx: (addr cell) <- copy _a-tmp
1396     var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
1397     var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
1398     compare result, 0/false
1399     break-if-!=
1400     trace-higher trace
1401     trace-text trace, "eval", "=> false (car mismatch)"
1402     return 0/false
1403   }
1404   # recurse on cdrs
1405   cdr a, a-tmp-ah, trace
1406   cdr b, b-tmp-ah, trace
1407   var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
1408   var a-tmp/ecx: (addr cell) <- copy _a-tmp
1409   var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
1410   var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
1411   trace-higher trace
1412   return result
1413 }
1414 
1415 fn fn? _x: (addr cell) -> _/eax: boolean {
1416   var x/esi: (addr cell) <- copy _x
1417   var type/eax: (addr int) <- get x, type
1418   compare *type, 2/symbol
1419   {
1420     break-if-=
1421     return 0/false
1422   }
1423   var contents-ah/eax: (addr handle stream byte) <- get x, text-data
1424   var contents/eax: (addr stream byte) <- lookup *contents-ah
1425   var result/eax: boolean <- stream-data-equal? contents, "fn"
1426   return result
1427 }
1428 
1429 fn litfn? _x: (addr cell) -> _/eax: boolean {
1430   var x/esi: (addr cell) <- copy _x
1431   var type/eax: (addr int) <- get x, type
1432   compare *type, 2/symbol
1433   {
1434     break-if-=
1435     return 0/false
1436   }
1437   var contents-ah/eax: (addr handle stream byte) <- get x, text-data
1438   var contents/eax: (addr stream byte) <- lookup *contents-ah
1439   var result/eax: boolean <- stream-data-equal? contents, "litfn"
1440   return result
1441 }
1442 
1443 fn litmac? _x: (addr cell) -> _/eax: boolean {
1444   var x/esi: (addr cell) <- copy _x
1445   var type/eax: (addr int) <- get x, type
1446   compare *type, 2/symbol
1447   {
1448     break-if-=
1449     return 0/false
1450   }
1451   var contents-ah/eax: (addr handle stream byte) <- get x, text-data
1452   var contents/eax: (addr stream byte) <- lookup *contents-ah
1453   var result/eax: boolean <- stream-data-equal? contents, "litmac"
1454   return result
1455 }
1456 
1457 fn test-evaluate-is-well-behaved {
1458   var t-storage: trace
1459   var t/esi: (addr trace) <- address t-storage
1460   initialize-trace t, 0x100/max-depth, 0x10/capacity, 0/visible  # we don't use trace UI
1461   # env = nil
1462   var env-storage: (handle cell)
1463   var env-ah/ecx: (addr handle cell) <- address env-storage
1464   allocate-pair env-ah
1465   # eval sym(a), nil 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   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
1470   # doesn't die
1471   check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved"
1472 }
1473 
1474 fn test-evaluate-number {
1475   # env = nil
1476   var env-storage: (handle cell)
1477   var env-ah/ecx: (addr handle cell) <- address env-storage
1478   allocate-pair env-ah
1479   # tmp = 3
1480   var tmp-storage: (handle cell)
1481   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
1482   new-integer tmp-ah, 3
1483   var trace-storage: trace
1484   var trace/edi: (addr trace) <- address trace-storage
1485   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
1486   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
1487   #
1488   var result/eax: (addr cell) <- lookup *tmp-ah
1489   var result-type/edx: (addr int) <- get result, type
1490   check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0"
1491   var result-value-addr/eax: (addr float) <- get result, number-data
1492   var result-value/eax: int <- convert *result-value-addr
1493   check-ints-equal result-value, 3, "F - test-evaluate-number/1"
1494 }
1495 
1496 fn test-evaluate-symbol {
1497   # tmp = (a . 3)
1498   var val-storage: (handle cell)
1499   var val-ah/ecx: (addr handle cell) <- address val-storage
1500   new-integer val-ah, 3
1501   var key-storage: (handle cell)
1502   var key-ah/edx: (addr handle cell) <- address key-storage
1503   new-symbol key-ah, "a"
1504   var env-storage: (handle cell)
1505   var env-ah/ebx: (addr handle cell) <- address env-storage
1506   new-pair env-ah, *key-ah, *val-ah
1507   # env = ((a . 3))
1508   var nil-storage: (handle cell)
1509   var nil-ah/ecx: (addr handle cell) <- address nil-storage
1510   allocate-pair nil-ah
1511   new-pair env-ah, *env-ah, *nil-ah
1512   # eval sym(a), env
1513   var tmp-storage: (handle cell)
1514   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
1515   new-symbol tmp-ah, "a"
1516   var trace-storage: trace
1517   var trace/edi: (addr trace) <- address trace-storage
1518   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
1519   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
1520   var result/eax: (addr cell) <- lookup *tmp-ah
1521   var result-type/edx: (addr int) <- get result, type
1522   check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0"
1523   var result-value-addr/eax: (addr float) <- get result, number-data
1524   var result-value/eax: int <- convert *result-value-addr
1525   check-ints-equal result-value, 3, "F - test-evaluate-symbol/1"
1526 }
1527 
1528 fn test-evaluate-quote {
1529   # env = nil
1530   var nil-storage: (handle cell)
1531   var nil-ah/ecx: (addr handle cell) <- address nil-storage
1532   allocate-pair nil-ah
1533   # eval `a, env
1534   var tmp-storage: (handle cell)
1535   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
1536   new-symbol tmp-ah, "'"
1537   var tmp2-storage: (handle cell)
1538   var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage
1539   new-symbol tmp2-ah, "a"
1540   new-pair tmp-ah, *tmp-ah, *tmp2-ah
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, *nil-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, 2/symbol, "F - test-evaluate-quote/0"
1548   var sym?/eax: boolean <- symbol-equal? result, "a"
1549   check sym?, "F - test-evaluate-quote/1"
1550 }
1551 
1552 fn test-evaluate-primitive-function {
1553   var globals-storage: global-table
1554   var globals/edi: (addr global-table) <- address globals-storage
1555   initialize-globals globals
1556   var nil-storage: (handle cell)
1557   var nil-ah/ecx: (addr handle cell) <- address nil-storage
1558   allocate-pair nil-ah
1559   var add-storage: (handle cell)
1560   var add-ah/ebx: (addr handle cell) <- address add-storage
1561   new-symbol add-ah, "+"
1562   # eval +, nil env
1563   var tmp-storage: (handle cell)
1564   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
1565   var trace-storage: trace
1566   var trace/edx: (addr trace) <- address trace-storage
1567   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
1568   evaluate add-ah, tmp-ah, *nil-ah, globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
1569   #
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, 4/primitive-function, "F - test-evaluate-primitive-function/0"
1573   var result-value/eax: (addr int) <- get result, index-data
1574   check-ints-equal *result-value, 1/add, "F - test-evaluate-primitive-function/1"
1575 }
1576 
1577 fn test-evaluate-primitive-function-call {
1578   var t-storage: trace
1579   var t/edi: (addr trace) <- address t-storage
1580   initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible  # we don't use trace UI
1581   #
1582   var nil-storage: (handle cell)
1583   var nil-ah/ecx: (addr handle cell) <- address nil-storage
1584   allocate-pair nil-ah
1585   var one-storage: (handle cell)
1586   var one-ah/edx: (addr handle cell) <- address one-storage
1587   new-integer one-ah, 1
1588   var add-storage: (handle cell)
1589   var add-ah/ebx: (addr handle cell) <- address add-storage
1590   new-symbol add-ah, "+"
1591   # input is (+ 1 1)
1592   var tmp-storage: (handle cell)
1593   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
1594   new-pair tmp-ah, *one-ah, *nil-ah
1595   new-pair tmp-ah, *one-ah, *tmp-ah
1596   new-pair tmp-ah, *add-ah, *tmp-ah
1597 #?   dump-cell tmp-ah
1598   #
1599   var globals-storage: global-table
1600   var globals/edx: (addr global-table) <- address globals-storage
1601   initialize-globals globals
1602   #
1603   evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
1604 #?   dump-trace t
1605   #
1606   var result/eax: (addr cell) <- lookup *tmp-ah
1607   var result-type/edx: (addr int) <- get result, type
1608   check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0"
1609   var result-value-addr/eax: (addr float) <- get result, number-data
1610   var result-value/eax: int <- convert *result-value-addr
1611   check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1"
1612 }
1613 
1614 fn test-evaluate-backquote {
1615   # env = nil
1616   var nil-storage: (handle cell)
1617   var nil-ah/ecx: (addr handle cell) <- address nil-storage
1618   allocate-pair nil-ah
1619   # eval `a, env
1620   var tmp-storage: (handle cell)
1621   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
1622   new-symbol tmp-ah, "`"
1623   var tmp2-storage: (handle cell)
1624   var tmp2-ah/ebx: (addr handle cell) <- address tmp2-storage
1625   new-symbol tmp2-ah, "a"
1626   new-pair tmp-ah, *tmp-ah, *tmp2-ah
1627   clear-object tmp2-ah
1628   var trace-storage: trace
1629   var trace/edi: (addr trace) <- address trace-storage
1630   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
1631   evaluate tmp-ah, tmp2-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
1632   var result/eax: (addr cell) <- lookup *tmp2-ah
1633   var result-type/edx: (addr int) <- get result, type
1634   check-ints-equal *result-type, 2/symbol, "F - test-evaluate-backquote/0"
1635   var sym?/eax: boolean <- symbol-equal? result, "a"
1636   check sym?, "F - test-evaluate-backquote/1"
1637 }
1638 
1639 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) {
1640   # stack overflow?   # disable when enabling Really-debug-print
1641 #?   dump-cell-from-cursor-over-full-screen _in-ah
1642   check-stack
1643   {
1644     var inner-screen-var/eax: (addr handle cell) <- copy inner-screen-var
1645     compare inner-screen-var, 0
1646     break-if-=
1647     var inner-screen-var-addr/eax: (addr cell) <- lookup *inner-screen-var
1648     compare inner-screen-var-addr, 0
1649     break-if-=
1650     # if inner-screen-var exists, we're probably not in a test
1651     show-stack-state
1652   }
1653   # errors? skip
1654   {
1655     var error?/eax: boolean <- has-errors? trace
1656     compare error?, 0/false
1657     break-if-=
1658     return
1659   }
1660   trace-lower trace
1661   var in-ah/esi: (addr handle cell) <- copy _in-ah
1662   var in/eax: (addr cell) <- lookup *in-ah
1663   {
1664     var nil?/eax: boolean <- nil? in
1665     compare nil?, 0/false
1666     break-if-=
1667     # nil is a literal
1668     trace-text trace, "eval", "backquote nil"
1669     copy-object _in-ah, _out-ah
1670     trace-higher trace
1671     return
1672   }
1673   var in-type/ecx: (addr int) <- get in, type
1674   compare *in-type, 0/pair
1675   {
1676     break-if-=
1677     # copy non-pairs directly
1678     # TODO: streams might need to be copied
1679     trace-text trace, "eval", "backquote atom"
1680     copy-object _in-ah, _out-ah
1681     trace-higher trace
1682     return
1683   }
1684   # 'in' is a pair
1685   debug-print "()", 4/fg, 0/bg
1686   var in-ah/esi: (addr handle cell) <- copy _in-ah
1687   var _in/eax: (addr cell) <- lookup *in-ah
1688   var in/ebx: (addr cell) <- copy _in
1689   var in-left-ah/ecx: (addr handle cell) <- get in, left
1690   debug-print "10", 4/fg, 0/bg
1691   # check for unquote
1692   $evaluate-backquote:unquote: {
1693     var in-left/eax: (addr cell) <- lookup *in-left-ah
1694     var unquote?/eax: boolean <- symbol-equal? in-left, ","
1695     compare unquote?, 0/false
1696     break-if-=
1697     trace-text trace, "eval", "unquote"
1698     var rest-ah/eax: (addr handle cell) <- get in, right
1699     debug-print ",", 3/fg, 0/bg
1700     evaluate rest-ah, _out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number
1701     debug-print ",)", 3/fg, 0/bg
1702     trace-higher trace
1703     return
1704   }
1705   # check for unquote-splice in in-left
1706   debug-print "11", 4/fg, 0/bg
1707   var out-ah/edi: (addr handle cell) <- copy _out-ah
1708   $evaluate-backquote:unquote-splice: {
1709 #?     dump-cell-from-cursor-over-full-screen in-left-ah
1710     var in-left/eax: (addr cell) <- lookup *in-left-ah
1711     {
1712       debug-print "12", 4/fg, 0/bg
1713       {
1714         var in-left-is-nil?/eax: boolean <- nil? in-left
1715         compare in-left-is-nil?, 0/false
1716       }
1717       break-if-!= $evaluate-backquote:unquote-splice
1718       var in-left-type/ecx: (addr int) <- get in-left, type
1719       debug-print "13", 4/fg, 0/bg
1720       compare *in-left-type, 0/pair
1721       break-if-!= $evaluate-backquote:unquote-splice
1722       var in-left-left-ah/eax: (addr handle cell) <- get in-left, left
1723       debug-print "14", 4/fg, 0/bg
1724       var in-left-left/eax: (addr cell) <- lookup *in-left-left-ah
1725       debug-print "15", 4/fg, 0/bg
1726       var in-left-left-type/ecx: (addr int) <- get in-left-left, type
1727       var left-is-unquote-splice?/eax: boolean <- symbol-equal? in-left-left, ",@"
1728       debug-print "16", 4/fg, 0/bg
1729       compare left-is-unquote-splice?, 0/false
1730     }
1731     break-if-=
1732     debug-print "17", 4/fg, 0/bg
1733     trace-text trace, "eval", "unquote-splice"
1734     var in-unquote-payload-ah/eax: (addr handle cell) <- get in-left, right
1735     evaluate in-unquote-payload-ah, out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number
1736     # errors? skip
1737     {
1738       var error?/eax: boolean <- has-errors? trace
1739       compare error?, 0/false
1740       break-if-=
1741       trace-higher trace
1742       return
1743     }
1744     # while (*out-ah != null) out-ah = cdr(out-ah)
1745     {
1746       var out/eax: (addr cell) <- lookup *out-ah
1747       {
1748         var done?/eax: boolean <- nil? out
1749         compare done?, 0/false
1750       }
1751       break-if-!=
1752       out-ah <- get out, right
1753       loop
1754     }
1755     # append result of in-right
1756     var in-right-ah/ecx: (addr handle cell) <- get in, right
1757     evaluate-backquote in-right-ah, out-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number
1758     trace-higher trace
1759     return
1760   }
1761   debug-print "19", 4/fg, 0/bg
1762   # otherwise continue copying
1763   trace-text trace, "eval", "backquote: copy"
1764   var out-ah/edi: (addr handle cell) <- copy _out-ah
1765   allocate-pair out-ah
1766   debug-print "20", 7/fg, 0/bg
1767 #?   dump-cell-from-cursor-over-full-screen out-ah
1768   var out/eax: (addr cell) <- lookup *out-ah
1769   var out-left-ah/edx: (addr handle cell) <- get out, left
1770   debug-print "`(l", 3/fg, 0/bg
1771   evaluate-backquote in-left-ah, out-left-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number
1772   debug-print "`r)", 3/fg, 0/bg
1773   # errors? skip
1774   {
1775     var error?/eax: boolean <- has-errors? trace
1776     compare error?, 0/false
1777     break-if-=
1778     trace-higher trace
1779     return
1780   }
1781   var in-right-ah/ecx: (addr handle cell) <- get in, right
1782   var out-right-ah/edx: (addr handle cell) <- get out, right
1783   debug-print "`r(", 3/fg, 0/bg
1784   evaluate-backquote in-right-ah, out-right-ah, env-h, globals, trace, inner-screen-var, inner-keyboard-var, definitions-created, call-number
1785   debug-print "`r)", 3/fg, 0/bg
1786   trace-higher trace
1787 }
1788 
1789 fn test-evaluate-backquote-list {
1790   var nil-storage: (handle cell)
1791   var nil-ah/ecx: (addr handle cell) <- address nil-storage
1792   allocate-pair nil-ah
1793   var backquote-storage: (handle cell)
1794   var backquote-ah/edx: (addr handle cell) <- address backquote-storage
1795   new-symbol backquote-ah, "`"
1796   # input is `(a b)
1797   var a-storage: (handle cell)
1798   var a-ah/ebx: (addr handle cell) <- address a-storage
1799   new-symbol a-ah, "a"
1800   var b-storage: (handle cell)
1801   var b-ah/esi: (addr handle cell) <- address b-storage
1802   new-symbol b-ah, "b"
1803   var tmp-storage: (handle cell)
1804   var tmp-ah/eax: (addr handle cell) <- address tmp-storage
1805   new-pair tmp-ah, *b-ah, *nil-ah
1806   new-pair tmp-ah, *a-ah, *tmp-ah
1807   new-pair tmp-ah, *backquote-ah, *tmp-ah
1808   #
1809   var trace-storage: trace
1810   var trace/edi: (addr trace) <- address trace-storage
1811   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
1812   evaluate tmp-ah, tmp-ah, *nil-ah, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
1813   # result is (a b)
1814   var result/eax: (addr cell) <- lookup *tmp-ah
1815   {
1816     var result-type/eax: (addr int) <- get result, type
1817     check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list/0"
1818   }
1819   {
1820     var a1-ah/eax: (addr handle cell) <- get result, left
1821     var a1/eax: (addr cell) <- lookup *a1-ah
1822     var check1/eax: boolean <- symbol-equal? a1, "a"
1823     check check1, "F - test-evaluate-backquote-list/1"
1824   }
1825   var rest-ah/eax: (addr handle cell) <- get result, right
1826   var rest/eax: (addr cell) <- lookup *rest-ah
1827   {
1828     var a2-ah/eax: (addr handle cell) <- get rest, left
1829     var a2/eax: (addr cell) <- lookup *a2-ah
1830     var check2/eax: boolean <- symbol-equal? a2, "b"
1831     check check2, "F - test-evaluate-backquote-list/2"
1832   }
1833   var rest-ah/eax: (addr handle cell) <- get rest, right
1834   var rest/eax: (addr cell) <- lookup *rest-ah
1835   var check3/eax: boolean <- nil? rest
1836   check check3, "F - test-evaluate-backquote-list/3"
1837 }
1838 
1839 fn test-evaluate-backquote-list-with-unquote {
1840   var nil-h: (handle cell)
1841   var nil-ah/eax: (addr handle cell) <- address nil-h
1842   allocate-pair nil-ah
1843   var backquote-h: (handle cell)
1844   var backquote-ah/eax: (addr handle cell) <- address backquote-h
1845   new-symbol backquote-ah, "`"
1846   var unquote-h: (handle cell)
1847   var unquote-ah/eax: (addr handle cell) <- address unquote-h
1848   new-symbol unquote-ah, ","
1849   var a-h: (handle cell)
1850   var a-ah/eax: (addr handle cell) <- address a-h
1851   new-symbol a-ah, "a"
1852   var b-h: (handle cell)
1853   var b-ah/eax: (addr handle cell) <- address b-h
1854   new-symbol b-ah, "b"
1855   # env = ((b . 3))
1856   var val-h: (handle cell)
1857   var val-ah/eax: (addr handle cell) <- address val-h
1858   new-integer val-ah, 3
1859   var env-h: (handle cell)
1860   var env-ah/eax: (addr handle cell) <- address env-h
1861   new-pair env-ah, b-h, val-h
1862   new-pair env-ah, env-h, nil-h
1863   # input is `(a ,b)
1864   var tmp-h: (handle cell)
1865   var tmp-ah/eax: (addr handle cell) <- address tmp-h
1866   # tmp = cons(unquote, b)
1867   new-pair tmp-ah, unquote-h, b-h
1868   # tmp = cons(tmp, nil)
1869   new-pair tmp-ah, tmp-h, nil-h
1870   # tmp = cons(a, tmp)
1871   new-pair tmp-ah, a-h, tmp-h
1872   # tmp = cons(backquote, tmp)
1873   new-pair tmp-ah, backquote-h, tmp-h
1874   #
1875   var trace-storage: trace
1876   var trace/edi: (addr trace) <- address trace-storage
1877   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
1878   evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
1879   # result is (a 3)
1880   var result/eax: (addr cell) <- lookup *tmp-ah
1881   {
1882     var result-type/eax: (addr int) <- get result, type
1883     check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote/0"
1884   }
1885   {
1886     var a1-ah/eax: (addr handle cell) <- get result, left
1887     var a1/eax: (addr cell) <- lookup *a1-ah
1888     var check1/eax: boolean <- symbol-equal? a1, "a"
1889     check check1, "F - test-evaluate-backquote-list-with-unquote/1"
1890   }
1891   var rest-ah/eax: (addr handle cell) <- get result, right
1892   var rest/eax: (addr cell) <- lookup *rest-ah
1893   {
1894     var a2-ah/eax: (addr handle cell) <- get rest, left
1895     var a2/eax: (addr cell) <- lookup *a2-ah
1896     var a2-value-addr/eax: (addr float) <- get a2, number-data
1897     var a2-value/eax: int <- convert *a2-value-addr
1898     check-ints-equal a2-value, 3, "F - test-evaluate-backquote-list-with-unquote/2"
1899   }
1900   var rest-ah/eax: (addr handle cell) <- get rest, right
1901   var rest/eax: (addr cell) <- lookup *rest-ah
1902   var check3/eax: boolean <- nil? rest
1903   check check3, "F - test-evaluate-backquote-list-with-unquote/3"
1904 }
1905 
1906 fn test-evaluate-backquote-list-with-unquote-splice {
1907   var nil-h: (handle cell)
1908   var nil-ah/eax: (addr handle cell) <- address nil-h
1909   allocate-pair nil-ah
1910   var backquote-h: (handle cell)
1911   var backquote-ah/eax: (addr handle cell) <- address backquote-h
1912   new-symbol backquote-ah, "`"
1913   var unquote-splice-h: (handle cell)
1914   var unquote-splice-ah/eax: (addr handle cell) <- address unquote-splice-h
1915   new-symbol unquote-splice-ah, ",@"
1916   var a-h: (handle cell)
1917   var a-ah/eax: (addr handle cell) <- address a-h
1918   new-symbol a-ah, "a"
1919   var b-h: (handle cell)
1920   var b-ah/eax: (addr handle cell) <- address b-h
1921   new-symbol b-ah, "b"
1922   # env = ((b . (a 3)))
1923   var val-h: (handle cell)
1924   var val-ah/eax: (addr handle cell) <- address val-h
1925   new-integer val-ah, 3
1926   new-pair val-ah, val-h, nil-h
1927   new-pair val-ah, a-h, val-h
1928   var env-h: (handle cell)
1929   var env-ah/eax: (addr handle cell) <- address env-h
1930   new-pair env-ah, b-h, val-h
1931   new-pair env-ah, env-h, nil-h
1932   # input is `(a ,@b b)
1933   var tmp-h: (handle cell)
1934   var tmp-ah/eax: (addr handle cell) <- address tmp-h
1935   # tmp = cons(b, nil)
1936   new-pair tmp-ah, b-h, nil-h
1937   # tmp2 = cons(unquote-splice, b)
1938   var tmp2-h: (handle cell)
1939   var tmp2-ah/ecx: (addr handle cell) <- address tmp2-h
1940   new-pair tmp2-ah, unquote-splice-h, b-h
1941   # tmp = cons(tmp2, tmp)
1942   new-pair tmp-ah, tmp2-h, tmp-h
1943   # tmp = cons(a, tmp)
1944   new-pair tmp-ah, a-h, tmp-h
1945   # tmp = cons(backquote, tmp)
1946   new-pair tmp-ah, backquote-h, tmp-h
1947 #?   dump-cell-from-cursor-over-full-screen tmp-ah
1948   #
1949   var trace-storage: trace
1950   var trace/edi: (addr trace) <- address trace-storage
1951   initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
1952   evaluate tmp-ah, tmp-ah, env-h, 0/no-globals, trace, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
1953   # result is (a a 3 b)
1954 #?   dump-cell-from-cursor-over-full-screen tmp-ah
1955   var result/eax: (addr cell) <- lookup *tmp-ah
1956   {
1957     var result-type/eax: (addr int) <- get result, type
1958     check-ints-equal *result-type, 0/pair, "F - test-evaluate-backquote-list-with-unquote-splice/0"
1959   }
1960   {
1961     var a1-ah/eax: (addr handle cell) <- get result, left
1962     var a1/eax: (addr cell) <- lookup *a1-ah
1963     var check1/eax: boolean <- symbol-equal? a1, "a"
1964     check check1, "F - test-evaluate-backquote-list-with-unquote-splice/1"
1965   }
1966   var rest-ah/eax: (addr handle cell) <- get result, right
1967   var rest/eax: (addr cell) <- lookup *rest-ah
1968   {
1969     var a2-ah/eax: (addr handle cell) <- get rest, left
1970     var a2/eax: (addr cell) <- lookup *a2-ah
1971     var check2/eax: boolean <- symbol-equal? a2, "a"
1972     check check2, "F - test-evaluate-backquote-list-with-unquote-splice/2"
1973   }
1974   var rest-ah/eax: (addr handle cell) <- get rest, right
1975   var rest/eax: (addr cell) <- lookup *rest-ah
1976   {
1977     var a3-ah/eax: (addr handle cell) <- get rest, left
1978     var a3/eax: (addr cell) <- lookup *a3-ah
1979     var a3-value-addr/eax: (addr float) <- get a3, number-data
1980     var a3-value/eax: int <- convert *a3-value-addr
1981     check-ints-equal a3-value, 3, "F - test-evaluate-backquote-list-with-unquote-splice/3"
1982   }
1983   var rest-ah/eax: (addr handle cell) <- get rest, right
1984   var rest/eax: (addr cell) <- lookup *rest-ah
1985   {
1986     var a4-ah/eax: (addr handle cell) <- get rest, left
1987     var a4/eax: (addr cell) <- lookup *a4-ah
1988     var check4/eax: boolean <- symbol-equal? a4, "b"
1989     check check4, "F - test-evaluate-backquote-list-with-unquote-splice/4"
1990   }
1991   var rest-ah/eax: (addr handle cell) <- get rest, right
1992   var rest/eax: (addr cell) <- lookup *rest-ah
1993   var check5/eax: boolean <- nil? rest
1994   check check5, "F - test-evaluate-backquote-list-with-unquote-splice/5"
1995 }