1 type global {
   2   name: (handle array byte)
   3   value: (handle cell)
   4 }
   5 
   6 type global-table {
   7   data: (handle array global)
   8   final-index: int
   9 }
  10 
  11 fn initialize-globals _self: (addr global-table) {
  12   var self/esi: (addr global-table) <- copy _self
  13   var data-ah/eax: (addr handle array global) <- get self, data
  14   populate data-ah, 0x40
  15   # generic
  16   append-primitive self, "="
  17   # for numbers
  18   append-primitive self, "+"
  19   append-primitive self, "-"
  20   append-primitive self, "*"
  21   append-primitive self, "/"
  22   append-primitive self, "sqrt"
  23   append-primitive self, "abs"
  24   append-primitive self, "sgn"
  25   append-primitive self, "<"
  26   append-primitive self, ">"
  27   append-primitive self, "<="
  28   append-primitive self, ">="
  29   # for pairs
  30   append-primitive self, "car"
  31   append-primitive self, "cdr"
  32   append-primitive self, "cons"
  33   # for screens
  34   append-primitive self, "print"
  35   append-primitive self, "clear"
  36   append-primitive self, "lines"
  37   append-primitive self, "columns"
  38   append-primitive self, "up"
  39   append-primitive self, "down"
  40   append-primitive self, "left"
  41   append-primitive self, "right"
  42   append-primitive self, "cr"
  43   append-primitive self, "pixel"
  44   append-primitive self, "width"
  45   append-primitive self, "height"
  46   # for keyboards
  47   append-primitive self, "key"
  48   # for streams
  49   append-primitive self, "stream"
  50   append-primitive self, "write"
  51   # misc
  52   append-primitive self, "abort"
  53   append-primitive self, "life"
  54   # keep sync'd with render-primitives
  55 }
  56 
  57 fn load-globals in: (addr handle cell), self: (addr global-table) {
  58   var remaining-ah/esi: (addr handle cell) <- copy in
  59   {
  60     var _remaining/eax: (addr cell) <- lookup *remaining-ah
  61     var remaining/ecx: (addr cell) <- copy _remaining
  62     var done?/eax: boolean <- nil? remaining
  63     compare done?, 0/false
  64     break-if-!=
  65     var curr-ah/eax: (addr handle cell) <- get remaining, left
  66     var curr/eax: (addr cell) <- lookup *curr-ah
  67     remaining-ah <- get remaining, right
  68     var name-ah/ecx: (addr handle cell) <- get curr, left
  69     var value-ah/ebx: (addr handle cell) <- get curr, right
  70     var name/eax: (addr cell) <- lookup *name-ah
  71     var name-data-ah/eax: (addr handle stream byte) <- get name, text-data
  72     var name-data/eax: (addr stream byte) <- lookup *name-data-ah
  73     append-global-binding-of-stream self, name-data, *value-ah
  74     loop
  75   }
  76 }
  77 
  78 fn write-globals out: (addr stream byte), _self: (addr global-table) {
  79   var self/esi: (addr global-table) <- copy _self
  80   write out, "  (globals . (\n"
  81   var data-ah/eax: (addr handle array global) <- get self, data
  82   var data/eax: (addr array global) <- lookup *data-ah
  83   var final-index/edx: (addr int) <- get self, final-index
  84   var curr-index/ecx: int <- copy 1/skip-0
  85   {
  86     compare curr-index, *final-index
  87     break-if->
  88     var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
  89     var curr/ebx: (addr global) <- index data, curr-offset
  90     var curr-value-ah/edx: (addr handle cell) <- get curr, value
  91     var curr-value/eax: (addr cell) <- lookup *curr-value-ah
  92     var curr-type/eax: (addr int) <- get curr-value, type
  93     {
  94       compare *curr-type, 4/primitive-function
  95       break-if-=
  96       compare *curr-type, 5/screen
  97       break-if-=
  98       compare *curr-type, 6/keyboard
  99       break-if-=
 100       compare *curr-type, 3/stream  # not implemented yet
 101       break-if-=
 102       write out, "    ("
 103       var curr-name-ah/eax: (addr handle array byte) <- get curr, name
 104       var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
 105       write out, curr-name
 106       write out, " . "
 107       print-cell curr-value-ah, out, 0/no-trace
 108       write out, ")\n"
 109     }
 110     curr-index <- increment
 111     loop
 112   }
 113   write out, "  ))\n"
 114 }
 115 
 116 fn render-globals screen: (addr screen), _self: (addr global-table), xmin: int, ymin: int, xmax: int, ymax: int {
 117   clear-rect screen, xmin, ymin, xmax, ymax, 0x12/bg=almost-black
 118   var self/esi: (addr global-table) <- copy _self
 119   # render primitives
 120   render-primitives screen, xmin, ymin, xmax, ymax
 121   var data-ah/eax: (addr handle array global) <- get self, data
 122   var data/eax: (addr array global) <- lookup *data-ah
 123   var curr-index/edx: int <- copy 1
 124   {
 125     var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
 126     var curr/ebx: (addr global) <- index data, curr-offset
 127     var continue?/eax: boolean <- primitive-global? curr
 128     compare continue?, 0/false
 129     break-if-=
 130     curr-index <- increment
 131     loop
 132   }
 133   var lowest-index/edi: int <- copy curr-index
 134   var y/ecx: int <- copy ymin
 135   var final-index/edx: (addr int) <- get self, final-index
 136   var curr-index/edx: int <- copy *final-index
 137   {
 138     compare curr-index, lowest-index
 139     break-if-<
 140     compare y, ymax
 141     break-if->=
 142     {
 143       var curr-offset/ebx: (offset global) <- compute-offset data, curr-index
 144       var curr/ebx: (addr global) <- index data, curr-offset
 145       var curr-name-ah/eax: (addr handle array byte) <- get curr, name
 146       var _curr-name/eax: (addr array byte) <- lookup *curr-name-ah
 147       var curr-name/edx: (addr array byte) <- copy _curr-name
 148       var x/eax: int <- copy xmin
 149       x, y <- draw-text-wrapping-right-then-down screen, curr-name, xmin, ymin, xmax, ymax, x, y, 0x2a/fg=orange, 0x12/bg=almost-black
 150       x, y <- draw-text-wrapping-right-then-down screen, " <- ", xmin, ymin, xmax, ymax, x, y, 7/fg=grey, 0x12/bg=almost-black
 151       var curr-value/edx: (addr handle cell) <- get curr, value
 152       var s-storage: (stream byte 0x400)
 153       var s/ebx: (addr stream byte) <- address s-storage
 154       print-cell curr-value, s, 0/no-trace
 155       x, y <- draw-stream-wrapping-right-then-down screen, s, xmin, ymin, xmax, ymax, x, y, 3/fg=cyan, 0x12/bg=almost-black
 156     }
 157     curr-index <- decrement
 158     y <- increment
 159     loop
 160   }
 161 }
 162 
 163 fn render-primitives screen: (addr screen), xmin: int, ymin: int, xmax: int, ymax: int {
 164   var y/ecx: int <- copy ymax
 165   y <- subtract 0xf
 166   var tmpx/eax: int <- copy xmin
 167   tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 168   y <- increment
 169   var tmpx/eax: int <- copy xmin
 170   tmpx <- draw-text-rightward screen, "  print", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 171   tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 172   y <- increment
 173   var tmpx/eax: int <- copy xmin
 174   tmpx <- draw-text-rightward screen, "  lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 175   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 176   y <- increment
 177   var tmpx/eax: int <- copy xmin
 178   tmpx <- draw-text-rightward screen, "  up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 179   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 180   y <- increment
 181   var tmpx/eax: int <- copy xmin
 182   tmpx <- draw-text-rightward screen, "  cr", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 183   tmpx <- draw-text-rightward screen, ": screen   ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 184   tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 9/fg=blue, 0x12/bg=almost-black
 185   y <- increment
 186   var tmpx/eax: int <- copy xmin
 187   tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 188   y <- increment
 189   var tmpx/eax: int <- copy xmin
 190   tmpx <- draw-text-rightward screen, "  width height", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 191   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 192   y <- increment
 193   var tmpx/eax: int <- copy xmin
 194   tmpx <- draw-text-rightward screen, "  pixel", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 195   tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 196   y <- increment
 197   var tmpx/eax: int <- copy xmin
 198   tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 199   y <- increment
 200   var tmpx/eax: int <- copy xmin
 201   tmpx <- draw-text-rightward screen, "  clear", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 202   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 203   y <- increment
 204   var tmpx/eax: int <- copy xmin
 205   tmpx <- draw-text-rightward screen, "  key", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 206   tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 207   y <- increment
 208   var tmpx/eax: int <- copy xmin
 209   tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 210   y <- increment
 211   var tmpx/eax: int <- copy xmin
 212   tmpx <- draw-text-rightward screen, "  stream", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 213   tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 214   y <- increment
 215   var tmpx/eax: int <- copy xmin
 216   tmpx <- draw-text-rightward screen, "  write", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 217   tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 218   y <- increment
 219   var tmpx/eax: int <- copy xmin
 220   tmpx <- draw-text-rightward screen, "numbers: ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 221   tmpx <- draw-text-rightward screen, "+ - * / sqrt abs sgn = < > <= >=   ", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 222   tmpx <- draw-text-rightward screen, "pairs: ", tmpx, xmax, y, 7/fg=grey, 0x12/bg=almost-black
 223   tmpx <- draw-text-rightward screen, "car cdr cons", tmpx, xmax, y, 0x2a/fg=orange, 0x12/bg=almost-black
 224 }
 225 
 226 fn primitive-global? _x: (addr global) -> _/eax: boolean {
 227   var x/eax: (addr global) <- copy _x
 228   var value-ah/eax: (addr handle cell) <- get x, value
 229   var value/eax: (addr cell) <- lookup *value-ah
 230   compare value, 0/null
 231   {
 232     break-if-!=
 233     return 0/false
 234   }
 235   var value-type/eax: (addr int) <- get value, type
 236   compare *value-type, 4/primitive
 237   {
 238     break-if-=
 239     return 0/false
 240   }
 241   return 1/true
 242 }
 243 
 244 fn append-primitive _self: (addr global-table), name: (addr array byte) {
 245   var self/esi: (addr global-table) <- copy _self
 246   var final-index-addr/ecx: (addr int) <- get self, final-index
 247   increment *final-index-addr
 248   var curr-index/ecx: int <- copy *final-index-addr
 249   var data-ah/eax: (addr handle array global) <- get self, data
 250   var data/eax: (addr array global) <- lookup *data-ah
 251   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
 252   var curr/esi: (addr global) <- index data, curr-offset
 253   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
 254   copy-array-object name, curr-name-ah
 255   var curr-value-ah/eax: (addr handle cell) <- get curr, value
 256   new-primitive-function curr-value-ah, curr-index
 257 }
 258 
 259 fn append-global _self: (addr global-table), name: (addr array byte), value: (handle cell) {
 260   var self/esi: (addr global-table) <- copy _self
 261   var final-index-addr/ecx: (addr int) <- get self, final-index
 262   increment *final-index-addr
 263   var curr-index/ecx: int <- copy *final-index-addr
 264   var data-ah/eax: (addr handle array global) <- get self, data
 265   var data/eax: (addr array global) <- lookup *data-ah
 266   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
 267   var curr/esi: (addr global) <- index data, curr-offset
 268   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
 269   copy-array-object name, curr-name-ah
 270   var curr-value-ah/eax: (addr handle cell) <- get curr, value
 271   copy-handle value, curr-value-ah
 272 }
 273 
 274 fn append-global-binding-of-stream _self: (addr global-table), name: (addr stream byte), value: (handle cell) {
 275   var self/esi: (addr global-table) <- copy _self
 276   var final-index-addr/ecx: (addr int) <- get self, final-index
 277   increment *final-index-addr
 278   var curr-index/ecx: int <- copy *final-index-addr
 279   var data-ah/eax: (addr handle array global) <- get self, data
 280   var data/eax: (addr array global) <- lookup *data-ah
 281   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
 282   var curr/esi: (addr global) <- index data, curr-offset
 283   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
 284   rewind-stream name
 285   stream-to-array name, curr-name-ah
 286   var curr-value-ah/eax: (addr handle cell) <- get curr, value
 287   copy-handle value, curr-value-ah
 288 }
 289 
 290 fn lookup-symbol-in-globals _sym: (addr cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
 291   var sym/eax: (addr cell) <- copy _sym
 292   var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data
 293   var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah
 294   var sym-name/edx: (addr stream byte) <- copy _sym-name
 295   var globals/esi: (addr global-table) <- copy _globals
 296   {
 297     compare globals, 0
 298     break-if-=
 299     var curr-index/ecx: int <- find-symbol-in-globals globals, sym-name
 300     compare curr-index, -1/not-found
 301     break-if-=
 302     var global-data-ah/eax: (addr handle array global) <- get globals, data
 303     var global-data/eax: (addr array global) <- lookup *global-data-ah
 304     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
 305     var curr/ebx: (addr global) <- index global-data, curr-offset
 306     var curr-value/eax: (addr handle cell) <- get curr, value
 307     copy-object curr-value, out
 308     return
 309   }
 310   # if sym is "screen" and screen-cell exists, return it
 311   {
 312     var sym-is-screen?/eax: boolean <- stream-data-equal? sym-name, "screen"
 313     compare sym-is-screen?, 0/false
 314     break-if-=
 315     compare screen-cell, 0
 316     break-if-=
 317     copy-object screen-cell, out
 318     return
 319   }
 320   # if sym is "keyboard" and keyboard-cell exists, return it
 321   {
 322     var sym-is-keyboard?/eax: boolean <- stream-data-equal? sym-name, "keyboard"
 323     compare sym-is-keyboard?, 0/false
 324     break-if-=
 325     compare keyboard-cell, 0
 326     break-if-=
 327     copy-object keyboard-cell, out
 328     return
 329   }
 330   # otherwise error "unbound symbol: ", sym
 331   var stream-storage: (stream byte 0x40)
 332   var stream/ecx: (addr stream byte) <- address stream-storage
 333   write stream, "unbound symbol: "
 334   rewind-stream sym-name
 335   write-stream stream, sym-name
 336   trace trace, "error", stream
 337 }
 338 
 339 # return the index in globals containing 'sym'
 340 # or -1 if not found
 341 fn find-symbol-in-globals _globals: (addr global-table), sym-name: (addr stream byte) -> _/ecx: int {
 342   var globals/esi: (addr global-table) <- copy _globals
 343   compare globals, 0
 344   {
 345     break-if-!=
 346     return -1/not-found
 347   }
 348   var global-data-ah/eax: (addr handle array global) <- get globals, data
 349   var global-data/eax: (addr array global) <- lookup *global-data-ah
 350   var final-index/ecx: (addr int) <- get globals, final-index
 351   var curr-index/ecx: int <- copy *final-index
 352   {
 353     compare curr-index, 0
 354     break-if-<
 355     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
 356     var curr/ebx: (addr global) <- index global-data, curr-offset
 357     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
 358     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
 359     var found?/eax: boolean <- stream-data-equal? sym-name, curr-name
 360     compare found?, 0/false
 361     {
 362       break-if-=
 363       return curr-index
 364     }
 365     curr-index <- decrement
 366     loop
 367   }
 368   return -1/not-found
 369 }
 370 
 371 # a little strange; goes from value to name and selects primitive based on name
 372 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
 373   var f/esi: (addr cell) <- copy _f
 374   var f-index-a/ecx: (addr int) <- get f, index-data
 375   var f-index/ecx: int <- copy *f-index-a
 376   var globals/eax: (addr global-table) <- copy _globals
 377   var global-data-ah/eax: (addr handle array global) <- get globals, data
 378   var global-data/eax: (addr array global) <- lookup *global-data-ah
 379   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
 380   var f-value/ecx: (addr global) <- index global-data, f-offset
 381   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
 382   var f-name/eax: (addr array byte) <- lookup *f-name-ah
 383   {
 384     var is-add?/eax: boolean <- string-equal? f-name, "+"
 385     compare is-add?, 0/false
 386     break-if-=
 387     apply-add args-ah, out, trace
 388     return
 389   }
 390   {
 391     var is-subtract?/eax: boolean <- string-equal? f-name, "-"
 392     compare is-subtract?, 0/false
 393     break-if-=
 394     apply-subtract args-ah, out, trace
 395     return
 396   }
 397   {
 398     var is-multiply?/eax: boolean <- string-equal? f-name, "*"
 399     compare is-multiply?, 0/false
 400     break-if-=
 401     apply-multiply args-ah, out, trace
 402     return
 403   }
 404   {
 405     var is-divide?/eax: boolean <- string-equal? f-name, "/"
 406     compare is-divide?, 0/false
 407     break-if-=
 408     apply-divide args-ah, out, trace
 409     return
 410   }
 411   {
 412     var is-square-root?/eax: boolean <- string-equal? f-name, "sqrt"
 413     compare is-square-root?, 0/false
 414     break-if-=
 415     apply-square-root args-ah, out, trace
 416     return
 417   }
 418   {
 419     var is-abs?/eax: boolean <- string-equal? f-name, "abs"
 420     compare is-abs?, 0/false
 421     break-if-=
 422     apply-abs args-ah, out, trace
 423     return
 424   }
 425   {
 426     var is-sgn?/eax: boolean <- string-equal? f-name, "sgn"
 427     compare is-sgn?, 0/false
 428     break-if-=
 429     apply-sgn args-ah, out, trace
 430     return
 431   }
 432   {
 433     var is-car?/eax: boolean <- string-equal? f-name, "car"
 434     compare is-car?, 0/false
 435     break-if-=
 436     apply-car args-ah, out, trace
 437     return
 438   }
 439   {
 440     var is-cdr?/eax: boolean <- string-equal? f-name, "cdr"
 441     compare is-cdr?, 0/false
 442     break-if-=
 443     apply-cdr args-ah, out, trace
 444     return
 445   }
 446   {
 447     var is-cons?/eax: boolean <- string-equal? f-name, "cons"
 448     compare is-cons?, 0/false
 449     break-if-=
 450     apply-cons args-ah, out, trace
 451     return
 452   }
 453   {
 454     var is-structurally-equal?/eax: boolean <- string-equal? f-name, "="
 455     compare is-structurally-equal?, 0/false
 456     break-if-=
 457     apply-structurally-equal args-ah, out, trace
 458     return
 459   }
 460   {
 461     var is-lesser?/eax: boolean <- string-equal? f-name, "<"
 462     compare is-lesser?, 0/false
 463     break-if-=
 464     apply-< args-ah, out, trace
 465     return
 466   }
 467   {
 468     var is-greater?/eax: boolean <- string-equal? f-name, ">"
 469     compare is-greater?, 0/false
 470     break-if-=
 471     apply-> args-ah, out, trace
 472     return
 473   }
 474   {
 475     var is-lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
 476     compare is-lesser-or-equal?, 0/false
 477     break-if-=
 478     apply-<= args-ah, out, trace
 479     return
 480   }
 481   {
 482     var is-greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
 483     compare is-greater-or-equal?, 0/false
 484     break-if-=
 485     apply->= args-ah, out, trace
 486     return
 487   }
 488   {
 489     var is-print?/eax: boolean <- string-equal? f-name, "print"
 490     compare is-print?, 0/false
 491     break-if-=
 492     apply-print args-ah, out, trace
 493     return
 494   }
 495   {
 496     var is-clear?/eax: boolean <- string-equal? f-name, "clear"
 497     compare is-clear?, 0/false
 498     break-if-=
 499     apply-clear args-ah, out, trace
 500     return
 501   }
 502   {
 503     var is-lines?/eax: boolean <- string-equal? f-name, "lines"
 504     compare is-lines?, 0/false
 505     break-if-=
 506     apply-lines args-ah, out, trace
 507     return
 508   }
 509   {
 510     var is-columns?/eax: boolean <- string-equal? f-name, "columns"
 511     compare is-columns?, 0/false
 512     break-if-=
 513     apply-columns args-ah, out, trace
 514     return
 515   }
 516   {
 517     var is-up?/eax: boolean <- string-equal? f-name, "up"
 518     compare is-up?, 0/false
 519     break-if-=
 520     apply-up args-ah, out, trace
 521     return
 522   }
 523   {
 524     var is-down?/eax: boolean <- string-equal? f-name, "down"
 525     compare is-down?, 0/false
 526     break-if-=
 527     apply-down args-ah, out, trace
 528     return
 529   }
 530   {
 531     var is-left?/eax: boolean <- string-equal? f-name, "left"
 532     compare is-left?, 0/false
 533     break-if-=
 534     apply-left args-ah, out, trace
 535     return
 536   }
 537   {
 538     var is-right?/eax: boolean <- string-equal? f-name, "right"
 539     compare is-right?, 0/false
 540     break-if-=
 541     apply-right args-ah, out, trace
 542     return
 543   }
 544   {
 545     var is-cr?/eax: boolean <- string-equal? f-name, "cr"
 546     compare is-cr?, 0/false
 547     break-if-=
 548     apply-cr args-ah, out, trace
 549     return
 550   }
 551   {
 552     var is-pixel?/eax: boolean <- string-equal? f-name, "pixel"
 553     compare is-pixel?, 0/false
 554     break-if-=
 555     apply-pixel args-ah, out, trace
 556     return
 557   }
 558   {
 559     var is-width?/eax: boolean <- string-equal? f-name, "width"
 560     compare is-width?, 0/false
 561     break-if-=
 562     apply-width args-ah, out, trace
 563     return
 564   }
 565   {
 566     var is-height?/eax: boolean <- string-equal? f-name, "height"
 567     compare is-height?, 0/false
 568     break-if-=
 569     apply-height args-ah, out, trace
 570     return
 571   }
 572   {
 573     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
 574     compare wait-for-key?, 0/false
 575     break-if-=
 576     apply-wait-for-key args-ah, out, trace
 577     return
 578   }
 579   {
 580     var is-stream?/eax: boolean <- string-equal? f-name, "stream"
 581     compare is-stream?, 0/false
 582     break-if-=
 583     apply-stream args-ah, out, trace
 584     return
 585   }
 586   {
 587     var write?/eax: boolean <- string-equal? f-name, "write"
 588     compare write?, 0/false
 589     break-if-=
 590     apply-write args-ah, out, trace
 591     return
 592   }
 593   {
 594     var abort?/eax: boolean <- string-equal? f-name, "abort"
 595     compare abort?, 0/false
 596     break-if-=
 597     apply-abort args-ah, out, trace
 598     return
 599   }
 600   {
 601     var life?/eax: boolean <- string-equal? f-name, "life"
 602     compare life?, 0/false
 603     break-if-=
 604     apply-life args-ah, out, trace
 605     return
 606   }
 607   abort "unknown primitive function"
 608 }
 609 
 610 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 611   trace-text trace, "eval", "apply +"
 612   var args-ah/eax: (addr handle cell) <- copy _args-ah
 613   var _args/eax: (addr cell) <- lookup *args-ah
 614   var args/esi: (addr cell) <- copy _args
 615   # TODO: check that args is a pair
 616   var empty-args?/eax: boolean <- nil? args
 617   compare empty-args?, 0/false
 618   {
 619     break-if-=
 620     error trace, "+ needs 2 args but got 0"
 621     return
 622   }
 623   # args->left->value
 624   var first-ah/eax: (addr handle cell) <- get args, left
 625   var first/eax: (addr cell) <- lookup *first-ah
 626   var first-type/ecx: (addr int) <- get first, type
 627   compare *first-type, 1/number
 628   {
 629     break-if-=
 630     error trace, "first arg for + is not a number"
 631     return
 632   }
 633   var first-value/ecx: (addr float) <- get first, number-data
 634   # args->right->left->value
 635   var right-ah/eax: (addr handle cell) <- get args, right
 636 #?   dump-cell right-ah
 637 #?   abort "aaa"
 638   var right/eax: (addr cell) <- lookup *right-ah
 639   # TODO: check that right is a pair
 640   var second-ah/eax: (addr handle cell) <- get right, left
 641   var second/eax: (addr cell) <- lookup *second-ah
 642   var second-type/edx: (addr int) <- get second, type
 643   compare *second-type, 1/number
 644   {
 645     break-if-=
 646     error trace, "second arg for + is not a number"
 647     return
 648   }
 649   var second-value/edx: (addr float) <- get second, number-data
 650   # add
 651   var result/xmm0: float <- copy *first-value
 652   result <- add *second-value
 653   new-float out, result
 654 }
 655 
 656 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 657   trace-text trace, "eval", "apply -"
 658   var args-ah/eax: (addr handle cell) <- copy _args-ah
 659   var _args/eax: (addr cell) <- lookup *args-ah
 660   var args/esi: (addr cell) <- copy _args
 661   # TODO: check that args is a pair
 662   var empty-args?/eax: boolean <- nil? args
 663   compare empty-args?, 0/false
 664   {
 665     break-if-=
 666     error trace, "- needs 2 args but got 0"
 667     return
 668   }
 669   # args->left->value
 670   var first-ah/eax: (addr handle cell) <- get args, left
 671   var first/eax: (addr cell) <- lookup *first-ah
 672   var first-type/ecx: (addr int) <- get first, type
 673   compare *first-type, 1/number
 674   {
 675     break-if-=
 676     error trace, "first arg for - is not a number"
 677     return
 678   }
 679   var first-value/ecx: (addr float) <- get first, number-data
 680   # args->right->left->value
 681   var right-ah/eax: (addr handle cell) <- get args, right
 682   var right/eax: (addr cell) <- lookup *right-ah
 683   # TODO: check that right is a pair
 684   var second-ah/eax: (addr handle cell) <- get right, left
 685   var second/eax: (addr cell) <- lookup *second-ah
 686   var second-type/edx: (addr int) <- get second, type
 687   compare *second-type, 1/number
 688   {
 689     break-if-=
 690     error trace, "second arg for - is not a number"
 691     return
 692   }
 693   var second-value/edx: (addr float) <- get second, number-data
 694   # subtract
 695   var result/xmm0: float <- copy *first-value
 696   result <- subtract *second-value
 697   new-float out, result
 698 }
 699 
 700 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 701   trace-text trace, "eval", "apply *"
 702   var args-ah/eax: (addr handle cell) <- copy _args-ah
 703   var _args/eax: (addr cell) <- lookup *args-ah
 704   var args/esi: (addr cell) <- copy _args
 705   # TODO: check that args is a pair
 706   var empty-args?/eax: boolean <- nil? args
 707   compare empty-args?, 0/false
 708   {
 709     break-if-=
 710     error trace, "* needs 2 args but got 0"
 711     return
 712   }
 713   # args->left->value
 714   var first-ah/eax: (addr handle cell) <- get args, left
 715   var first/eax: (addr cell) <- lookup *first-ah
 716   var first-type/ecx: (addr int) <- get first, type
 717   compare *first-type, 1/number
 718   {
 719     break-if-=
 720     error trace, "first arg for * is not a number"
 721     return
 722   }
 723   var first-value/ecx: (addr float) <- get first, number-data
 724   # args->right->left->value
 725   var right-ah/eax: (addr handle cell) <- get args, right
 726   var right/eax: (addr cell) <- lookup *right-ah
 727   # TODO: check that right is a pair
 728   var second-ah/eax: (addr handle cell) <- get right, left
 729   var second/eax: (addr cell) <- lookup *second-ah
 730   var second-type/edx: (addr int) <- get second, type
 731   compare *second-type, 1/number
 732   {
 733     break-if-=
 734     error trace, "second arg for * is not a number"
 735     return
 736   }
 737   var second-value/edx: (addr float) <- get second, number-data
 738   # multiply
 739   var result/xmm0: float <- copy *first-value
 740   result <- multiply *second-value
 741   new-float out, result
 742 }
 743 
 744 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 745   trace-text trace, "eval", "apply /"
 746   var args-ah/eax: (addr handle cell) <- copy _args-ah
 747   var _args/eax: (addr cell) <- lookup *args-ah
 748   var args/esi: (addr cell) <- copy _args
 749   # TODO: check that args is a pair
 750   var empty-args?/eax: boolean <- nil? args
 751   compare empty-args?, 0/false
 752   {
 753     break-if-=
 754     error trace, "/ needs 2 args but got 0"
 755     return
 756   }
 757   # args->left->value
 758   var first-ah/eax: (addr handle cell) <- get args, left
 759   var first/eax: (addr cell) <- lookup *first-ah
 760   var first-type/ecx: (addr int) <- get first, type
 761   compare *first-type, 1/number
 762   {
 763     break-if-=
 764     error trace, "first arg for / is not a number"
 765     return
 766   }
 767   var first-value/ecx: (addr float) <- get first, number-data
 768   # args->right->left->value
 769   var right-ah/eax: (addr handle cell) <- get args, right
 770   var right/eax: (addr cell) <- lookup *right-ah
 771   # TODO: check that right is a pair
 772   var second-ah/eax: (addr handle cell) <- get right, left
 773   var second/eax: (addr cell) <- lookup *second-ah
 774   var second-type/edx: (addr int) <- get second, type
 775   compare *second-type, 1/number
 776   {
 777     break-if-=
 778     error trace, "second arg for / is not a number"
 779     return
 780   }
 781   var second-value/edx: (addr float) <- get second, number-data
 782   # divide
 783   var result/xmm0: float <- copy *first-value
 784   result <- divide *second-value
 785   new-float out, result
 786 }
 787 
 788 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 789   trace-text trace, "eval", "apply sqrt"
 790   var args-ah/eax: (addr handle cell) <- copy _args-ah
 791   var _args/eax: (addr cell) <- lookup *args-ah
 792   var args/esi: (addr cell) <- copy _args
 793   # TODO: check that args is a pair
 794   var empty-args?/eax: boolean <- nil? args
 795   compare empty-args?, 0/false
 796   {
 797     break-if-=
 798     error trace, "sqrt needs 1 args but got 0"
 799     return
 800   }
 801   # args->left->value
 802   var first-ah/eax: (addr handle cell) <- get args, left
 803   var first/eax: (addr cell) <- lookup *first-ah
 804   var first-type/ecx: (addr int) <- get first, type
 805   compare *first-type, 1/number
 806   {
 807     break-if-=
 808     error trace, "arg for sqrt is not a number"
 809     return
 810   }
 811   var first-value/ecx: (addr float) <- get first, number-data
 812   # square-root
 813   var result/xmm0: float <- square-root *first-value
 814   new-float out, result
 815 }
 816 
 817 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 818   trace-text trace, "eval", "apply abs"
 819   var args-ah/eax: (addr handle cell) <- copy _args-ah
 820   var _args/eax: (addr cell) <- lookup *args-ah
 821   var args/esi: (addr cell) <- copy _args
 822   # TODO: check that args is a pair
 823   var empty-args?/eax: boolean <- nil? args
 824   compare empty-args?, 0/false
 825   {
 826     break-if-=
 827     error trace, "abs needs 1 args but got 0"
 828     return
 829   }
 830   # args->left->value
 831   var first-ah/eax: (addr handle cell) <- get args, left
 832   var first/eax: (addr cell) <- lookup *first-ah
 833   var first-type/ecx: (addr int) <- get first, type
 834   compare *first-type, 1/number
 835   {
 836     break-if-=
 837     error trace, "arg for abs is not a number"
 838     return
 839   }
 840   var first-value/ecx: (addr float) <- get first, number-data
 841   #
 842   var result/xmm0: float <- copy *first-value
 843   var zero: float
 844   compare result, zero
 845   {
 846     break-if-float>=
 847     var neg1/eax: int <- copy -1
 848     var neg1-f/xmm1: float <- convert neg1
 849     result <- multiply neg1-f
 850   }
 851   new-float out, result
 852 }
 853 
 854 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 855   trace-text trace, "eval", "apply sgn"
 856   var args-ah/eax: (addr handle cell) <- copy _args-ah
 857   var _args/eax: (addr cell) <- lookup *args-ah
 858   var args/esi: (addr cell) <- copy _args
 859   # TODO: check that args is a pair
 860   var empty-args?/eax: boolean <- nil? args
 861   compare empty-args?, 0/false
 862   {
 863     break-if-=
 864     error trace, "sgn needs 1 args but got 0"
 865     return
 866   }
 867   # args->left->value
 868   var first-ah/eax: (addr handle cell) <- get args, left
 869   var first/eax: (addr cell) <- lookup *first-ah
 870   var first-type/ecx: (addr int) <- get first, type
 871   compare *first-type, 1/number
 872   {
 873     break-if-=
 874     error trace, "arg for sgn is not a number"
 875     return
 876   }
 877   var first-value/ecx: (addr float) <- get first, number-data
 878   #
 879   var result/xmm0: float <- copy *first-value
 880   var zero: float
 881   $apply-sgn:core: {
 882     compare result, zero
 883     break-if-=
 884     {
 885       break-if-float>
 886       var neg1/eax: int <- copy -1
 887       result <- convert neg1
 888       break $apply-sgn:core
 889     }
 890     {
 891       break-if-float<
 892       var one/eax: int <- copy 1
 893       result <- convert one
 894       break $apply-sgn:core
 895     }
 896   }
 897   new-float out, result
 898 }
 899 
 900 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 901   trace-text trace, "eval", "apply car"
 902   var args-ah/eax: (addr handle cell) <- copy _args-ah
 903   var _args/eax: (addr cell) <- lookup *args-ah
 904   var args/esi: (addr cell) <- copy _args
 905   # TODO: check that args is a pair
 906   var empty-args?/eax: boolean <- nil? args
 907   compare empty-args?, 0/false
 908   {
 909     break-if-=
 910     error trace, "car needs 1 args but got 0"
 911     return
 912   }
 913   # args->left
 914   var first-ah/eax: (addr handle cell) <- get args, left
 915   var first/eax: (addr cell) <- lookup *first-ah
 916   var first-type/ecx: (addr int) <- get first, type
 917   compare *first-type, 0/pair
 918   {
 919     break-if-=
 920     error trace, "arg for car is not a pair"
 921     return
 922   }
 923   # car
 924   var result/eax: (addr handle cell) <- get first, left
 925   copy-object result, out
 926 }
 927 
 928 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 929   trace-text trace, "eval", "apply cdr"
 930   var args-ah/eax: (addr handle cell) <- copy _args-ah
 931   var _args/eax: (addr cell) <- lookup *args-ah
 932   var args/esi: (addr cell) <- copy _args
 933   # TODO: check that args is a pair
 934   var empty-args?/eax: boolean <- nil? args
 935   compare empty-args?, 0/false
 936   {
 937     break-if-=
 938     error trace, "cdr needs 1 args but got 0"
 939     return
 940   }
 941   # args->left
 942   var first-ah/eax: (addr handle cell) <- get args, left
 943   var first/eax: (addr cell) <- lookup *first-ah
 944   var first-type/ecx: (addr int) <- get first, type
 945   compare *first-type, 0/pair
 946   {
 947     break-if-=
 948     error trace, "arg for cdr is not a pair"
 949     return
 950   }
 951   # cdr
 952   var result/eax: (addr handle cell) <- get first, right
 953   copy-object result, out
 954 }
 955 
 956 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 957   trace-text trace, "eval", "apply cons"
 958   var args-ah/eax: (addr handle cell) <- copy _args-ah
 959   var _args/eax: (addr cell) <- lookup *args-ah
 960   var args/esi: (addr cell) <- copy _args
 961   # TODO: check that args is a pair
 962   var empty-args?/eax: boolean <- nil? args
 963   compare empty-args?, 0/false
 964   {
 965     break-if-=
 966     error trace, "cons needs 2 args but got 0"
 967     return
 968   }
 969   # args->left
 970   var first-ah/ecx: (addr handle cell) <- get args, left
 971   # args->right->left
 972   var right-ah/eax: (addr handle cell) <- get args, right
 973   var right/eax: (addr cell) <- lookup *right-ah
 974   # TODO: check that right is a pair
 975   var second-ah/eax: (addr handle cell) <- get right, left
 976   # cons
 977   new-pair out, *first-ah, *second-ah
 978 }
 979 
 980 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 981   trace-text trace, "eval", "apply '='"
 982   var args-ah/eax: (addr handle cell) <- copy _args-ah
 983   var _args/eax: (addr cell) <- lookup *args-ah
 984   var args/esi: (addr cell) <- copy _args
 985   # TODO: check that args is a pair
 986   var empty-args?/eax: boolean <- nil? args
 987   compare empty-args?, 0/false
 988   {
 989     break-if-=
 990     error trace, "'=' needs 2 args but got 0"
 991     return
 992   }
 993   # args->left
 994   var first-ah/ecx: (addr handle cell) <- get args, left
 995   # args->right->left
 996   var right-ah/eax: (addr handle cell) <- get args, right
 997   var right/eax: (addr cell) <- lookup *right-ah
 998   # TODO: check that right is a pair
 999   var second-ah/edx: (addr handle cell) <- get right, left
1000   # compare
1001   var _first/eax: (addr cell) <- lookup *first-ah
1002   var first/ecx: (addr cell) <- copy _first
1003   var second/eax: (addr cell) <- lookup *second-ah
1004   var match?/eax: boolean <- cell-isomorphic? first, second, trace
1005   compare match?, 0/false
1006   {
1007     break-if-!=
1008     nil out
1009     return
1010   }
1011   new-integer out, 1/true
1012 }
1013 
1014 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1015   trace-text trace, "eval", "apply '<'"
1016   var args-ah/eax: (addr handle cell) <- copy _args-ah
1017   var _args/eax: (addr cell) <- lookup *args-ah
1018   var args/esi: (addr cell) <- copy _args
1019   # TODO: check that args is a pair
1020   var empty-args?/eax: boolean <- nil? args
1021   compare empty-args?, 0/false
1022   {
1023     break-if-=
1024     error trace, "'<' needs 2 args but got 0"
1025     return
1026   }
1027   # args->left
1028   var first-ah/ecx: (addr handle cell) <- get args, left
1029   # args->right->left
1030   var right-ah/eax: (addr handle cell) <- get args, right
1031   var right/eax: (addr cell) <- lookup *right-ah
1032   # TODO: check that right is a pair
1033   var second-ah/edx: (addr handle cell) <- get right, left
1034   # compare
1035   var _first/eax: (addr cell) <- lookup *first-ah
1036   var first/ecx: (addr cell) <- copy _first
1037   var first-type/eax: (addr int) <- get first, type
1038   compare *first-type, 1/number
1039   {
1040     break-if-=
1041     error trace, "first arg for '<' is not a number"
1042     return
1043   }
1044   var first-value/ecx: (addr float) <- get first, number-data
1045   var first-float/xmm0: float <- copy *first-value
1046   var second/eax: (addr cell) <- lookup *second-ah
1047   var second-type/edx: (addr int) <- get second, type
1048   compare *second-type, 1/number
1049   {
1050     break-if-=
1051     error trace, "first arg for '<' is not a number"
1052     return
1053   }
1054   var second-value/eax: (addr float) <- get second, number-data
1055   compare first-float, *second-value
1056   {
1057     break-if-float<
1058     nil out
1059     return
1060   }
1061   new-integer out, 1/true
1062 }
1063 
1064 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1065   trace-text trace, "eval", "apply '>'"
1066   var args-ah/eax: (addr handle cell) <- copy _args-ah
1067   var _args/eax: (addr cell) <- lookup *args-ah
1068   var args/esi: (addr cell) <- copy _args
1069   # TODO: check that args is a pair
1070   var empty-args?/eax: boolean <- nil? args
1071   compare empty-args?, 0/false
1072   {
1073     break-if-=
1074     error trace, "'>' needs 2 args but got 0"
1075     return
1076   }
1077   # args->left
1078   var first-ah/ecx: (addr handle cell) <- get args, left
1079   # args->right->left
1080   var right-ah/eax: (addr handle cell) <- get args, right
1081   var right/eax: (addr cell) <- lookup *right-ah
1082   # TODO: check that right is a pair
1083   var second-ah/edx: (addr handle cell) <- get right, left
1084   # compare
1085   var _first/eax: (addr cell) <- lookup *first-ah
1086   var first/ecx: (addr cell) <- copy _first
1087   var first-type/eax: (addr int) <- get first, type
1088   compare *first-type, 1/number
1089   {
1090     break-if-=
1091     error trace, "first arg for '>' is not a number"
1092     return
1093   }
1094   var first-value/ecx: (addr float) <- get first, number-data
1095   var first-float/xmm0: float <- copy *first-value
1096   var second/eax: (addr cell) <- lookup *second-ah
1097   var second-type/edx: (addr int) <- get second, type
1098   compare *second-type, 1/number
1099   {
1100     break-if-=
1101     error trace, "first arg for '>' is not a number"
1102     return
1103   }
1104   var second-value/eax: (addr float) <- get second, number-data
1105   compare first-float, *second-value
1106   {
1107     break-if-float>
1108     nil out
1109     return
1110   }
1111   new-integer out, 1/true
1112 }
1113 
1114 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1115   trace-text trace, "eval", "apply '<='"
1116   var args-ah/eax: (addr handle cell) <- copy _args-ah
1117   var _args/eax: (addr cell) <- lookup *args-ah
1118   var args/esi: (addr cell) <- copy _args
1119   # TODO: check that args is a pair
1120   var empty-args?/eax: boolean <- nil? args
1121   compare empty-args?, 0/false
1122   {
1123     break-if-=
1124     error trace, "'<=' needs 2 args but got 0"
1125     return
1126   }
1127   # args->left
1128   var first-ah/ecx: (addr handle cell) <- get args, left
1129   # args->right->left
1130   var right-ah/eax: (addr handle cell) <- get args, right
1131   var right/eax: (addr cell) <- lookup *right-ah
1132   # TODO: check that right is a pair
1133   var second-ah/edx: (addr handle cell) <- get right, left
1134   # compare
1135   var _first/eax: (addr cell) <- lookup *first-ah
1136   var first/ecx: (addr cell) <- copy _first
1137   var first-type/eax: (addr int) <- get first, type
1138   compare *first-type, 1/number
1139   {
1140     break-if-=
1141     error trace, "first arg for '<=' is not a number"
1142     return
1143   }
1144   var first-value/ecx: (addr float) <- get first, number-data
1145   var first-float/xmm0: float <- copy *first-value
1146   var second/eax: (addr cell) <- lookup *second-ah
1147   var second-type/edx: (addr int) <- get second, type
1148   compare *second-type, 1/number
1149   {
1150     break-if-=
1151     error trace, "first arg for '<=' is not a number"
1152     return
1153   }
1154   var second-value/eax: (addr float) <- get second, number-data
1155   compare first-float, *second-value
1156   {
1157     break-if-float<=
1158     nil out
1159     return
1160   }
1161   new-integer out, 1/true
1162 }
1163 
1164 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1165   trace-text trace, "eval", "apply '>='"
1166   var args-ah/eax: (addr handle cell) <- copy _args-ah
1167   var _args/eax: (addr cell) <- lookup *args-ah
1168   var args/esi: (addr cell) <- copy _args
1169   # TODO: check that args is a pair
1170   var empty-args?/eax: boolean <- nil? args
1171   compare empty-args?, 0/false
1172   {
1173     break-if-=
1174     error trace, "'>=' needs 2 args but got 0"
1175     return
1176   }
1177   # args->left
1178   var first-ah/ecx: (addr handle cell) <- get args, left
1179   # args->right->left
1180   var right-ah/eax: (addr handle cell) <- get args, right
1181   var right/eax: (addr cell) <- lookup *right-ah
1182   # TODO: check that right is a pair
1183   var second-ah/edx: (addr handle cell) <- get right, left
1184   # compare
1185   var _first/eax: (addr cell) <- lookup *first-ah
1186   var first/ecx: (addr cell) <- copy _first
1187   var first-type/eax: (addr int) <- get first, type
1188   compare *first-type, 1/number
1189   {
1190     break-if-=
1191     error trace, "first arg for '>=' is not a number"
1192     return
1193   }
1194   var first-value/ecx: (addr float) <- get first, number-data
1195   var first-float/xmm0: float <- copy *first-value
1196   var second/eax: (addr cell) <- lookup *second-ah
1197   var second-type/edx: (addr int) <- get second, type
1198   compare *second-type, 1/number
1199   {
1200     break-if-=
1201     error trace, "first arg for '>=' is not a number"
1202     return
1203   }
1204   var second-value/eax: (addr float) <- get second, number-data
1205   compare first-float, *second-value
1206   {
1207     break-if-float>=
1208     nil out
1209     return
1210   }
1211   new-integer out, 1/true
1212 }
1213 
1214 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1215   trace-text trace, "eval", "apply print"
1216   var args-ah/eax: (addr handle cell) <- copy _args-ah
1217   var _args/eax: (addr cell) <- lookup *args-ah
1218   var args/esi: (addr cell) <- copy _args
1219   # TODO: check that args is a pair
1220   var empty-args?/eax: boolean <- nil? args
1221   compare empty-args?, 0/false
1222   {
1223     break-if-=
1224     error trace, "print needs 2 args but got 0"
1225     return
1226   }
1227   # screen = args->left
1228   var first-ah/eax: (addr handle cell) <- get args, left
1229   var first/eax: (addr cell) <- lookup *first-ah
1230   var first-type/ecx: (addr int) <- get first, type
1231   compare *first-type, 5/screen
1232   {
1233     break-if-=
1234     error trace, "first arg for 'print' is not a screen"
1235     return
1236   }
1237   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1238   var _screen/eax: (addr screen) <- lookup *screen-ah
1239   var screen/ecx: (addr screen) <- copy _screen
1240   # args->right->left
1241   var right-ah/eax: (addr handle cell) <- get args, right
1242   var right/eax: (addr cell) <- lookup *right-ah
1243   # TODO: check that right is a pair
1244   var second-ah/eax: (addr handle cell) <- get right, left
1245   var stream-storage: (stream byte 0x100)
1246   var stream/edi: (addr stream byte) <- address stream-storage
1247   print-cell second-ah, stream, trace
1248   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
1249   # return what was printed
1250   copy-object second-ah, out
1251 }
1252 
1253 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1254   trace-text trace, "eval", "apply clear"
1255   var args-ah/eax: (addr handle cell) <- copy _args-ah
1256   var _args/eax: (addr cell) <- lookup *args-ah
1257   var args/esi: (addr cell) <- copy _args
1258   # TODO: check that args is a pair
1259   var empty-args?/eax: boolean <- nil? args
1260   compare empty-args?, 0/false
1261   {
1262     break-if-=
1263     error trace, "'clear' needs 1 arg but got 0"
1264     return
1265   }
1266   # screen = args->left
1267   var first-ah/eax: (addr handle cell) <- get args, left
1268   var first/eax: (addr cell) <- lookup *first-ah
1269   var first-type/ecx: (addr int) <- get first, type
1270   compare *first-type, 5/screen
1271   {
1272     break-if-=
1273     error trace, "first arg for 'clear' is not a screen"
1274     return
1275   }
1276   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1277   var _screen/eax: (addr screen) <- lookup *screen-ah
1278   var screen/ecx: (addr screen) <- copy _screen
1279   #
1280   clear-screen screen
1281 }
1282 
1283 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1284   trace-text trace, "eval", "apply up"
1285   var args-ah/eax: (addr handle cell) <- copy _args-ah
1286   var _args/eax: (addr cell) <- lookup *args-ah
1287   var args/esi: (addr cell) <- copy _args
1288   # TODO: check that args is a pair
1289   var empty-args?/eax: boolean <- nil? args
1290   compare empty-args?, 0/false
1291   {
1292     break-if-=
1293     error trace, "'up' needs 1 arg but got 0"
1294     return
1295   }
1296   # screen = args->left
1297   var first-ah/eax: (addr handle cell) <- get args, left
1298   var first/eax: (addr cell) <- lookup *first-ah
1299   var first-type/ecx: (addr int) <- get first, type
1300   compare *first-type, 5/screen
1301   {
1302     break-if-=
1303     error trace, "first arg for 'up' is not a screen"
1304     return
1305   }
1306   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1307   var _screen/eax: (addr screen) <- lookup *screen-ah
1308   var screen/ecx: (addr screen) <- copy _screen
1309   #
1310   move-cursor-up screen
1311 }
1312 
1313 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1314   trace-text trace, "eval", "apply 'down'"
1315   var args-ah/eax: (addr handle cell) <- copy _args-ah
1316   var _args/eax: (addr cell) <- lookup *args-ah
1317   var args/esi: (addr cell) <- copy _args
1318   # TODO: check that args is a pair
1319   var empty-args?/eax: boolean <- nil? args
1320   compare empty-args?, 0/false
1321   {
1322     break-if-=
1323     error trace, "'down' needs 1 arg but got 0"
1324     return
1325   }
1326   # screen = args->left
1327   var first-ah/eax: (addr handle cell) <- get args, left
1328   var first/eax: (addr cell) <- lookup *first-ah
1329   var first-type/ecx: (addr int) <- get first, type
1330   compare *first-type, 5/screen
1331   {
1332     break-if-=
1333     error trace, "first arg for 'down' is not a screen"
1334     return
1335   }
1336   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1337   var _screen/eax: (addr screen) <- lookup *screen-ah
1338   var screen/ecx: (addr screen) <- copy _screen
1339   #
1340   move-cursor-down screen
1341 }
1342 
1343 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1344   trace-text trace, "eval", "apply 'left'"
1345   var args-ah/eax: (addr handle cell) <- copy _args-ah
1346   var _args/eax: (addr cell) <- lookup *args-ah
1347   var args/esi: (addr cell) <- copy _args
1348   # TODO: check that args is a pair
1349   var empty-args?/eax: boolean <- nil? args
1350   compare empty-args?, 0/false
1351   {
1352     break-if-=
1353     error trace, "'left' needs 1 arg but got 0"
1354     return
1355   }
1356   # screen = args->left
1357   var first-ah/eax: (addr handle cell) <- get args, left
1358   var first/eax: (addr cell) <- lookup *first-ah
1359   var first-type/ecx: (addr int) <- get first, type
1360   compare *first-type, 5/screen
1361   {
1362     break-if-=
1363     error trace, "first arg for 'left' is not a screen"
1364     return
1365   }
1366   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1367   var _screen/eax: (addr screen) <- lookup *screen-ah
1368   var screen/ecx: (addr screen) <- copy _screen
1369   #
1370   move-cursor-left screen
1371 }
1372 
1373 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1374   trace-text trace, "eval", "apply 'right'"
1375   var args-ah/eax: (addr handle cell) <- copy _args-ah
1376   var _args/eax: (addr cell) <- lookup *args-ah
1377   var args/esi: (addr cell) <- copy _args
1378   # TODO: check that args is a pair
1379   var empty-args?/eax: boolean <- nil? args
1380   compare empty-args?, 0/false
1381   {
1382     break-if-=
1383     error trace, "'right' needs 1 arg but got 0"
1384     return
1385   }
1386   # screen = args->left
1387   var first-ah/eax: (addr handle cell) <- get args, left
1388   var first/eax: (addr cell) <- lookup *first-ah
1389   var first-type/ecx: (addr int) <- get first, type
1390   compare *first-type, 5/screen
1391   {
1392     break-if-=
1393     error trace, "first arg for 'right' is not a screen"
1394     return
1395   }
1396   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1397   var _screen/eax: (addr screen) <- lookup *screen-ah
1398   var screen/ecx: (addr screen) <- copy _screen
1399   #
1400   move-cursor-right screen
1401 }
1402 
1403 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1404   trace-text trace, "eval", "apply 'cr'"
1405   var args-ah/eax: (addr handle cell) <- copy _args-ah
1406   var _args/eax: (addr cell) <- lookup *args-ah
1407   var args/esi: (addr cell) <- copy _args
1408   # TODO: check that args is a pair
1409   var empty-args?/eax: boolean <- nil? args
1410   compare empty-args?, 0/false
1411   {
1412     break-if-=
1413     error trace, "'cr' needs 1 arg but got 0"
1414     return
1415   }
1416   # screen = args->left
1417   var first-ah/eax: (addr handle cell) <- get args, left
1418   var first/eax: (addr cell) <- lookup *first-ah
1419   var first-type/ecx: (addr int) <- get first, type
1420   compare *first-type, 5/screen
1421   {
1422     break-if-=
1423     error trace, "first arg for 'cr' is not a screen"
1424     return
1425   }
1426   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1427   var _screen/eax: (addr screen) <- lookup *screen-ah
1428   var screen/ecx: (addr screen) <- copy _screen
1429   #
1430   move-cursor-to-left-margin-of-next-line screen
1431 }
1432 
1433 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1434   trace-text trace, "eval", "apply pixel"
1435   var args-ah/eax: (addr handle cell) <- copy _args-ah
1436   var _args/eax: (addr cell) <- lookup *args-ah
1437   var args/esi: (addr cell) <- copy _args
1438   # TODO: check that args is a pair
1439   var empty-args?/eax: boolean <- nil? args
1440   compare empty-args?, 0/false
1441   {
1442     break-if-=
1443     error trace, "pixel needs 4 args but got 0"
1444     return
1445   }
1446   # screen = args->left
1447   var first-ah/eax: (addr handle cell) <- get args, left
1448   var first/eax: (addr cell) <- lookup *first-ah
1449   var first-type/ecx: (addr int) <- get first, type
1450   compare *first-type, 5/screen
1451   {
1452     break-if-=
1453     error trace, "first arg for 'pixel' is not a screen"
1454     return
1455   }
1456   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1457   var _screen/eax: (addr screen) <- lookup *screen-ah
1458   var screen/edi: (addr screen) <- copy _screen
1459   # x = args->right->left->value
1460   var rest-ah/eax: (addr handle cell) <- get args, right
1461   var _rest/eax: (addr cell) <- lookup *rest-ah
1462   var rest/esi: (addr cell) <- copy _rest
1463   # TODO: check that rest is a pair
1464   var second-ah/eax: (addr handle cell) <- get rest, left
1465   var second/eax: (addr cell) <- lookup *second-ah
1466   var second-type/ecx: (addr int) <- get second, type
1467   compare *second-type, 1/number
1468   {
1469     break-if-=
1470     error trace, "second arg for 'pixel' is not an int (x coordinate)"
1471     return
1472   }
1473   var second-value/eax: (addr float) <- get second, number-data
1474   var x/edx: int <- convert *second-value
1475   # y = rest->right->left->value
1476   var rest-ah/eax: (addr handle cell) <- get rest, right
1477   var _rest/eax: (addr cell) <- lookup *rest-ah
1478   rest <- copy _rest
1479   # TODO: check that rest is a pair
1480   var third-ah/eax: (addr handle cell) <- get rest, left
1481   var third/eax: (addr cell) <- lookup *third-ah
1482   var third-type/ecx: (addr int) <- get third, type
1483   compare *third-type, 1/number
1484   {
1485     break-if-=
1486     error trace, "third arg for 'pixel' is not an int (y coordinate)"
1487     return
1488   }
1489   var third-value/eax: (addr float) <- get third, number-data
1490   var y/ebx: int <- convert *third-value
1491   # color = rest->right->left->value
1492   var rest-ah/eax: (addr handle cell) <- get rest, right
1493   var _rest/eax: (addr cell) <- lookup *rest-ah
1494   rest <- copy _rest
1495   # TODO: check that rest is a pair
1496   var fourth-ah/eax: (addr handle cell) <- get rest, left
1497   var fourth/eax: (addr cell) <- lookup *fourth-ah
1498   var fourth-type/ecx: (addr int) <- get fourth, type
1499   compare *fourth-type, 1/number
1500   {
1501     break-if-=
1502     error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
1503     return
1504   }
1505   var fourth-value/eax: (addr float) <- get fourth, number-data
1506   var color/eax: int <- convert *fourth-value
1507   pixel screen, x, y, color
1508   # return nothing
1509 }
1510 
1511 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1512   trace-text trace, "eval", "apply key"
1513   var args-ah/eax: (addr handle cell) <- copy _args-ah
1514   var _args/eax: (addr cell) <- lookup *args-ah
1515   var args/esi: (addr cell) <- copy _args
1516   # TODO: check that args is a pair
1517   var empty-args?/eax: boolean <- nil? args
1518   compare empty-args?, 0/false
1519   {
1520     break-if-=
1521     error trace, "key needs 1 arg but got 0"
1522     return
1523   }
1524   # keyboard = args->left
1525   var first-ah/eax: (addr handle cell) <- get args, left
1526   var first/eax: (addr cell) <- lookup *first-ah
1527   var first-type/ecx: (addr int) <- get first, type
1528   compare *first-type, 6/keyboard
1529   {
1530     break-if-=
1531     error trace, "first arg for 'key' is not a keyboard"
1532     return
1533   }
1534   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
1535   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
1536   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
1537   var result/eax: int <- wait-for-key keyboard
1538   # return key typed
1539   new-integer out, result
1540 }
1541 
1542 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
1543   # if keyboard is 0, use real keyboard
1544   {
1545     compare keyboard, 0/real-keyboard
1546     break-if-!=
1547     var key/eax: byte <- read-key 0/real-keyboard
1548     var result/eax: int <- copy key
1549     return result
1550   }
1551   # otherwise read from fake keyboard
1552   var g/eax: grapheme <- read-from-gap-buffer keyboard
1553   var result/eax: int <- copy g
1554   return result
1555 }
1556 
1557 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1558   trace-text trace, "eval", "apply stream"
1559   allocate-stream out
1560 }
1561 
1562 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1563   trace-text trace, "eval", "apply write"
1564   var args-ah/eax: (addr handle cell) <- copy _args-ah
1565   var _args/eax: (addr cell) <- lookup *args-ah
1566   var args/esi: (addr cell) <- copy _args
1567   # TODO: check that args is a pair
1568   var empty-args?/eax: boolean <- nil? args
1569   compare empty-args?, 0/false
1570   {
1571     break-if-=
1572     error trace, "write needs 2 args but got 0"
1573     return
1574   }
1575   # stream = args->left
1576   var first-ah/edx: (addr handle cell) <- get args, left
1577   var first/eax: (addr cell) <- lookup *first-ah
1578   var first-type/ecx: (addr int) <- get first, type
1579   compare *first-type, 3/stream
1580   {
1581     break-if-=
1582     error trace, "first arg for 'write' is not a stream"
1583     return
1584   }
1585   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
1586   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
1587   var stream-data/ebx: (addr stream byte) <- copy _stream-data
1588   # args->right->left
1589   var right-ah/eax: (addr handle cell) <- get args, right
1590   var right/eax: (addr cell) <- lookup *right-ah
1591   # TODO: check that right is a pair
1592   var second-ah/eax: (addr handle cell) <- get right, left
1593   var second/eax: (addr cell) <- lookup *second-ah
1594   var second-type/ecx: (addr int) <- get second, type
1595   compare *second-type, 1/number
1596   {
1597     break-if-=
1598     error trace, "second arg for stream is not a number/grapheme"
1599     return
1600   }
1601   var second-value/eax: (addr float) <- get second, number-data
1602   var x-float/xmm0: float <- copy *second-value
1603   var x/eax: int <- convert x-float
1604   var x-grapheme/eax: grapheme <- copy x
1605   write-grapheme stream-data, x-grapheme
1606   # return the stream
1607   copy-object first-ah, out
1608 }
1609 
1610 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1611   trace-text trace, "eval", "apply lines"
1612   var args-ah/eax: (addr handle cell) <- copy _args-ah
1613   var _args/eax: (addr cell) <- lookup *args-ah
1614   var args/esi: (addr cell) <- copy _args
1615   # TODO: check that args is a pair
1616   var empty-args?/eax: boolean <- nil? args
1617   compare empty-args?, 0/false
1618   {
1619     break-if-=
1620     error trace, "lines needs 1 arg but got 0"
1621     return
1622   }
1623   # screen = args->left
1624   var first-ah/eax: (addr handle cell) <- get args, left
1625   var first/eax: (addr cell) <- lookup *first-ah
1626   var first-type/ecx: (addr int) <- get first, type
1627   compare *first-type, 5/screen
1628   {
1629     break-if-=
1630     error trace, "first arg for 'lines' is not a screen"
1631     return
1632   }
1633   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1634   var _screen/eax: (addr screen) <- lookup *screen-ah
1635   var screen/edx: (addr screen) <- copy _screen
1636   # compute dimensions
1637   var dummy/eax: int <- copy 0
1638   var height/ecx: int <- copy 0
1639   dummy, height <- screen-size screen
1640   var result/xmm0: float <- convert height
1641   new-float out, result
1642 }
1643 
1644 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1645   abort "aa"
1646 }
1647 
1648 fn apply-life _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1649   life
1650 }
1651 
1652 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1653   trace-text trace, "eval", "apply columns"
1654   var args-ah/eax: (addr handle cell) <- copy _args-ah
1655   var _args/eax: (addr cell) <- lookup *args-ah
1656   var args/esi: (addr cell) <- copy _args
1657   # TODO: check that args is a pair
1658   var empty-args?/eax: boolean <- nil? args
1659   compare empty-args?, 0/false
1660   {
1661     break-if-=
1662     error trace, "columns needs 1 arg but got 0"
1663     return
1664   }
1665   # screen = args->left
1666   var first-ah/eax: (addr handle cell) <- get args, left
1667   var first/eax: (addr cell) <- lookup *first-ah
1668   var first-type/ecx: (addr int) <- get first, type
1669   compare *first-type, 5/screen
1670   {
1671     break-if-=
1672     error trace, "first arg for 'columns' is not a screen"
1673     return
1674   }
1675   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1676   var _screen/eax: (addr screen) <- lookup *screen-ah
1677   var screen/edx: (addr screen) <- copy _screen
1678   # compute dimensions
1679   var width/eax: int <- copy 0
1680   var dummy/ecx: int <- copy 0
1681   width, dummy <- screen-size screen
1682   var result/xmm0: float <- convert width
1683   new-float out, result
1684 }
1685 
1686 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1687   trace-text trace, "eval", "apply width"
1688   var args-ah/eax: (addr handle cell) <- copy _args-ah
1689   var _args/eax: (addr cell) <- lookup *args-ah
1690   var args/esi: (addr cell) <- copy _args
1691   # TODO: check that args is a pair
1692   var empty-args?/eax: boolean <- nil? args
1693   compare empty-args?, 0/false
1694   {
1695     break-if-=
1696     error trace, "width needs 1 arg but got 0"
1697     return
1698   }
1699   # screen = args->left
1700   var first-ah/eax: (addr handle cell) <- get args, left
1701   var first/eax: (addr cell) <- lookup *first-ah
1702   var first-type/ecx: (addr int) <- get first, type
1703   compare *first-type, 5/screen
1704   {
1705     break-if-=
1706     error trace, "first arg for 'width' is not a screen"
1707     return
1708   }
1709   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1710   var _screen/eax: (addr screen) <- lookup *screen-ah
1711   var screen/edx: (addr screen) <- copy _screen
1712   # compute dimensions
1713   var width/eax: int <- copy 0
1714   var dummy/ecx: int <- copy 0
1715   width, dummy <- screen-size screen
1716   width <- shift-left 3/log2-font-width
1717   var result/xmm0: float <- convert width
1718   new-float out, result
1719 }
1720 
1721 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1722   trace-text trace, "eval", "apply height"
1723   var args-ah/eax: (addr handle cell) <- copy _args-ah
1724   var _args/eax: (addr cell) <- lookup *args-ah
1725   var args/esi: (addr cell) <- copy _args
1726   # TODO: check that args is a pair
1727   var empty-args?/eax: boolean <- nil? args
1728   compare empty-args?, 0/false
1729   {
1730     break-if-=
1731     error trace, "height needs 1 arg but got 0"
1732     return
1733   }
1734   # screen = args->left
1735   var first-ah/eax: (addr handle cell) <- get args, left
1736   var first/eax: (addr cell) <- lookup *first-ah
1737   var first-type/ecx: (addr int) <- get first, type
1738   compare *first-type, 5/screen
1739   {
1740     break-if-=
1741     error trace, "first arg for 'height' is not a screen"
1742     return
1743   }
1744   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1745   var _screen/eax: (addr screen) <- lookup *screen-ah
1746   var screen/edx: (addr screen) <- copy _screen
1747   # compute dimensions
1748   var dummy/eax: int <- copy 0
1749   var height/ecx: int <- copy 0
1750   dummy, height <- screen-size screen
1751   height <- shift-left 4/log2-font-height
1752   var result/xmm0: float <- convert height
1753   new-float out, result
1754 }