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