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