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