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