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