1 # env is an alist of ((sym . val) (sym . val) ...)
   2 # we never modify `in` or `env`
   3 # ignore 'screen-cell' on a first reading; it's a hack for sandboxes
   4 # 'call-number' is just for showing intermediate progress; this is a _slow_ interpreter
   5 fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int {
   6   # stack overflow?   # disable when enabling Really-debug-print
   7   check-stack
   8   show-stack-state
   9   # errors? skip
  10   {
  11     compare trace, 0
  12     break-if-=
  13     var error?/eax: boolean <- has-errors? trace
  14     compare error?, 0/false
  15     break-if-=
  16     return
  17   }
  18   var in/esi: (addr handle cell) <- copy _in
  19   # show intermediate progress on screen if necessary
  20   {
  21     compare screen-cell, 0
  22     break-if-=
  23     var tmp/eax: int <- copy call-number
  24     tmp <- and 0xf  # every 16 calls to evaluate
  25     compare tmp, 0
  26     break-if-!=
  27     var screen-cell/eax: (addr handle cell) <- copy screen-cell
  28     var screen-cell-addr/eax: (addr cell) <- lookup *screen-cell
  29     compare screen-cell-addr, 0
  30     break-if-=
  31     var screen-obj-ah/eax: (addr handle screen) <- get screen-cell-addr, screen-data
  32     var screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
  33     compare screen-obj, 0
  34     break-if-=
  35     var y/ecx: int <- render-screen 0/screen, screen-obj, 0x70/xmin, 2/ymin
  36   }
  37 #?   dump-cell in
  38 #?   {
  39 #?     var foo/eax: byte <- read-key 0/keyboard
  40 #?     compare foo, 0
  41 #?     loop-if-=
  42 #?   }
  43 +-- 14 lines: # trace "evaluate " in " in environment " env -----------------------------------------------------------------------------------------------------------------------------
  57   trace-lower trace
  58   var in-addr/eax: (addr cell) <- lookup *in
  59   {
  60     var nil?/eax: boolean <- nil? in-addr
  61     compare nil?, 0/false
  62     break-if-=
  63     # nil is a literal
  64     trace-text trace, "eval", "nil"
  65     copy-object _in, out
  66     trace-higher trace
  67     return
  68   }
  69   var in-type/ecx: (addr int) <- get in-addr, type
  70   compare *in-type, 1/number
  71   {
  72     break-if-!=
  73     # numbers are literals
  74     trace-text trace, "eval", "number"
  75     copy-object _in, out
  76     trace-higher trace
  77     return
  78   }
  79   compare *in-type, 2/symbol
  80   {
  81     break-if-!=
  82     trace-text trace, "eval", "symbol"
  83     debug-print "a", 7/fg, 0/bg
  84     lookup-symbol in-addr, out, env-h, globals, trace, screen-cell, keyboard-cell
  85     debug-print "z", 7/fg, 0/bg
  86     trace-higher trace
  87     return
  88   }
  89   compare *in-type, 5/screen
  90   {
  91     break-if-!=
  92     trace-text trace, "eval", "screen"
  93     copy-object _in, out
  94     trace-higher trace
  95     return
  96   }
  97   compare *in-type, 6/keyboard
  98   {
  99     break-if-!=
 100     trace-text trace, "eval", "keyboard"
 101     copy-object _in, out
 102     trace-higher trace
 103     return
 104   }
 105   # in-addr is a syntax tree
 106   $evaluate:anonymous-function: {
 107     # trees starting with "fn" are anonymous functions
 108     var expr/esi: (addr cell) <- copy in-addr
 109     # if its first elem is not "fn", break
 110     var in-addr/edx: (addr cell) <- copy in-addr
 111     var first-ah/ecx: (addr handle cell) <- get in-addr, left
 112     var first/eax: (addr cell) <- lookup *first-ah
 113     var fn?/eax: boolean <- fn? first
 114     compare fn?, 0/false
 115     break-if-=
 116     # turn (fn ...) into (fn env ...)
 117     trace-text trace, "eval", "anonymous function"
 118     var rest-ah/eax: (addr handle cell) <- get in-addr, right
 119     var tmp: (handle cell)
 120     var tmp-ah/edi: (addr handle cell) <- address tmp
 121     new-pair tmp-ah, env-h, *rest-ah
 122     new-pair out, *first-ah, *tmp-ah
 123     trace-higher trace
 124     return
 125   }
 126   # builtins with "special" evaluation rules
 127   $evaluate:quote: {
 128     # trees starting with single quote create literals
 129     var expr/esi: (addr cell) <- copy in-addr
 130     # if its first elem is not "'", break
 131     var first-ah/ecx: (addr handle cell) <- get in-addr, left
 132     var rest-ah/edx: (addr handle cell) <- get in-addr, right
 133     var first/eax: (addr cell) <- lookup *first-ah
 134     var first-type/ecx: (addr int) <- get first, type
 135     compare *first-type, 2/symbol
 136     break-if-!=
 137     var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
 138     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
 139     var quote?/eax: boolean <- stream-data-equal? sym-data, "'"
 140     compare quote?, 0/false
 141     break-if-=
 142     #
 143     trace-text trace, "eval", "quote"
 144     copy-object rest-ah, out
 145     trace-higher trace
 146     return
 147   }
 148   $evaluate:def: {
 149     # trees starting with "def" define globals
 150     var expr/esi: (addr cell) <- copy in-addr
 151     # if its first elem is not "def", break
 152     var first-ah/ecx: (addr handle cell) <- get in-addr, left
 153     var rest-ah/edx: (addr handle cell) <- get in-addr, right
 154     var first/eax: (addr cell) <- lookup *first-ah
 155     var first-type/ecx: (addr int) <- get first, type
 156     compare *first-type, 2/symbol
 157     break-if-!=
 158     var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
 159     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
 160     var def?/eax: boolean <- stream-data-equal? sym-data, "def"
 161     compare def?, 0/false
 162     break-if-=
 163     #
 164     trace-text trace, "eval", "def"
 165     trace-text trace, "eval", "evaluating second arg"
 166     var rest/eax: (addr cell) <- lookup *rest-ah
 167     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
 168     {
 169       var first-arg/eax: (addr cell) <- lookup *first-arg-ah
 170       var first-arg-type/eax: (addr int) <- get first-arg, type
 171       compare *first-arg-type, 2/symbol
 172       break-if-=
 173       error trace, "first arg to def must be a symbol"
 174       trace-higher trace
 175       return
 176     }
 177     rest-ah <- get rest, right
 178     rest <- lookup *rest-ah
 179     var second-arg-ah/edx: (addr handle cell) <- get rest, left
 180     debug-print "P", 4/fg, 0/bg
 181     increment call-number
 182     evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
 183     debug-print "Q", 4/fg, 0/bg
 184     trace-text trace, "eval", "saving global binding"
 185     var first-arg/eax: (addr cell) <- lookup *first-arg-ah
 186     var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data
 187     var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah
 188     var tmp-string: (handle array byte)
 189     var tmp-ah/edx: (addr handle array byte) <- address tmp-string
 190     rewind-stream first-arg-data
 191     stream-to-array first-arg-data, tmp-ah
 192     var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah
 193     var out2/edi: (addr handle cell) <- copy out
 194     append-global globals, first-arg-data-string, *out2, trace
 195     trace-higher trace
 196     return
 197   }
 198   $evaluate:set: {
 199     # trees starting with "set" mutate bindings
 200     var expr/esi: (addr cell) <- copy in-addr
 201     # if its first elem is not "set", break
 202     var first-ah/ecx: (addr handle cell) <- get in-addr, left
 203     var rest-ah/edx: (addr handle cell) <- get in-addr, right
 204     var first/eax: (addr cell) <- lookup *first-ah
 205     var first-type/ecx: (addr int) <- get first, type
 206     compare *first-type, 2/symbol
 207     break-if-!=
 208     var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
 209     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
 210     var set?/eax: boolean <- stream-data-equal? sym-data, "set"
 211     compare set?, 0/false
 212     break-if-=
 213     #
 214     trace-text trace, "eval", "set"
 215     trace-text trace, "eval", "evaluating second arg"
 216     var rest/eax: (addr cell) <- lookup *rest-ah
 217     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
 218     {
 219       var first-arg/eax: (addr cell) <- lookup *first-arg-ah
 220       var first-arg-type/eax: (addr int) <- get first-arg, type
 221       compare *first-arg-type, 2/symbol
 222       break-if-=
 223       error trace, "first arg to set must be a symbol"
 224       trace-higher trace
 225       return
 226     }
 227     rest-ah <- get rest, right
 228     rest <- lookup *rest-ah
 229     var second-arg-ah/edx: (addr handle cell) <- get rest, left
 230     debug-print "P", 4/fg, 0/bg
 231     increment call-number
 232     evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
 233     debug-print "Q", 4/fg, 0/bg
 234     trace-text trace, "eval", "mutating binding"
 235     var first-arg/eax: (addr cell) <- lookup *first-arg-ah
 236     var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data
 237     var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah
 238     mutate-binding first-arg-data, out, env-h, globals, trace
 239     trace-higher trace
 240     return
 241   }
 242   $evaluate:if: {
 243     # trees starting with "if" are conditionals
 244     var expr/esi: (addr cell) <- copy in-addr
 245     # if its first elem is not "if", break
 246     var first-ah/ecx: (addr handle cell) <- get in-addr, left
 247     var rest-ah/edx: (addr handle cell) <- get in-addr, right
 248     var first/eax: (addr cell) <- lookup *first-ah
 249     var first-type/ecx: (addr int) <- get first, type
 250     compare *first-type, 2/symbol
 251     break-if-!=
 252     var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
 253     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
 254     var if?/eax: boolean <- stream-data-equal? sym-data, "if"
 255     compare if?, 0/false
 256     break-if-=
 257     #
 258     trace-text trace, "eval", "if"
 259     trace-text trace, "eval", "evaluating first arg"
 260     var rest/eax: (addr cell) <- lookup *rest-ah
 261     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
 262     var guard-h: (handle cell)
 263     var guard-ah/esi: (addr handle cell) <- address guard-h
 264     debug-print "R", 4/fg, 0/bg
 265     increment call-number
 266     evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
 267     debug-print "S", 4/fg, 0/bg
 268     rest-ah <- get rest, right
 269     rest <- lookup *rest-ah
 270     var branch-ah/edi: (addr handle cell) <- get rest, left
 271     var guard-a/eax: (addr cell) <- lookup *guard-ah
 272     var skip-to-third-arg?/eax: boolean <- nil? guard-a
 273     compare skip-to-third-arg?, 0/false
 274     {
 275       break-if-=
 276       trace-text trace, "eval", "skipping to third arg"
 277       var rest/eax: (addr cell) <- lookup *rest-ah
 278       rest-ah <- get rest, right
 279       rest <- lookup *rest-ah
 280       branch-ah <- get rest, left
 281     }
 282     debug-print "T", 4/fg, 0/bg
 283     increment call-number
 284     evaluate branch-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
 285     debug-print "U", 4/fg, 0/bg
 286     trace-higher trace
 287     return
 288   }
 289   $evaluate:while: {
 290     # trees starting with "while" are loops
 291     var expr/esi: (addr cell) <- copy in-addr
 292     # if its first elem is not "while", break
 293     var first-ah/ecx: (addr handle cell) <- get in-addr, left
 294     var rest-ah/edx: (addr handle cell) <- get in-addr, right
 295     var first/eax: (addr cell) <- lookup *first-ah
 296     var first-type/ecx: (addr int) <- get first, type
 297     compare *first-type, 2/symbol
 298     break-if-!=
 299     var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
 300     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
 301     var while?/eax: boolean <- stream-data-equal? sym-data, "while"
 302     compare while?, 0/false
 303     break-if-=
 304     #
 305     trace-text trace, "eval", "while"
 306     var rest/eax: (addr cell) <- lookup *rest-ah
 307     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
 308     rest-ah <- get rest, right
 309     var guard-h: (handle cell)
 310     var guard-ah/esi: (addr handle cell) <- address guard-h
 311     $evaluate:while:loop-execution: {
 312       {
 313         compare trace, 0
 314         break-if-=
 315         var error?/eax: boolean <- has-errors? trace
 316         compare error?, 0/false
 317         break-if-!= $evaluate:while:loop-execution
 318       }
 319       trace-text trace, "eval", "loop termination check"
 320       debug-print "V", 4/fg, 0/bg
 321       increment call-number
 322       evaluate first-arg-ah, guard-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
 323       debug-print "W", 4/fg, 0/bg
 324       var guard-a/eax: (addr cell) <- lookup *guard-ah
 325       var done?/eax: boolean <- nil? guard-a
 326       compare done?, 0/false
 327       break-if-!=
 328       evaluate-exprs rest-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
 329       loop
 330     }
 331     trace-text trace, "eval", "loop terminated"
 332     trace-higher trace
 333     return
 334   }
 335   trace-text trace, "eval", "function call"
 336   trace-text trace, "eval", "evaluating list elements"
 337   trace-lower trace
 338   var evaluated-list-storage: (handle cell)
 339   var evaluated-list-ah/esi: (addr handle cell) <- address evaluated-list-storage
 340   var curr-out-ah/edx: (addr handle cell) <- copy evaluated-list-ah
 341   var curr/ecx: (addr cell) <- copy in-addr
 342   $evaluate-list:loop: {
 343     allocate-pair curr-out-ah
 344     var nil?/eax: boolean <- nil? curr
 345     compare nil?, 0/false
 346     break-if-!=
 347     # eval left
 348     var curr-out/eax: (addr cell) <- lookup *curr-out-ah
 349     var left-out-ah/edi: (addr handle cell) <- get curr-out, left
 350     var left-ah/esi: (addr handle cell) <- get curr, left
 351     debug-print "A", 4/fg, 0/bg
 352     increment call-number
 353     evaluate left-ah, left-out-ah, env-h, globals, trace, screen-cell, keyboard-cell, call-number
 354     debug-print "B", 4/fg, 0/bg
 355     #
 356     curr-out-ah <- get curr-out, right
 357     var right-ah/eax: (addr handle cell) <- get curr, right
 358     var right/eax: (addr cell) <- lookup *right-ah
 359     curr <- copy right
 360     loop
 361   }
 362   trace-higher trace
 363   var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah
 364   var function-ah/ecx: (addr handle cell) <- get evaluated-list, left
 365   var args-ah/edx: (addr handle cell) <- get evaluated-list, right
 366   debug-print "C", 4/fg, 0/bg
 367   apply function-ah, args-ah, out, globals, trace, screen-cell, keyboard-cell, call-number
 368   debug-print "Y", 4/fg, 0/bg
 369   trace-higher trace
 370 +-- 11 lines: # trace "=> " out ---------------------------------------------------------------------------------------------------------------------------------------------------------
 381   debug-print "Z", 4/fg, 0/bg
 382 }
 383 
 384 fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int {
 385   var f-ah/eax: (addr handle cell) <- copy _f-ah
 386   var _f/eax: (addr cell) <- lookup *f-ah
 387   var f/esi: (addr cell) <- copy _f
 388   # call primitive functions
 389   {
 390     var f-type/eax: (addr int) <- get f, type
 391     compare *f-type, 4/primitive-function
 392     break-if-!=
 393     apply-primitive f, args-ah, out, globals, trace
 394     return
 395   }
 396   # if it's not a primitive function it must be an anonymous function
 397 +-- 14 lines: # trace "apply anonymous function " f " in environment " env --------------------------------------------------------------------------------------------------------------
 411   trace-lower trace
 412   {
 413     var f-type/ecx: (addr int) <- get f, type
 414     compare *f-type, 0/pair
 415     break-if-!=
 416     var first-ah/eax: (addr handle cell) <- get f, left
 417     var first/eax: (addr cell) <- lookup *first-ah
 418     var fn?/eax: boolean <- fn? first
 419     compare fn?, 0/false
 420     break-if-=
 421     var rest-ah/esi: (addr handle cell) <- get f, right
 422     var rest/eax: (addr cell) <- lookup *rest-ah
 423     var callee-env-ah/edx: (addr handle cell) <- get rest, left
 424     rest-ah <- get rest, right
 425     rest <- lookup *rest-ah
 426     var params-ah/ecx: (addr handle cell) <- get rest, left
 427     var body-ah/eax: (addr handle cell) <- get rest, right
 428     debug-print "D", 7/fg, 0/bg
 429     apply-function params-ah, args-ah, body-ah, out, *callee-env-ah, globals, trace, screen-cell, keyboard-cell, call-number
 430     debug-print "Y", 7/fg, 0/bg
 431     trace-higher trace
 432     return
 433   }
 434   error trace, "unknown function"
 435 }
 436 
 437 fn apply-function params-ah: (addr handle cell), args-ah: (addr handle cell), body-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int {
 438   # push bindings for params to env
 439   var new-env-h: (handle cell)
 440   var new-env-ah/esi: (addr handle cell) <- address new-env-h
 441   push-bindings params-ah, args-ah, env-h, new-env-ah, trace
 442   #
 443   evaluate-exprs body-ah, out, new-env-h, globals, trace, screen-cell, keyboard-cell, call-number
 444 }
 445 
 446 fn evaluate-exprs _exprs-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell), call-number: int {
 447   # eval all exprs, writing result to `out` each time
 448   var exprs-ah/ecx: (addr handle cell) <- copy _exprs-ah
 449   $evaluate-exprs:loop: {
 450     var exprs/eax: (addr cell) <- lookup *exprs-ah
 451     # stop when exprs is nil
 452     {
 453       var exprs-nil?/eax: boolean <- nil? exprs
 454       compare exprs-nil?, 0/false
 455       break-if-!= $evaluate-exprs:loop
 456     }
 457     # evaluate each expression, writing result to `out`
 458     {
 459       var curr-ah/eax: (addr handle cell) <- get exprs, left
 460       debug-print "E", 7/fg, 0/bg
 461       increment call-number
 462       evaluate curr-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
 463       debug-print "X", 7/fg, 0/bg
 464     }
 465     #
 466     exprs-ah <- get exprs, right
 467     loop
 468   }
 469   # `out` contains result of evaluating final expression
 470 }
 471 
 472 # Bind params to corresponding args and add the bindings to old-env. Return
 473 # the result in env-ah.
 474 #
 475 # We never modify old-env, but we point to it. This way other parts of the
 476 # interpreter can continue using old-env, and everything works harmoniously
 477 # even though no cells are copied around.
 478 #
 479 # env should always be a DAG (ignoring internals of values). It doesn't have
 480 # to be a tree (some values may be shared), but there are also no cycles.
 481 #
 482 # Learn more: https://en.wikipedia.org/wiki/Persistent_data_structure
 483 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) {
 484   var params-ah/edx: (addr handle cell) <- copy _params-ah
 485   var args-ah/ebx: (addr handle cell) <- copy _args-ah
 486   var _params/eax: (addr cell) <- lookup *params-ah
 487   var params/esi: (addr cell) <- copy _params
 488   {
 489     var params-nil?/eax: boolean <- nil? params
 490     compare params-nil?, 0/false
 491     break-if-=
 492     # nil is a literal
 493     trace-text trace, "eval", "done with push-bindings"
 494     copy-handle old-env-h, env-ah
 495     return
 496   }
 497   # Params can only be symbols or pairs. Args can be anything.
 498 +-- 16 lines: # trace "pushing bindings from " params " to " args -----------------------------------------------------------------------------------------------------------------------
 514   trace-lower trace
 515   var params-type/eax: (addr int) <- get params, type
 516   compare *params-type, 2/symbol
 517   {
 518     break-if-!=
 519     trace-text trace, "eval", "symbol; binding to all remaining args"
 520     # create a new binding
 521     var new-binding-storage: (handle cell)
 522     var new-binding-ah/eax: (addr handle cell) <- address new-binding-storage
 523     new-pair new-binding-ah, *params-ah, *args-ah
 524     # push it to env
 525     new-pair env-ah, *new-binding-ah, old-env-h
 526     trace-higher trace
 527     return
 528   }
 529   compare *params-type, 0/pair
 530   {
 531     break-if-=
 532     error trace, "cannot bind a non-symbol"
 533     trace-higher trace
 534     return
 535   }
 536   var _args/eax: (addr cell) <- lookup *args-ah
 537   var args/edi: (addr cell) <- copy _args
 538   # params is now a pair, so args must be also
 539   var args-type/eax: (addr int) <- get args, type
 540   compare *args-type, 0/pair
 541   {
 542     break-if-=
 543     error trace, "args not in a proper list"
 544     trace-higher trace
 545     return
 546   }
 547   var intermediate-env-storage: (handle cell)
 548   var intermediate-env-ah/edx: (addr handle cell) <- address intermediate-env-storage
 549   var first-param-ah/eax: (addr handle cell) <- get params, left
 550   var first-arg-ah/ecx: (addr handle cell) <- get args, left
 551   push-bindings first-param-ah, first-arg-ah, old-env-h, intermediate-env-ah, trace
 552   var remaining-params-ah/eax: (addr handle cell) <- get params, right
 553   var remaining-args-ah/ecx: (addr handle cell) <- get args, right
 554   push-bindings remaining-params-ah, remaining-args-ah, *intermediate-env-ah, env-ah, trace
 555   trace-higher trace
 556 }
 557 
 558 fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
 559   # trace sym
 560   {
 561     compare trace, 0
 562     break-if-=
 563     var stream-storage: (stream byte 0x800)  # pessimistically sized just for the large alist loaded from disk in `main`
 564     var stream/ecx: (addr stream byte) <- address stream-storage
 565     write stream, "look up "
 566     var sym2/eax: (addr cell) <- copy sym
 567     var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data
 568     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
 569     rewind-stream sym-data
 570     write-stream stream, sym-data
 571     write stream, " in "
 572     var env-ah/eax: (addr handle cell) <- address env-h
 573     print-cell env-ah, stream, 0/no-trace
 574     trace trace, "eval", stream
 575   }
 576   trace-lower trace
 577   var _env/eax: (addr cell) <- lookup env-h
 578   var env/ebx: (addr cell) <- copy _env
 579   # if env is not a list, abort
 580   {
 581     var env-type/ecx: (addr int) <- get env, type
 582     compare *env-type, 0/pair
 583     break-if-=
 584     error trace, "eval found a non-list environment"
 585     trace-higher trace
 586     return
 587   }
 588   # if env is nil, look up in globals
 589   {
 590     var env-nil?/eax: boolean <- nil? env
 591     compare env-nil?, 0/false
 592     break-if-=
 593     debug-print "b", 7/fg, 0/bg
 594     lookup-symbol-in-globals sym, out, globals, trace, screen-cell, keyboard-cell
 595     debug-print "x", 7/fg, 0/bg
 596     trace-higher trace
 597 +-- 15 lines: # trace "=> " out " (global)" ---------------------------------------------------------------------------------------------------------------------------------------------
 612     debug-print "y", 7/fg, 0/bg
 613     return
 614   }
 615   # check car
 616   var env-head-storage: (handle cell)
 617   var env-head-ah/eax: (addr handle cell) <- address env-head-storage
 618   car env, env-head-ah, 0/no-trace
 619   var _env-head/eax: (addr cell) <- lookup *env-head-ah
 620   var env-head/ecx: (addr cell) <- copy _env-head
 621   # if car is not a list, abort
 622   {
 623     var env-head-type/eax: (addr int) <- get env-head, type
 624     compare *env-head-type, 0/pair
 625     break-if-=
 626     error trace, "environment is not a list of (key . value) pairs"
 627     trace-higher trace
 628     return
 629   }
 630   # check key
 631   var curr-key-storage: (handle cell)
 632   var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage
 633   car env-head, curr-key-ah, trace
 634   var curr-key/eax: (addr cell) <- lookup *curr-key-ah
 635   # if key is not a symbol, abort
 636   {
 637     var curr-key-type/eax: (addr int) <- get curr-key, type
 638     compare *curr-key-type, 2/symbol
 639     break-if-=
 640     error trace, "environment contains a binding for a non-symbol"
 641     trace-higher trace
 642     return
 643   }
 644   # if key matches sym, return val
 645   var match?/eax: boolean <- cell-isomorphic? curr-key, sym, trace
 646   compare match?, 0/false
 647   {
 648     break-if-=
 649     cdr env-head, out, 0/no-trace
 650 +-- 15 lines: # trace "=> " out " (match)" ----------------------------------------------------------------------------------------------------------------------------------------------
 665     trace-higher trace
 666     return
 667   }
 668   # otherwise recurse
 669   var env-tail-storage: (handle cell)
 670   var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
 671   cdr env, env-tail-ah, trace
 672   lookup-symbol sym, out, *env-tail-ah, globals, trace, screen-cell, keyboard-cell
 673   trace-higher trace
 674 +-- 15 lines: # trace "=> " out " (recurse)" --------------------------------------------------------------------------------------------------------------------------------------------
 689 }
 690 
 691 fn test-lookup-symbol-in-env {
 692   # tmp = (a . 3)
 693   var val-storage: (handle cell)
 694   var val-ah/ecx: (addr handle cell) <- address val-storage
 695   new-integer val-ah, 3
 696   var key-storage: (handle cell)
 697   var key-ah/edx: (addr handle cell) <- address key-storage
 698   new-symbol key-ah, "a"
 699   var env-storage: (handle cell)
 700   var env-ah/ebx: (addr handle cell) <- address env-storage
 701   new-pair env-ah, *key-ah, *val-ah
 702   # env = ((a . 3))
 703   var nil-storage: (handle cell)
 704   var nil-ah/ecx: (addr handle cell) <- address nil-storage
 705   allocate-pair nil-ah
 706   new-pair env-ah, *env-ah, *nil-ah
 707   # lookup sym(a) in env tmp
 708   var tmp-storage: (handle cell)
 709   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
 710   new-symbol tmp-ah, "a"
 711   var in/eax: (addr cell) <- lookup *tmp-ah
 712   lookup-symbol in, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard
 713   var result/eax: (addr cell) <- lookup *tmp-ah
 714   var result-type/edx: (addr int) <- get result, type
 715   check-ints-equal *result-type, 1/number, "F - test-lookup-symbol-in-env/0"
 716   var result-value-addr/eax: (addr float) <- get result, number-data
 717   var result-value/eax: int <- convert *result-value-addr
 718   check-ints-equal result-value, 3, "F - test-lookup-symbol-in-env/1"
 719 }
 720 
 721 fn test-lookup-symbol-in-globals {
 722   var globals-storage: global-table
 723   var globals/edi: (addr global-table) <- address globals-storage
 724   initialize-globals globals
 725   # env = nil
 726   var nil-storage: (handle cell)
 727   var nil-ah/ecx: (addr handle cell) <- address nil-storage
 728   allocate-pair nil-ah
 729   # lookup sym(a), env
 730   var tmp-storage: (handle cell)
 731   var tmp-ah/ebx: (addr handle cell) <- address tmp-storage
 732   new-symbol tmp-ah, "+"
 733   var in/eax: (addr cell) <- lookup *tmp-ah
 734   lookup-symbol in, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard
 735   var result/eax: (addr cell) <- lookup *tmp-ah
 736   var result-type/edx: (addr int) <- get result, type
 737   check-ints-equal *result-type, 4/primitive-function, "F - test-lookup-symbol-in-globals/0"
 738   var result-value/eax: (addr int) <- get result, index-data
 739   check-ints-equal *result-value, 2/add, "F - test-lookup-symbol-in-globals/1"
 740 }
 741 
 742 fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) {
 743   # trace name
 744   {
 745     compare trace, 0
 746     break-if-=
 747     var stream-storage: (stream byte 0x800)  # pessimistically sized just for the large alist loaded from disk in `main`
 748     var stream/ecx: (addr stream byte) <- address stream-storage
 749     write stream, "bind "
 750     rewind-stream name
 751     write-stream stream, name
 752     write stream, " to "
 753     print-cell val, stream, 0/no-trace
 754     write stream, " in "
 755     var env-ah/eax: (addr handle cell) <- address env-h
 756     print-cell env-ah, stream, 0/no-trace
 757     trace trace, "eval", stream
 758   }
 759   trace-lower trace
 760   var _env/eax: (addr cell) <- lookup env-h
 761   var env/ebx: (addr cell) <- copy _env
 762   # if env is not a list, abort
 763   {
 764     var env-type/ecx: (addr int) <- get env, type
 765     compare *env-type, 0/pair
 766     break-if-=
 767     error trace, "eval found a non-list environment"
 768     trace-higher trace
 769     return
 770   }
 771   # if env is nil, look in globals
 772   {
 773     var env-nil?/eax: boolean <- nil? env
 774     compare env-nil?, 0/false
 775     break-if-=
 776     debug-print "b", 3/fg, 0/bg
 777     mutate-binding-in-globals name, val, globals, trace
 778     debug-print "x", 3/fg, 0/bg
 779     trace-higher trace
 780 +-- 15 lines: # trace "=> " val " (global)" ---------------------------------------------------------------------------------------------------------------------------------------------
 795     debug-print "y", 3/fg, 0/bg
 796     return
 797   }
 798   # check car
 799   var env-head-storage: (handle cell)
 800   var env-head-ah/eax: (addr handle cell) <- address env-head-storage
 801   car env, env-head-ah, 0/no-trace
 802   var _env-head/eax: (addr cell) <- lookup *env-head-ah
 803   var env-head/ecx: (addr cell) <- copy _env-head
 804   # if car is not a list, abort
 805   {
 806     var env-head-type/eax: (addr int) <- get env-head, type
 807     compare *env-head-type, 0/pair
 808     break-if-=
 809     error trace, "environment is not a list of (key . value) pairs"
 810     trace-higher trace
 811     return
 812   }
 813   # check key
 814   var curr-key-storage: (handle cell)
 815   var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage
 816   car env-head, curr-key-ah, trace
 817   var curr-key/eax: (addr cell) <- lookup *curr-key-ah
 818   # if key is not a symbol, abort
 819   {
 820     var curr-key-type/eax: (addr int) <- get curr-key, type
 821     compare *curr-key-type, 2/symbol
 822     break-if-=
 823     error trace, "environment contains a binding for a non-symbol"
 824     trace-higher trace
 825     return
 826   }
 827   # if key matches name, return val
 828   var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data
 829   var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah
 830   var match?/eax: boolean <- streams-data-equal? curr-key-data, name
 831   compare match?, 0/false
 832   {
 833     break-if-=
 834     var dest/eax: (addr handle cell) <- get env-head, right
 835     copy-object val, dest
 836     trace-text trace, "eval", "=> done"
 837     trace-higher trace
 838     return
 839   }
 840   # otherwise recurse
 841   var env-tail-storage: (handle cell)
 842   var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
 843   cdr env, env-tail-ah, trace
 844   mutate-binding name, val, *env-tail-ah, globals, trace
 845   trace-higher trace
 846 }
 847 
 848 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
 849   trace-text trace, "eval", "car"
 850   trace-lower trace
 851   var in/eax: (addr cell) <- copy _in
 852   # if in is not a list, abort
 853   {
 854     var in-type/ecx: (addr int) <- get in, type
 855     compare *in-type, 0/pair
 856     break-if-=
 857     error trace, "car on a non-list"
 858     trace-higher trace
 859     return
 860   }
 861   # if in is nil, abort
 862   {
 863     var in-nil?/eax: boolean <- nil? in
 864     compare in-nil?, 0/false
 865     break-if-=
 866     error trace, "car on nil"
 867     trace-higher trace
 868     return
 869   }
 870   var in-left/eax: (addr handle cell) <- get in, left
 871   copy-object in-left, out
 872   trace-higher trace
 873   return
 874 }
 875 
 876 fn cdr _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
 877   trace-text trace, "eval", "cdr"
 878   trace-lower trace
 879   var in/eax: (addr cell) <- copy _in
 880   # if in is not a list, abort
 881   {
 882     var in-type/ecx: (addr int) <- get in, type
 883     compare *in-type, 0/pair
 884     break-if-=
 885     error trace, "car on a non-list"
 886     trace-higher trace
 887     return
 888   }
 889   # if in is nil, abort
 890   {
 891     var in-nil?/eax: boolean <- nil? in
 892     compare in-nil?, 0/false
 893     break-if-=
 894     error trace, "car on nil"
 895     trace-higher trace
 896     return
 897   }
 898   var in-right/eax: (addr handle cell) <- get in, right
 899   copy-object in-right, out
 900   trace-higher trace
 901   return
 902 }
 903 
 904 fn cell-isomorphic? _a: (addr cell), _b: (addr cell), trace: (addr trace) -> _/eax: boolean {
 905   trace-text trace, "eval", "cell-isomorphic?"
 906   trace-lower trace
 907   var a/esi: (addr cell) <- copy _a
 908   var b/edi: (addr cell) <- copy _b
 909   # if types don't match, return false
 910   var a-type-addr/eax: (addr int) <- get a, type
 911   var b-type-addr/ecx: (addr int) <- get b, type
 912   var b-type/ecx: int <- copy *b-type-addr
 913   compare b-type, *a-type-addr
 914   {
 915     break-if-=
 916     trace-higher trace
 917     trace-text trace, "eval", "=> false (type)"
 918     return 0/false
 919   }
 920   # if types are number, compare number-data
 921   # TODO: exactly comparing floats is a bad idea
 922   compare b-type, 1/number
 923   {
 924     break-if-!=
 925     var a-val-addr/eax: (addr float) <- get a, number-data
 926     var b-val-addr/ecx: (addr float) <- get b, number-data
 927     var a-val/xmm0: float <- copy *a-val-addr
 928     compare a-val, *b-val-addr
 929     {
 930       break-if-=
 931       trace-higher trace
 932       trace-text trace, "eval", "=> false (numbers)"
 933       return 0/false
 934     }
 935     trace-higher trace
 936     trace-text trace, "eval", "=> true (numbers)"
 937     return 1/true
 938   }
 939   compare b-type, 2/symbol
 940   {
 941     break-if-!=
 942     var b-val-ah/eax: (addr handle stream byte) <- get b, text-data
 943     var _b-val/eax: (addr stream byte) <- lookup *b-val-ah
 944     var b-val/ecx: (addr stream byte) <- copy _b-val
 945     var a-val-ah/eax: (addr handle stream byte) <- get a, text-data
 946     var a-val/eax: (addr stream byte) <- lookup *a-val-ah
 947     var tmp-array: (handle array byte)
 948     var tmp-ah/edx: (addr handle array byte) <- address tmp-array
 949     rewind-stream a-val
 950     stream-to-array a-val, tmp-ah
 951     var tmp/eax: (addr array byte) <- lookup *tmp-ah
 952     var match?/eax: boolean <- stream-data-equal? b-val, tmp
 953     trace-higher trace
 954     {
 955       compare match?, 0/false
 956       break-if-=
 957       trace-text trace, "eval", "=> true (symbols)"
 958     }
 959     {
 960       compare match?, 0/false
 961       break-if-!=
 962       trace-text trace, "eval", "=> false (symbols)"
 963     }
 964     return match?
 965   }
 966   # if a is nil, b should be nil
 967   {
 968     # (assumes nil? returns 0 or 1)
 969     var _b-nil?/eax: boolean <- nil? b
 970     var b-nil?/ecx: boolean <- copy _b-nil?
 971     var a-nil?/eax: boolean <- nil? a
 972     # a == nil and b == nil => return true
 973     {
 974       compare a-nil?, 0/false
 975       break-if-=
 976       compare b-nil?, 0/false
 977       break-if-=
 978       trace-higher trace
 979       trace-text trace, "eval", "=> true (nils)"
 980       return 1/true
 981     }
 982     # a == nil => return false
 983     {
 984       compare a-nil?, 0/false
 985       break-if-=
 986       trace-higher trace
 987       trace-text trace, "eval", "=> false (b != nil)"
 988       return 0/false
 989     }
 990     # b == nil => return false
 991     {
 992       compare b-nil?, 0/false
 993       break-if-=
 994       trace-higher trace
 995       trace-text trace, "eval", "=> false (a != nil)"
 996       return 0/false
 997     }
 998   }
 999   # a and b are pairs
1000   var a-tmp-storage: (handle cell)
1001   var a-tmp-ah/edx: (addr handle cell) <- address a-tmp-storage
1002   var b-tmp-storage: (handle cell)
1003   var b-tmp-ah/ebx: (addr handle cell) <- address b-tmp-storage
1004   # if cars aren't equal, return false
1005   car a, a-tmp-ah, trace
1006   car b, b-tmp-ah, trace
1007   {
1008     var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
1009     var a-tmp/ecx: (addr cell) <- copy _a-tmp
1010     var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
1011     var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
1012     compare result, 0/false
1013     break-if-!=
1014     trace-higher trace
1015     trace-text trace, "eval", "=> false (car mismatch)"
1016     return 0/false
1017   }
1018   # recurse on cdrs
1019   cdr a, a-tmp-ah, trace
1020   cdr b, b-tmp-ah, trace
1021   var _a-tmp/eax: (addr cell) <- lookup *a-tmp-ah
1022   var a-tmp/ecx: (addr cell) <- copy _a-tmp
1023   var b-tmp/eax: (addr cell) <- lookup *b-tmp-ah
1024   var result/eax: boolean <- cell-isomorphic? a-tmp, b-tmp, trace
1025   trace-higher trace
1026   return result
1027 }
1028 
1029 fn fn? _x: (addr cell) -> _/eax: boolean {
1030   var x/esi: (addr cell) <- copy _x
1031   var type/eax: (addr int) <- get x, type
1032   compare *type, 2/symbol
1033   {
1034     break-if-=
1035     return 0/false
1036   }
1037   var contents-ah/eax: (addr handle stream byte) <- get x, text-data
1038   var contents/eax: (addr stream byte) <- lookup *contents-ah
1039   var result/eax: boolean <- stream-data-equal? contents, "fn"
1040   return result
1041 }
1042 
1043 fn test-evaluate-is-well-behaved {
1044   var t-storage: trace
1045   var t/esi: (addr trace) <- address t-storage
1046   initialize-trace t, 0x10, 0/visible  # we don't use trace UI
1047   # env = nil
1048   var env-storage: (handle cell)
1049   var env-ah/ecx: (addr handle cell) <- address env-storage
1050   allocate-pair env-ah
1051   # eval sym(a), nil env
1052   var tmp-storage: (handle cell)
1053   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
1054   new-symbol tmp-ah, "a"
1055   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, t, 0/no-screen, 0/no-keyboard, 0/call-number
1056   # doesn't die
1057   check-trace-contains t, "error", "unbound symbol: a", "F - test-evaluate-is-well-behaved"
1058 }
1059 
1060 fn test-evaluate-number {
1061   # env = nil
1062   var env-storage: (handle cell)
1063   var env-ah/ecx: (addr handle cell) <- address env-storage
1064   allocate-pair env-ah
1065   # tmp = 3
1066   var tmp-storage: (handle cell)
1067   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
1068   new-integer tmp-ah, 3
1069   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number
1070   #
1071   var result/eax: (addr cell) <- lookup *tmp-ah
1072   var result-type/edx: (addr int) <- get result, type
1073   check-ints-equal *result-type, 1/number, "F - test-evaluate-number/0"
1074   var result-value-addr/eax: (addr float) <- get result, number-data
1075   var result-value/eax: int <- convert *result-value-addr
1076   check-ints-equal result-value, 3, "F - test-evaluate-number/1"
1077 }
1078 
1079 fn test-evaluate-symbol {
1080   # tmp = (a . 3)
1081   var val-storage: (handle cell)
1082   var val-ah/ecx: (addr handle cell) <- address val-storage
1083   new-integer val-ah, 3
1084   var key-storage: (handle cell)
1085   var key-ah/edx: (addr handle cell) <- address key-storage
1086   new-symbol key-ah, "a"
1087   var env-storage: (handle cell)
1088   var env-ah/ebx: (addr handle cell) <- address env-storage
1089   new-pair env-ah, *key-ah, *val-ah
1090   # env = ((a . 3))
1091   var nil-storage: (handle cell)
1092   var nil-ah/ecx: (addr handle cell) <- address nil-storage
1093   allocate-pair nil-ah
1094   new-pair env-ah, *env-ah, *nil-ah
1095   # eval sym(a), env
1096   var tmp-storage: (handle cell)
1097   var tmp-ah/edx: (addr handle cell) <- address tmp-storage
1098   new-symbol tmp-ah, "a"
1099   evaluate tmp-ah, tmp-ah, *env-ah, 0/no-globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number
1100   var result/eax: (addr cell) <- lookup *tmp-ah
1101   var result-type/edx: (addr int) <- get result, type
1102   check-ints-equal *result-type, 1/number, "F - test-evaluate-symbol/0"
1103   var result-value-addr/eax: (addr float) <- get result, number-data
1104   var result-value/eax: int <- convert *result-value-addr
1105   check-ints-equal result-value, 3, "F - test-evaluate-symbol/1"
1106 }
1107 
1108 fn test-evaluate-primitive-function {
1109   var globals-storage: global-table
1110   var globals/edi: (addr global-table) <- address globals-storage
1111   initialize-globals globals
1112   var nil-storage: (handle cell)
1113   var nil-ah/ecx: (addr handle cell) <- address nil-storage
1114   allocate-pair nil-ah
1115   var add-storage: (handle cell)
1116   var add-ah/ebx: (addr handle cell) <- address add-storage
1117   new-symbol add-ah, "+"
1118   # eval +, nil env
1119   var tmp-storage: (handle cell)
1120   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
1121   evaluate add-ah, tmp-ah, *nil-ah, globals, 0/no-trace, 0/no-screen, 0/no-keyboard, 0/call-number
1122   #
1123   var result/eax: (addr cell) <- lookup *tmp-ah
1124   var result-type/edx: (addr int) <- get result, type
1125   check-ints-equal *result-type, 4/primitive-function, "F - test-evaluate-primitive-function/0"
1126   var result-value/eax: (addr int) <- get result, index-data
1127   check-ints-equal *result-value, 2/add, "F - test-evaluate-primitive-function/1"
1128 }
1129 
1130 fn test-evaluate-primitive-function-call {
1131   var t-storage: trace
1132   var t/edi: (addr trace) <- address t-storage
1133   initialize-trace t, 0x100, 0/visible  # we don't use trace UI
1134   #
1135   var nil-storage: (handle cell)
1136   var nil-ah/ecx: (addr handle cell) <- address nil-storage
1137   allocate-pair nil-ah
1138   var one-storage: (handle cell)
1139   var one-ah/edx: (addr handle cell) <- address one-storage
1140   new-integer one-ah, 1
1141   var add-storage: (handle cell)
1142   var add-ah/ebx: (addr handle cell) <- address add-storage
1143   new-symbol add-ah, "+"
1144   # input is (+ 1 1)
1145   var tmp-storage: (handle cell)
1146   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
1147   new-pair tmp-ah, *one-ah, *nil-ah
1148   new-pair tmp-ah, *one-ah, *tmp-ah
1149   new-pair tmp-ah, *add-ah, *tmp-ah
1150 #?   dump-cell tmp-ah
1151   #
1152   var globals-storage: global-table
1153   var globals/edx: (addr global-table) <- address globals-storage
1154   initialize-globals globals
1155   #
1156   evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/call-number
1157 #?   dump-trace t
1158   #
1159   var result/eax: (addr cell) <- lookup *tmp-ah
1160   var result-type/edx: (addr int) <- get result, type
1161   check-ints-equal *result-type, 1/number, "F - test-evaluate-primitive-function-call/0"
1162   var result-value-addr/eax: (addr float) <- get result, number-data
1163   var result-value/eax: int <- convert *result-value-addr
1164   check-ints-equal result-value, 2, "F - test-evaluate-primitive-function-call/1"
1165 }