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), trace: (addr trace) {
 260   var self/esi: (addr global-table) <- copy _self
 261   {
 262     var curr-index/ecx: int <- find-symbol-name-in-globals self, name
 263     compare curr-index, -1/not-found
 264     break-if-=
 265     # otherwise error "global already exists: ", sym
 266     var stream-storage: (stream byte 0x40)
 267     var stream/ecx: (addr stream byte) <- address stream-storage
 268     write stream, "global already exists: "
 269     write stream, name
 270     trace trace, "error", stream
 271     return
 272   }
 273   var final-index-addr/ecx: (addr int) <- get self, final-index
 274   increment *final-index-addr
 275   var curr-index/ecx: int <- copy *final-index-addr
 276   var data-ah/eax: (addr handle array global) <- get self, data
 277   var data/eax: (addr array global) <- lookup *data-ah
 278   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
 279   var curr/esi: (addr global) <- index data, curr-offset
 280   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
 281   copy-array-object name, curr-name-ah
 282   var curr-value-ah/eax: (addr handle cell) <- get curr, value
 283   copy-handle value, curr-value-ah
 284 }
 285 
 286 fn append-global-binding-of-stream _self: (addr global-table), name: (addr stream byte), value: (handle cell) {
 287   var self/esi: (addr global-table) <- copy _self
 288   var final-index-addr/ecx: (addr int) <- get self, final-index
 289   increment *final-index-addr
 290   var curr-index/ecx: int <- copy *final-index-addr
 291   var data-ah/eax: (addr handle array global) <- get self, data
 292   var data/eax: (addr array global) <- lookup *data-ah
 293   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
 294   var curr/esi: (addr global) <- index data, curr-offset
 295   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
 296   rewind-stream name
 297   stream-to-array name, curr-name-ah
 298   var curr-value-ah/eax: (addr handle cell) <- get curr, value
 299   copy-handle value, curr-value-ah
 300 }
 301 
 302 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) {
 303   var sym/eax: (addr cell) <- copy _sym
 304   var sym-name-ah/eax: (addr handle stream byte) <- get sym, text-data
 305   var _sym-name/eax: (addr stream byte) <- lookup *sym-name-ah
 306   var sym-name/edx: (addr stream byte) <- copy _sym-name
 307   var globals/esi: (addr global-table) <- copy _globals
 308   {
 309     compare globals, 0
 310     break-if-=
 311     var curr-index/ecx: int <- find-symbol-in-globals globals, sym-name
 312     compare curr-index, -1/not-found
 313     break-if-=
 314     var global-data-ah/eax: (addr handle array global) <- get globals, data
 315     var global-data/eax: (addr array global) <- lookup *global-data-ah
 316     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
 317     var curr/ebx: (addr global) <- index global-data, curr-offset
 318     var curr-value/eax: (addr handle cell) <- get curr, value
 319     copy-object curr-value, out
 320     return
 321   }
 322   # if sym is "screen" and screen-cell exists, return it
 323   {
 324     var sym-is-screen?/eax: boolean <- stream-data-equal? sym-name, "screen"
 325     compare sym-is-screen?, 0/false
 326     break-if-=
 327     compare screen-cell, 0
 328     break-if-=
 329     copy-object screen-cell, out
 330     return
 331   }
 332   # if sym is "keyboard" and keyboard-cell exists, return it
 333   {
 334     var sym-is-keyboard?/eax: boolean <- stream-data-equal? sym-name, "keyboard"
 335     compare sym-is-keyboard?, 0/false
 336     break-if-=
 337     compare keyboard-cell, 0
 338     break-if-=
 339     copy-object keyboard-cell, out
 340     return
 341   }
 342   # otherwise error "unbound symbol: ", sym
 343   var stream-storage: (stream byte 0x40)
 344   var stream/ecx: (addr stream byte) <- address stream-storage
 345   write stream, "unbound symbol: "
 346   rewind-stream sym-name
 347   write-stream stream, sym-name
 348   trace trace, "error", stream
 349 }
 350 
 351 # return the index in globals containing 'sym'
 352 # or -1 if not found
 353 fn find-symbol-in-globals _globals: (addr global-table), sym-name: (addr stream byte) -> _/ecx: int {
 354   var globals/esi: (addr global-table) <- copy _globals
 355   compare globals, 0
 356   {
 357     break-if-!=
 358     return -1/not-found
 359   }
 360   var global-data-ah/eax: (addr handle array global) <- get globals, data
 361   var global-data/eax: (addr array global) <- lookup *global-data-ah
 362   var final-index/ecx: (addr int) <- get globals, final-index
 363   var curr-index/ecx: int <- copy *final-index
 364   {
 365     compare curr-index, 0
 366     break-if-<
 367     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
 368     var curr/ebx: (addr global) <- index global-data, curr-offset
 369     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
 370     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
 371     var found?/eax: boolean <- stream-data-equal? sym-name, curr-name
 372     compare found?, 0/false
 373     {
 374       break-if-=
 375       return curr-index
 376     }
 377     curr-index <- decrement
 378     loop
 379   }
 380   return -1/not-found
 381 }
 382 
 383 # return the index in globals containing 'sym'
 384 # or -1 if not found
 385 fn find-symbol-name-in-globals _globals: (addr global-table), sym-name: (addr array byte) -> _/ecx: int {
 386   var globals/esi: (addr global-table) <- copy _globals
 387   compare globals, 0
 388   {
 389     break-if-!=
 390     return -1/not-found
 391   }
 392   var global-data-ah/eax: (addr handle array global) <- get globals, data
 393   var global-data/eax: (addr array global) <- lookup *global-data-ah
 394   var final-index/ecx: (addr int) <- get globals, final-index
 395   var curr-index/ecx: int <- copy *final-index
 396   {
 397     compare curr-index, 0
 398     break-if-<
 399     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
 400     var curr/ebx: (addr global) <- index global-data, curr-offset
 401     var curr-name-ah/eax: (addr handle array byte) <- get curr, name
 402     var curr-name/eax: (addr array byte) <- lookup *curr-name-ah
 403     var found?/eax: boolean <- string-equal? sym-name, curr-name
 404     compare found?, 0/false
 405     {
 406       break-if-=
 407       return curr-index
 408     }
 409     curr-index <- decrement
 410     loop
 411   }
 412   return -1/not-found
 413 }
 414 
 415 fn mutate-binding-in-globals name: (addr stream byte), val: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
 416   var globals/esi: (addr global-table) <- copy _globals
 417   {
 418     compare globals, 0
 419     break-if-=
 420     var curr-index/ecx: int <- find-symbol-in-globals globals, name
 421     compare curr-index, -1/not-found
 422     break-if-=
 423     var global-data-ah/eax: (addr handle array global) <- get globals, data
 424     var global-data/eax: (addr array global) <- lookup *global-data-ah
 425     var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
 426     var curr/ebx: (addr global) <- index global-data, curr-offset
 427     var dest/eax: (addr handle cell) <- get curr, value
 428     copy-object val, dest
 429     return
 430   }
 431   # otherwise error "unbound symbol: ", sym
 432   var stream-storage: (stream byte 0x40)
 433   var stream/ecx: (addr stream byte) <- address stream-storage
 434   write stream, "unbound symbol: "
 435   rewind-stream name
 436   write-stream stream, name
 437   trace trace, "error", stream
 438 }
 439 
 440 # a little strange; goes from value to name and selects primitive based on name
 441 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
 442   var f/esi: (addr cell) <- copy _f
 443   var f-index-a/ecx: (addr int) <- get f, index-data
 444   var f-index/ecx: int <- copy *f-index-a
 445   var globals/eax: (addr global-table) <- copy _globals
 446   var global-data-ah/eax: (addr handle array global) <- get globals, data
 447   var global-data/eax: (addr array global) <- lookup *global-data-ah
 448   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
 449   var f-value/ecx: (addr global) <- index global-data, f-offset
 450   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
 451   var f-name/eax: (addr array byte) <- lookup *f-name-ah
 452   {
 453     var is-add?/eax: boolean <- string-equal? f-name, "+"
 454     compare is-add?, 0/false
 455     break-if-=
 456     apply-add args-ah, out, trace
 457     return
 458   }
 459   {
 460     var is-subtract?/eax: boolean <- string-equal? f-name, "-"
 461     compare is-subtract?, 0/false
 462     break-if-=
 463     apply-subtract args-ah, out, trace
 464     return
 465   }
 466   {
 467     var is-multiply?/eax: boolean <- string-equal? f-name, "*"
 468     compare is-multiply?, 0/false
 469     break-if-=
 470     apply-multiply args-ah, out, trace
 471     return
 472   }
 473   {
 474     var is-divide?/eax: boolean <- string-equal? f-name, "/"
 475     compare is-divide?, 0/false
 476     break-if-=
 477     apply-divide args-ah, out, trace
 478     return
 479   }
 480   {
 481     var is-square-root?/eax: boolean <- string-equal? f-name, "sqrt"
 482     compare is-square-root?, 0/false
 483     break-if-=
 484     apply-square-root args-ah, out, trace
 485     return
 486   }
 487   {
 488     var is-abs?/eax: boolean <- string-equal? f-name, "abs"
 489     compare is-abs?, 0/false
 490     break-if-=
 491     apply-abs args-ah, out, trace
 492     return
 493   }
 494   {
 495     var is-sgn?/eax: boolean <- string-equal? f-name, "sgn"
 496     compare is-sgn?, 0/false
 497     break-if-=
 498     apply-sgn args-ah, out, trace
 499     return
 500   }
 501   {
 502     var is-car?/eax: boolean <- string-equal? f-name, "car"
 503     compare is-car?, 0/false
 504     break-if-=
 505     apply-car args-ah, out, trace
 506     return
 507   }
 508   {
 509     var is-cdr?/eax: boolean <- string-equal? f-name, "cdr"
 510     compare is-cdr?, 0/false
 511     break-if-=
 512     apply-cdr args-ah, out, trace
 513     return
 514   }
 515   {
 516     var is-cons?/eax: boolean <- string-equal? f-name, "cons"
 517     compare is-cons?, 0/false
 518     break-if-=
 519     apply-cons args-ah, out, trace
 520     return
 521   }
 522   {
 523     var is-structurally-equal?/eax: boolean <- string-equal? f-name, "="
 524     compare is-structurally-equal?, 0/false
 525     break-if-=
 526     apply-structurally-equal args-ah, out, trace
 527     return
 528   }
 529   {
 530     var is-lesser?/eax: boolean <- string-equal? f-name, "<"
 531     compare is-lesser?, 0/false
 532     break-if-=
 533     apply-< args-ah, out, trace
 534     return
 535   }
 536   {
 537     var is-greater?/eax: boolean <- string-equal? f-name, ">"
 538     compare is-greater?, 0/false
 539     break-if-=
 540     apply-> args-ah, out, trace
 541     return
 542   }
 543   {
 544     var is-lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
 545     compare is-lesser-or-equal?, 0/false
 546     break-if-=
 547     apply-<= args-ah, out, trace
 548     return
 549   }
 550   {
 551     var is-greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
 552     compare is-greater-or-equal?, 0/false
 553     break-if-=
 554     apply->= args-ah, out, trace
 555     return
 556   }
 557   {
 558     var is-print?/eax: boolean <- string-equal? f-name, "print"
 559     compare is-print?, 0/false
 560     break-if-=
 561     apply-print args-ah, out, trace
 562     return
 563   }
 564   {
 565     var is-clear?/eax: boolean <- string-equal? f-name, "clear"
 566     compare is-clear?, 0/false
 567     break-if-=
 568     apply-clear args-ah, out, trace
 569     return
 570   }
 571   {
 572     var is-lines?/eax: boolean <- string-equal? f-name, "lines"
 573     compare is-lines?, 0/false
 574     break-if-=
 575     apply-lines args-ah, out, trace
 576     return
 577   }
 578   {
 579     var is-columns?/eax: boolean <- string-equal? f-name, "columns"
 580     compare is-columns?, 0/false
 581     break-if-=
 582     apply-columns args-ah, out, trace
 583     return
 584   }
 585   {
 586     var is-up?/eax: boolean <- string-equal? f-name, "up"
 587     compare is-up?, 0/false
 588     break-if-=
 589     apply-up args-ah, out, trace
 590     return
 591   }
 592   {
 593     var is-down?/eax: boolean <- string-equal? f-name, "down"
 594     compare is-down?, 0/false
 595     break-if-=
 596     apply-down args-ah, out, trace
 597     return
 598   }
 599   {
 600     var is-left?/eax: boolean <- string-equal? f-name, "left"
 601     compare is-left?, 0/false
 602     break-if-=
 603     apply-left args-ah, out, trace
 604     return
 605   }
 606   {
 607     var is-right?/eax: boolean <- string-equal? f-name, "right"
 608     compare is-right?, 0/false
 609     break-if-=
 610     apply-right args-ah, out, trace
 611     return
 612   }
 613   {
 614     var is-cr?/eax: boolean <- string-equal? f-name, "cr"
 615     compare is-cr?, 0/false
 616     break-if-=
 617     apply-cr args-ah, out, trace
 618     return
 619   }
 620   {
 621     var is-pixel?/eax: boolean <- string-equal? f-name, "pixel"
 622     compare is-pixel?, 0/false
 623     break-if-=
 624     apply-pixel args-ah, out, trace
 625     return
 626   }
 627   {
 628     var is-width?/eax: boolean <- string-equal? f-name, "width"
 629     compare is-width?, 0/false
 630     break-if-=
 631     apply-width args-ah, out, trace
 632     return
 633   }
 634   {
 635     var is-height?/eax: boolean <- string-equal? f-name, "height"
 636     compare is-height?, 0/false
 637     break-if-=
 638     apply-height args-ah, out, trace
 639     return
 640   }
 641   {
 642     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
 643     compare wait-for-key?, 0/false
 644     break-if-=
 645     apply-wait-for-key args-ah, out, trace
 646     return
 647   }
 648   {
 649     var is-stream?/eax: boolean <- string-equal? f-name, "stream"
 650     compare is-stream?, 0/false
 651     break-if-=
 652     apply-stream args-ah, out, trace
 653     return
 654   }
 655   {
 656     var write?/eax: boolean <- string-equal? f-name, "write"
 657     compare write?, 0/false
 658     break-if-=
 659     apply-write args-ah, out, trace
 660     return
 661   }
 662   {
 663     var abort?/eax: boolean <- string-equal? f-name, "abort"
 664     compare abort?, 0/false
 665     break-if-=
 666     apply-abort args-ah, out, trace
 667     return
 668   }
 669   {
 670     var life?/eax: boolean <- string-equal? f-name, "life"
 671     compare life?, 0/false
 672     break-if-=
 673     apply-life args-ah, out, trace
 674     return
 675   }
 676   abort "unknown primitive function"
 677 }
 678 
 679 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 680   trace-text trace, "eval", "apply +"
 681   var args-ah/eax: (addr handle cell) <- copy _args-ah
 682   var _args/eax: (addr cell) <- lookup *args-ah
 683   var args/esi: (addr cell) <- copy _args
 684   # TODO: check that args is a pair
 685   var empty-args?/eax: boolean <- nil? args
 686   compare empty-args?, 0/false
 687   {
 688     break-if-=
 689     error trace, "+ needs 2 args but got 0"
 690     return
 691   }
 692   # args->left->value
 693   var first-ah/eax: (addr handle cell) <- get args, left
 694   var first/eax: (addr cell) <- lookup *first-ah
 695   var first-type/ecx: (addr int) <- get first, type
 696   compare *first-type, 1/number
 697   {
 698     break-if-=
 699     error trace, "first arg for + is not a number"
 700     return
 701   }
 702   var first-value/ecx: (addr float) <- get first, number-data
 703   # args->right->left->value
 704   var right-ah/eax: (addr handle cell) <- get args, right
 705 #?   dump-cell right-ah
 706 #?   abort "aaa"
 707   var right/eax: (addr cell) <- lookup *right-ah
 708   # TODO: check that right is a pair
 709   var second-ah/eax: (addr handle cell) <- get right, left
 710   var second/eax: (addr cell) <- lookup *second-ah
 711   var second-type/edx: (addr int) <- get second, type
 712   compare *second-type, 1/number
 713   {
 714     break-if-=
 715     error trace, "second arg for + is not a number"
 716     return
 717   }
 718   var second-value/edx: (addr float) <- get second, number-data
 719   # add
 720   var result/xmm0: float <- copy *first-value
 721   result <- add *second-value
 722   new-float out, result
 723 }
 724 
 725 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 726   trace-text trace, "eval", "apply -"
 727   var args-ah/eax: (addr handle cell) <- copy _args-ah
 728   var _args/eax: (addr cell) <- lookup *args-ah
 729   var args/esi: (addr cell) <- copy _args
 730   # TODO: check that args is a pair
 731   var empty-args?/eax: boolean <- nil? args
 732   compare empty-args?, 0/false
 733   {
 734     break-if-=
 735     error trace, "- needs 2 args but got 0"
 736     return
 737   }
 738   # args->left->value
 739   var first-ah/eax: (addr handle cell) <- get args, left
 740   var first/eax: (addr cell) <- lookup *first-ah
 741   var first-type/ecx: (addr int) <- get first, type
 742   compare *first-type, 1/number
 743   {
 744     break-if-=
 745     error trace, "first arg for - is not a number"
 746     return
 747   }
 748   var first-value/ecx: (addr float) <- get first, number-data
 749   # args->right->left->value
 750   var right-ah/eax: (addr handle cell) <- get args, right
 751   var right/eax: (addr cell) <- lookup *right-ah
 752   # TODO: check that right is a pair
 753   var second-ah/eax: (addr handle cell) <- get right, left
 754   var second/eax: (addr cell) <- lookup *second-ah
 755   var second-type/edx: (addr int) <- get second, type
 756   compare *second-type, 1/number
 757   {
 758     break-if-=
 759     error trace, "second arg for - is not a number"
 760     return
 761   }
 762   var second-value/edx: (addr float) <- get second, number-data
 763   # subtract
 764   var result/xmm0: float <- copy *first-value
 765   result <- subtract *second-value
 766   new-float out, result
 767 }
 768 
 769 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 770   trace-text trace, "eval", "apply *"
 771   var args-ah/eax: (addr handle cell) <- copy _args-ah
 772   var _args/eax: (addr cell) <- lookup *args-ah
 773   var args/esi: (addr cell) <- copy _args
 774   # TODO: check that args is a pair
 775   var empty-args?/eax: boolean <- nil? args
 776   compare empty-args?, 0/false
 777   {
 778     break-if-=
 779     error trace, "* needs 2 args but got 0"
 780     return
 781   }
 782   # args->left->value
 783   var first-ah/eax: (addr handle cell) <- get args, left
 784   var first/eax: (addr cell) <- lookup *first-ah
 785   var first-type/ecx: (addr int) <- get first, type
 786   compare *first-type, 1/number
 787   {
 788     break-if-=
 789     error trace, "first arg for * is not a number"
 790     return
 791   }
 792   var first-value/ecx: (addr float) <- get first, number-data
 793   # args->right->left->value
 794   var right-ah/eax: (addr handle cell) <- get args, right
 795   var right/eax: (addr cell) <- lookup *right-ah
 796   # TODO: check that right is a pair
 797   var second-ah/eax: (addr handle cell) <- get right, left
 798   var second/eax: (addr cell) <- lookup *second-ah
 799   var second-type/edx: (addr int) <- get second, type
 800   compare *second-type, 1/number
 801   {
 802     break-if-=
 803     error trace, "second arg for * is not a number"
 804     return
 805   }
 806   var second-value/edx: (addr float) <- get second, number-data
 807   # multiply
 808   var result/xmm0: float <- copy *first-value
 809   result <- multiply *second-value
 810   new-float out, result
 811 }
 812 
 813 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 814   trace-text trace, "eval", "apply /"
 815   var args-ah/eax: (addr handle cell) <- copy _args-ah
 816   var _args/eax: (addr cell) <- lookup *args-ah
 817   var args/esi: (addr cell) <- copy _args
 818   # TODO: check that args is a pair
 819   var empty-args?/eax: boolean <- nil? args
 820   compare empty-args?, 0/false
 821   {
 822     break-if-=
 823     error trace, "/ needs 2 args but got 0"
 824     return
 825   }
 826   # args->left->value
 827   var first-ah/eax: (addr handle cell) <- get args, left
 828   var first/eax: (addr cell) <- lookup *first-ah
 829   var first-type/ecx: (addr int) <- get first, type
 830   compare *first-type, 1/number
 831   {
 832     break-if-=
 833     error trace, "first arg for / is not a number"
 834     return
 835   }
 836   var first-value/ecx: (addr float) <- get first, number-data
 837   # args->right->left->value
 838   var right-ah/eax: (addr handle cell) <- get args, right
 839   var right/eax: (addr cell) <- lookup *right-ah
 840   # TODO: check that right is a pair
 841   var second-ah/eax: (addr handle cell) <- get right, left
 842   var second/eax: (addr cell) <- lookup *second-ah
 843   var second-type/edx: (addr int) <- get second, type
 844   compare *second-type, 1/number
 845   {
 846     break-if-=
 847     error trace, "second arg for / is not a number"
 848     return
 849   }
 850   var second-value/edx: (addr float) <- get second, number-data
 851   # divide
 852   var result/xmm0: float <- copy *first-value
 853   result <- divide *second-value
 854   new-float out, result
 855 }
 856 
 857 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 858   trace-text trace, "eval", "apply sqrt"
 859   var args-ah/eax: (addr handle cell) <- copy _args-ah
 860   var _args/eax: (addr cell) <- lookup *args-ah
 861   var args/esi: (addr cell) <- copy _args
 862   # TODO: check that args is a pair
 863   var empty-args?/eax: boolean <- nil? args
 864   compare empty-args?, 0/false
 865   {
 866     break-if-=
 867     error trace, "sqrt needs 1 args but got 0"
 868     return
 869   }
 870   # args->left->value
 871   var first-ah/eax: (addr handle cell) <- get args, left
 872   var first/eax: (addr cell) <- lookup *first-ah
 873   var first-type/ecx: (addr int) <- get first, type
 874   compare *first-type, 1/number
 875   {
 876     break-if-=
 877     error trace, "arg for sqrt is not a number"
 878     return
 879   }
 880   var first-value/ecx: (addr float) <- get first, number-data
 881   # square-root
 882   var result/xmm0: float <- square-root *first-value
 883   new-float out, result
 884 }
 885 
 886 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 887   trace-text trace, "eval", "apply abs"
 888   var args-ah/eax: (addr handle cell) <- copy _args-ah
 889   var _args/eax: (addr cell) <- lookup *args-ah
 890   var args/esi: (addr cell) <- copy _args
 891   # TODO: check that args is a pair
 892   var empty-args?/eax: boolean <- nil? args
 893   compare empty-args?, 0/false
 894   {
 895     break-if-=
 896     error trace, "abs needs 1 args but got 0"
 897     return
 898   }
 899   # args->left->value
 900   var first-ah/eax: (addr handle cell) <- get args, left
 901   var first/eax: (addr cell) <- lookup *first-ah
 902   var first-type/ecx: (addr int) <- get first, type
 903   compare *first-type, 1/number
 904   {
 905     break-if-=
 906     error trace, "arg for abs is not a number"
 907     return
 908   }
 909   var first-value/ecx: (addr float) <- get first, number-data
 910   #
 911   var result/xmm0: float <- copy *first-value
 912   var zero: float
 913   compare result, zero
 914   {
 915     break-if-float>=
 916     var neg1/eax: int <- copy -1
 917     var neg1-f/xmm1: float <- convert neg1
 918     result <- multiply neg1-f
 919   }
 920   new-float out, result
 921 }
 922 
 923 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 924   trace-text trace, "eval", "apply sgn"
 925   var args-ah/eax: (addr handle cell) <- copy _args-ah
 926   var _args/eax: (addr cell) <- lookup *args-ah
 927   var args/esi: (addr cell) <- copy _args
 928   # TODO: check that args is a pair
 929   var empty-args?/eax: boolean <- nil? args
 930   compare empty-args?, 0/false
 931   {
 932     break-if-=
 933     error trace, "sgn needs 1 args but got 0"
 934     return
 935   }
 936   # args->left->value
 937   var first-ah/eax: (addr handle cell) <- get args, left
 938   var first/eax: (addr cell) <- lookup *first-ah
 939   var first-type/ecx: (addr int) <- get first, type
 940   compare *first-type, 1/number
 941   {
 942     break-if-=
 943     error trace, "arg for sgn is not a number"
 944     return
 945   }
 946   var first-value/ecx: (addr float) <- get first, number-data
 947   #
 948   var result/xmm0: float <- copy *first-value
 949   var zero: float
 950   $apply-sgn:core: {
 951     compare result, zero
 952     break-if-=
 953     {
 954       break-if-float>
 955       var neg1/eax: int <- copy -1
 956       result <- convert neg1
 957       break $apply-sgn:core
 958     }
 959     {
 960       break-if-float<
 961       var one/eax: int <- copy 1
 962       result <- convert one
 963       break $apply-sgn:core
 964     }
 965   }
 966   new-float out, result
 967 }
 968 
 969 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 970   trace-text trace, "eval", "apply car"
 971   var args-ah/eax: (addr handle cell) <- copy _args-ah
 972   var _args/eax: (addr cell) <- lookup *args-ah
 973   var args/esi: (addr cell) <- copy _args
 974   # TODO: check that args is a pair
 975   var empty-args?/eax: boolean <- nil? args
 976   compare empty-args?, 0/false
 977   {
 978     break-if-=
 979     error trace, "car needs 1 args but got 0"
 980     return
 981   }
 982   # args->left
 983   var first-ah/eax: (addr handle cell) <- get args, left
 984   var first/eax: (addr cell) <- lookup *first-ah
 985   var first-type/ecx: (addr int) <- get first, type
 986   compare *first-type, 0/pair
 987   {
 988     break-if-=
 989     error trace, "arg for car is not a pair"
 990     return
 991   }
 992   # car
 993   var result/eax: (addr handle cell) <- get first, left
 994   copy-object result, out
 995 }
 996 
 997 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 998   trace-text trace, "eval", "apply cdr"
 999   var args-ah/eax: (addr handle cell) <- copy _args-ah
1000   var _args/eax: (addr cell) <- lookup *args-ah
1001   var args/esi: (addr cell) <- copy _args
1002   # TODO: check that args is a pair
1003   var empty-args?/eax: boolean <- nil? args
1004   compare empty-args?, 0/false
1005   {
1006     break-if-=
1007     error trace, "cdr needs 1 args but got 0"
1008     return
1009   }
1010   # args->left
1011   var first-ah/eax: (addr handle cell) <- get args, left
1012   var first/eax: (addr cell) <- lookup *first-ah
1013   var first-type/ecx: (addr int) <- get first, type
1014   compare *first-type, 0/pair
1015   {
1016     break-if-=
1017     error trace, "arg for cdr is not a pair"
1018     return
1019   }
1020   # cdr
1021   var result/eax: (addr handle cell) <- get first, right
1022   copy-object result, out
1023 }
1024 
1025 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1026   trace-text trace, "eval", "apply cons"
1027   var args-ah/eax: (addr handle cell) <- copy _args-ah
1028   var _args/eax: (addr cell) <- lookup *args-ah
1029   var args/esi: (addr cell) <- copy _args
1030   # TODO: check that args is a pair
1031   var empty-args?/eax: boolean <- nil? args
1032   compare empty-args?, 0/false
1033   {
1034     break-if-=
1035     error trace, "cons needs 2 args but got 0"
1036     return
1037   }
1038   # args->left
1039   var first-ah/ecx: (addr handle cell) <- get args, left
1040   # args->right->left
1041   var right-ah/eax: (addr handle cell) <- get args, right
1042   var right/eax: (addr cell) <- lookup *right-ah
1043   # TODO: check that right is a pair
1044   var second-ah/eax: (addr handle cell) <- get right, left
1045   # cons
1046   new-pair out, *first-ah, *second-ah
1047 }
1048 
1049 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1050   trace-text trace, "eval", "apply '='"
1051   var args-ah/eax: (addr handle cell) <- copy _args-ah
1052   var _args/eax: (addr cell) <- lookup *args-ah
1053   var args/esi: (addr cell) <- copy _args
1054   # TODO: check that args is a pair
1055   var empty-args?/eax: boolean <- nil? args
1056   compare empty-args?, 0/false
1057   {
1058     break-if-=
1059     error trace, "'=' needs 2 args but got 0"
1060     return
1061   }
1062   # args->left
1063   var first-ah/ecx: (addr handle cell) <- get args, left
1064   # args->right->left
1065   var right-ah/eax: (addr handle cell) <- get args, right
1066   var right/eax: (addr cell) <- lookup *right-ah
1067   # TODO: check that right is a pair
1068   var second-ah/edx: (addr handle cell) <- get right, left
1069   # compare
1070   var _first/eax: (addr cell) <- lookup *first-ah
1071   var first/ecx: (addr cell) <- copy _first
1072   var second/eax: (addr cell) <- lookup *second-ah
1073   var match?/eax: boolean <- cell-isomorphic? first, second, trace
1074   compare match?, 0/false
1075   {
1076     break-if-!=
1077     nil out
1078     return
1079   }
1080   new-integer out, 1/true
1081 }
1082 
1083 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1084   trace-text trace, "eval", "apply '<'"
1085   var args-ah/eax: (addr handle cell) <- copy _args-ah
1086   var _args/eax: (addr cell) <- lookup *args-ah
1087   var args/esi: (addr cell) <- copy _args
1088   # TODO: check that args is a pair
1089   var empty-args?/eax: boolean <- nil? args
1090   compare empty-args?, 0/false
1091   {
1092     break-if-=
1093     error trace, "'<' needs 2 args but got 0"
1094     return
1095   }
1096   # args->left
1097   var first-ah/ecx: (addr handle cell) <- get args, left
1098   # args->right->left
1099   var right-ah/eax: (addr handle cell) <- get args, right
1100   var right/eax: (addr cell) <- lookup *right-ah
1101   # TODO: check that right is a pair
1102   var second-ah/edx: (addr handle cell) <- get right, left
1103   # compare
1104   var _first/eax: (addr cell) <- lookup *first-ah
1105   var first/ecx: (addr cell) <- copy _first
1106   var first-type/eax: (addr int) <- get first, type
1107   compare *first-type, 1/number
1108   {
1109     break-if-=
1110     error trace, "first arg for '<' is not a number"
1111     return
1112   }
1113   var first-value/ecx: (addr float) <- get first, number-data
1114   var first-float/xmm0: float <- copy *first-value
1115   var second/eax: (addr cell) <- lookup *second-ah
1116   var second-type/edx: (addr int) <- get second, type
1117   compare *second-type, 1/number
1118   {
1119     break-if-=
1120     error trace, "first arg for '<' is not a number"
1121     return
1122   }
1123   var second-value/eax: (addr float) <- get second, number-data
1124   compare first-float, *second-value
1125   {
1126     break-if-float<
1127     nil out
1128     return
1129   }
1130   new-integer out, 1/true
1131 }
1132 
1133 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1134   trace-text trace, "eval", "apply '>'"
1135   var args-ah/eax: (addr handle cell) <- copy _args-ah
1136   var _args/eax: (addr cell) <- lookup *args-ah
1137   var args/esi: (addr cell) <- copy _args
1138   # TODO: check that args is a pair
1139   var empty-args?/eax: boolean <- nil? args
1140   compare empty-args?, 0/false
1141   {
1142     break-if-=
1143     error trace, "'>' needs 2 args but got 0"
1144     return
1145   }
1146   # args->left
1147   var first-ah/ecx: (addr handle cell) <- get args, left
1148   # args->right->left
1149   var right-ah/eax: (addr handle cell) <- get args, right
1150   var right/eax: (addr cell) <- lookup *right-ah
1151   # TODO: check that right is a pair
1152   var second-ah/edx: (addr handle cell) <- get right, left
1153   # compare
1154   var _first/eax: (addr cell) <- lookup *first-ah
1155   var first/ecx: (addr cell) <- copy _first
1156   var first-type/eax: (addr int) <- get first, type
1157   compare *first-type, 1/number
1158   {
1159     break-if-=
1160     error trace, "first arg for '>' is not a number"
1161     return
1162   }
1163   var first-value/ecx: (addr float) <- get first, number-data
1164   var first-float/xmm0: float <- copy *first-value
1165   var second/eax: (addr cell) <- lookup *second-ah
1166   var second-type/edx: (addr int) <- get second, type
1167   compare *second-type, 1/number
1168   {
1169     break-if-=
1170     error trace, "first arg for '>' is not a number"
1171     return
1172   }
1173   var second-value/eax: (addr float) <- get second, number-data
1174   compare first-float, *second-value
1175   {
1176     break-if-float>
1177     nil out
1178     return
1179   }
1180   new-integer out, 1/true
1181 }
1182 
1183 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1184   trace-text trace, "eval", "apply '<='"
1185   var args-ah/eax: (addr handle cell) <- copy _args-ah
1186   var _args/eax: (addr cell) <- lookup *args-ah
1187   var args/esi: (addr cell) <- copy _args
1188   # TODO: check that args is a pair
1189   var empty-args?/eax: boolean <- nil? args
1190   compare empty-args?, 0/false
1191   {
1192     break-if-=
1193     error trace, "'<=' needs 2 args but got 0"
1194     return
1195   }
1196   # args->left
1197   var first-ah/ecx: (addr handle cell) <- get args, left
1198   # args->right->left
1199   var right-ah/eax: (addr handle cell) <- get args, right
1200   var right/eax: (addr cell) <- lookup *right-ah
1201   # TODO: check that right is a pair
1202   var second-ah/edx: (addr handle cell) <- get right, left
1203   # compare
1204   var _first/eax: (addr cell) <- lookup *first-ah
1205   var first/ecx: (addr cell) <- copy _first
1206   var first-type/eax: (addr int) <- get first, type
1207   compare *first-type, 1/number
1208   {
1209     break-if-=
1210     error trace, "first arg for '<=' is not a number"
1211     return
1212   }
1213   var first-value/ecx: (addr float) <- get first, number-data
1214   var first-float/xmm0: float <- copy *first-value
1215   var second/eax: (addr cell) <- lookup *second-ah
1216   var second-type/edx: (addr int) <- get second, type
1217   compare *second-type, 1/number
1218   {
1219     break-if-=
1220     error trace, "first arg for '<=' is not a number"
1221     return
1222   }
1223   var second-value/eax: (addr float) <- get second, number-data
1224   compare first-float, *second-value
1225   {
1226     break-if-float<=
1227     nil out
1228     return
1229   }
1230   new-integer out, 1/true
1231 }
1232 
1233 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1234   trace-text trace, "eval", "apply '>='"
1235   var args-ah/eax: (addr handle cell) <- copy _args-ah
1236   var _args/eax: (addr cell) <- lookup *args-ah
1237   var args/esi: (addr cell) <- copy _args
1238   # TODO: check that args is a pair
1239   var empty-args?/eax: boolean <- nil? args
1240   compare empty-args?, 0/false
1241   {
1242     break-if-=
1243     error trace, "'>=' needs 2 args but got 0"
1244     return
1245   }
1246   # args->left
1247   var first-ah/ecx: (addr handle cell) <- get args, left
1248   # args->right->left
1249   var right-ah/eax: (addr handle cell) <- get args, right
1250   var right/eax: (addr cell) <- lookup *right-ah
1251   # TODO: check that right is a pair
1252   var second-ah/edx: (addr handle cell) <- get right, left
1253   # compare
1254   var _first/eax: (addr cell) <- lookup *first-ah
1255   var first/ecx: (addr cell) <- copy _first
1256   var first-type/eax: (addr int) <- get first, type
1257   compare *first-type, 1/number
1258   {
1259     break-if-=
1260     error trace, "first arg for '>=' is not a number"
1261     return
1262   }
1263   var first-value/ecx: (addr float) <- get first, number-data
1264   var first-float/xmm0: float <- copy *first-value
1265   var second/eax: (addr cell) <- lookup *second-ah
1266   var second-type/edx: (addr int) <- get second, type
1267   compare *second-type, 1/number
1268   {
1269     break-if-=
1270     error trace, "first arg for '>=' is not a number"
1271     return
1272   }
1273   var second-value/eax: (addr float) <- get second, number-data
1274   compare first-float, *second-value
1275   {
1276     break-if-float>=
1277     nil out
1278     return
1279   }
1280   new-integer out, 1/true
1281 }
1282 
1283 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1284   trace-text trace, "eval", "apply print"
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, "print needs 2 args 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 'print' 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   # args->right->left
1310   var right-ah/eax: (addr handle cell) <- get args, right
1311   var right/eax: (addr cell) <- lookup *right-ah
1312   # TODO: check that right is a pair
1313   var second-ah/eax: (addr handle cell) <- get right, left
1314   var stream-storage: (stream byte 0x100)
1315   var stream/edi: (addr stream byte) <- address stream-storage
1316   print-cell second-ah, stream, trace
1317   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
1318   # return what was printed
1319   copy-object second-ah, out
1320 }
1321 
1322 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1323   trace-text trace, "eval", "apply clear"
1324   var args-ah/eax: (addr handle cell) <- copy _args-ah
1325   var _args/eax: (addr cell) <- lookup *args-ah
1326   var args/esi: (addr cell) <- copy _args
1327   # TODO: check that args is a pair
1328   var empty-args?/eax: boolean <- nil? args
1329   compare empty-args?, 0/false
1330   {
1331     break-if-=
1332     error trace, "'clear' needs 1 arg but got 0"
1333     return
1334   }
1335   # screen = args->left
1336   var first-ah/eax: (addr handle cell) <- get args, left
1337   var first/eax: (addr cell) <- lookup *first-ah
1338   var first-type/ecx: (addr int) <- get first, type
1339   compare *first-type, 5/screen
1340   {
1341     break-if-=
1342     error trace, "first arg for 'clear' is not a screen"
1343     return
1344   }
1345   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1346   var _screen/eax: (addr screen) <- lookup *screen-ah
1347   var screen/ecx: (addr screen) <- copy _screen
1348   #
1349   clear-screen screen
1350 }
1351 
1352 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1353   trace-text trace, "eval", "apply up"
1354   var args-ah/eax: (addr handle cell) <- copy _args-ah
1355   var _args/eax: (addr cell) <- lookup *args-ah
1356   var args/esi: (addr cell) <- copy _args
1357   # TODO: check that args is a pair
1358   var empty-args?/eax: boolean <- nil? args
1359   compare empty-args?, 0/false
1360   {
1361     break-if-=
1362     error trace, "'up' needs 1 arg but got 0"
1363     return
1364   }
1365   # screen = args->left
1366   var first-ah/eax: (addr handle cell) <- get args, left
1367   var first/eax: (addr cell) <- lookup *first-ah
1368   var first-type/ecx: (addr int) <- get first, type
1369   compare *first-type, 5/screen
1370   {
1371     break-if-=
1372     error trace, "first arg for 'up' is not a screen"
1373     return
1374   }
1375   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1376   var _screen/eax: (addr screen) <- lookup *screen-ah
1377   var screen/ecx: (addr screen) <- copy _screen
1378   #
1379   move-cursor-up screen
1380 }
1381 
1382 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1383   trace-text trace, "eval", "apply 'down'"
1384   var args-ah/eax: (addr handle cell) <- copy _args-ah
1385   var _args/eax: (addr cell) <- lookup *args-ah
1386   var args/esi: (addr cell) <- copy _args
1387   # TODO: check that args is a pair
1388   var empty-args?/eax: boolean <- nil? args
1389   compare empty-args?, 0/false
1390   {
1391     break-if-=
1392     error trace, "'down' needs 1 arg but got 0"
1393     return
1394   }
1395   # screen = args->left
1396   var first-ah/eax: (addr handle cell) <- get args, left
1397   var first/eax: (addr cell) <- lookup *first-ah
1398   var first-type/ecx: (addr int) <- get first, type
1399   compare *first-type, 5/screen
1400   {
1401     break-if-=
1402     error trace, "first arg for 'down' is not a screen"
1403     return
1404   }
1405   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1406   var _screen/eax: (addr screen) <- lookup *screen-ah
1407   var screen/ecx: (addr screen) <- copy _screen
1408   #
1409   move-cursor-down screen
1410 }
1411 
1412 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1413   trace-text trace, "eval", "apply 'left'"
1414   var args-ah/eax: (addr handle cell) <- copy _args-ah
1415   var _args/eax: (addr cell) <- lookup *args-ah
1416   var args/esi: (addr cell) <- copy _args
1417   # TODO: check that args is a pair
1418   var empty-args?/eax: boolean <- nil? args
1419   compare empty-args?, 0/false
1420   {
1421     break-if-=
1422     error trace, "'left' needs 1 arg but got 0"
1423     return
1424   }
1425   # screen = args->left
1426   var first-ah/eax: (addr handle cell) <- get args, left
1427   var first/eax: (addr cell) <- lookup *first-ah
1428   var first-type/ecx: (addr int) <- get first, type
1429   compare *first-type, 5/screen
1430   {
1431     break-if-=
1432     error trace, "first arg for 'left' is not a screen"
1433     return
1434   }
1435   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1436   var _screen/eax: (addr screen) <- lookup *screen-ah
1437   var screen/ecx: (addr screen) <- copy _screen
1438   #
1439   move-cursor-left screen
1440 }
1441 
1442 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1443   trace-text trace, "eval", "apply 'right'"
1444   var args-ah/eax: (addr handle cell) <- copy _args-ah
1445   var _args/eax: (addr cell) <- lookup *args-ah
1446   var args/esi: (addr cell) <- copy _args
1447   # TODO: check that args is a pair
1448   var empty-args?/eax: boolean <- nil? args
1449   compare empty-args?, 0/false
1450   {
1451     break-if-=
1452     error trace, "'right' needs 1 arg but got 0"
1453     return
1454   }
1455   # screen = args->left
1456   var first-ah/eax: (addr handle cell) <- get args, left
1457   var first/eax: (addr cell) <- lookup *first-ah
1458   var first-type/ecx: (addr int) <- get first, type
1459   compare *first-type, 5/screen
1460   {
1461     break-if-=
1462     error trace, "first arg for 'right' is not a screen"
1463     return
1464   }
1465   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1466   var _screen/eax: (addr screen) <- lookup *screen-ah
1467   var screen/ecx: (addr screen) <- copy _screen
1468   #
1469   move-cursor-right screen
1470 }
1471 
1472 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1473   trace-text trace, "eval", "apply 'cr'"
1474   var args-ah/eax: (addr handle cell) <- copy _args-ah
1475   var _args/eax: (addr cell) <- lookup *args-ah
1476   var args/esi: (addr cell) <- copy _args
1477   # TODO: check that args is a pair
1478   var empty-args?/eax: boolean <- nil? args
1479   compare empty-args?, 0/false
1480   {
1481     break-if-=
1482     error trace, "'cr' needs 1 arg but got 0"
1483     return
1484   }
1485   # screen = args->left
1486   var first-ah/eax: (addr handle cell) <- get args, left
1487   var first/eax: (addr cell) <- lookup *first-ah
1488   var first-type/ecx: (addr int) <- get first, type
1489   compare *first-type, 5/screen
1490   {
1491     break-if-=
1492     error trace, "first arg for 'cr' is not a screen"
1493     return
1494   }
1495   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1496   var _screen/eax: (addr screen) <- lookup *screen-ah
1497   var screen/ecx: (addr screen) <- copy _screen
1498   #
1499   move-cursor-to-left-margin-of-next-line screen
1500 }
1501 
1502 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1503   trace-text trace, "eval", "apply pixel"
1504   var args-ah/eax: (addr handle cell) <- copy _args-ah
1505   var _args/eax: (addr cell) <- lookup *args-ah
1506   var args/esi: (addr cell) <- copy _args
1507   # TODO: check that args is a pair
1508   var empty-args?/eax: boolean <- nil? args
1509   compare empty-args?, 0/false
1510   {
1511     break-if-=
1512     error trace, "pixel needs 4 args but got 0"
1513     return
1514   }
1515   # screen = args->left
1516   var first-ah/eax: (addr handle cell) <- get args, left
1517   var first/eax: (addr cell) <- lookup *first-ah
1518   var first-type/ecx: (addr int) <- get first, type
1519   compare *first-type, 5/screen
1520   {
1521     break-if-=
1522     error trace, "first arg for 'pixel' is not a screen"
1523     return
1524   }
1525   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1526   var _screen/eax: (addr screen) <- lookup *screen-ah
1527   var screen/edi: (addr screen) <- copy _screen
1528   # x = args->right->left->value
1529   var rest-ah/eax: (addr handle cell) <- get args, right
1530   var _rest/eax: (addr cell) <- lookup *rest-ah
1531   var rest/esi: (addr cell) <- copy _rest
1532   # TODO: check that rest is a pair
1533   var second-ah/eax: (addr handle cell) <- get rest, left
1534   var second/eax: (addr cell) <- lookup *second-ah
1535   var second-type/ecx: (addr int) <- get second, type
1536   compare *second-type, 1/number
1537   {
1538     break-if-=
1539     error trace, "second arg for 'pixel' is not an int (x coordinate)"
1540     return
1541   }
1542   var second-value/eax: (addr float) <- get second, number-data
1543   var x/edx: int <- convert *second-value
1544   # y = rest->right->left->value
1545   var rest-ah/eax: (addr handle cell) <- get rest, right
1546   var _rest/eax: (addr cell) <- lookup *rest-ah
1547   rest <- copy _rest
1548   # TODO: check that rest is a pair
1549   var third-ah/eax: (addr handle cell) <- get rest, left
1550   var third/eax: (addr cell) <- lookup *third-ah
1551   var third-type/ecx: (addr int) <- get third, type
1552   compare *third-type, 1/number
1553   {
1554     break-if-=
1555     error trace, "third arg for 'pixel' is not an int (y coordinate)"
1556     return
1557   }
1558   var third-value/eax: (addr float) <- get third, number-data
1559   var y/ebx: int <- convert *third-value
1560   # color = rest->right->left->value
1561   var rest-ah/eax: (addr handle cell) <- get rest, right
1562   var _rest/eax: (addr cell) <- lookup *rest-ah
1563   rest <- copy _rest
1564   # TODO: check that rest is a pair
1565   var fourth-ah/eax: (addr handle cell) <- get rest, left
1566   var fourth/eax: (addr cell) <- lookup *fourth-ah
1567   var fourth-type/ecx: (addr int) <- get fourth, type
1568   compare *fourth-type, 1/number
1569   {
1570     break-if-=
1571     error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
1572     return
1573   }
1574   var fourth-value/eax: (addr float) <- get fourth, number-data
1575   var color/eax: int <- convert *fourth-value
1576   pixel screen, x, y, color
1577   # return nothing
1578 }
1579 
1580 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1581   trace-text trace, "eval", "apply key"
1582   var args-ah/eax: (addr handle cell) <- copy _args-ah
1583   var _args/eax: (addr cell) <- lookup *args-ah
1584   var args/esi: (addr cell) <- copy _args
1585   # TODO: check that args is a pair
1586   var empty-args?/eax: boolean <- nil? args
1587   compare empty-args?, 0/false
1588   {
1589     break-if-=
1590     error trace, "key needs 1 arg but got 0"
1591     return
1592   }
1593   # keyboard = args->left
1594   var first-ah/eax: (addr handle cell) <- get args, left
1595   var first/eax: (addr cell) <- lookup *first-ah
1596   var first-type/ecx: (addr int) <- get first, type
1597   compare *first-type, 6/keyboard
1598   {
1599     break-if-=
1600     error trace, "first arg for 'key' is not a keyboard"
1601     return
1602   }
1603   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
1604   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
1605   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
1606   var result/eax: int <- wait-for-key keyboard
1607   # return key typed
1608   new-integer out, result
1609 }
1610 
1611 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
1612   # if keyboard is 0, use real keyboard
1613   {
1614     compare keyboard, 0/real-keyboard
1615     break-if-!=
1616     var key/eax: byte <- read-key 0/real-keyboard
1617     var result/eax: int <- copy key
1618     return result
1619   }
1620   # otherwise read from fake keyboard
1621   var g/eax: grapheme <- read-from-gap-buffer keyboard
1622   var result/eax: int <- copy g
1623   return result
1624 }
1625 
1626 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1627   trace-text trace, "eval", "apply stream"
1628   allocate-stream out
1629 }
1630 
1631 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1632   trace-text trace, "eval", "apply write"
1633   var args-ah/eax: (addr handle cell) <- copy _args-ah
1634   var _args/eax: (addr cell) <- lookup *args-ah
1635   var args/esi: (addr cell) <- copy _args
1636   # TODO: check that args is a pair
1637   var empty-args?/eax: boolean <- nil? args
1638   compare empty-args?, 0/false
1639   {
1640     break-if-=
1641     error trace, "write needs 2 args but got 0"
1642     return
1643   }
1644   # stream = args->left
1645   var first-ah/edx: (addr handle cell) <- get args, left
1646   var first/eax: (addr cell) <- lookup *first-ah
1647   var first-type/ecx: (addr int) <- get first, type
1648   compare *first-type, 3/stream
1649   {
1650     break-if-=
1651     error trace, "first arg for 'write' is not a stream"
1652     return
1653   }
1654   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
1655   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
1656   var stream-data/ebx: (addr stream byte) <- copy _stream-data
1657   # args->right->left
1658   var right-ah/eax: (addr handle cell) <- get args, right
1659   var right/eax: (addr cell) <- lookup *right-ah
1660   # TODO: check that right is a pair
1661   var second-ah/eax: (addr handle cell) <- get right, left
1662   var second/eax: (addr cell) <- lookup *second-ah
1663   var second-type/ecx: (addr int) <- get second, type
1664   compare *second-type, 1/number
1665   {
1666     break-if-=
1667     error trace, "second arg for stream is not a number/grapheme"
1668     return
1669   }
1670   var second-value/eax: (addr float) <- get second, number-data
1671   var x-float/xmm0: float <- copy *second-value
1672   var x/eax: int <- convert x-float
1673   var x-grapheme/eax: grapheme <- copy x
1674   write-grapheme stream-data, x-grapheme
1675   # return the stream
1676   copy-object first-ah, out
1677 }
1678 
1679 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1680   trace-text trace, "eval", "apply lines"
1681   var args-ah/eax: (addr handle cell) <- copy _args-ah
1682   var _args/eax: (addr cell) <- lookup *args-ah
1683   var args/esi: (addr cell) <- copy _args
1684   # TODO: check that args is a pair
1685   var empty-args?/eax: boolean <- nil? args
1686   compare empty-args?, 0/false
1687   {
1688     break-if-=
1689     error trace, "lines needs 1 arg but got 0"
1690     return
1691   }
1692   # screen = args->left
1693   var first-ah/eax: (addr handle cell) <- get args, left
1694   var first/eax: (addr cell) <- lookup *first-ah
1695   var first-type/ecx: (addr int) <- get first, type
1696   compare *first-type, 5/screen
1697   {
1698     break-if-=
1699     error trace, "first arg for 'lines' is not a screen"
1700     return
1701   }
1702   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1703   var _screen/eax: (addr screen) <- lookup *screen-ah
1704   var screen/edx: (addr screen) <- copy _screen
1705   # compute dimensions
1706   var dummy/eax: int <- copy 0
1707   var height/ecx: int <- copy 0
1708   dummy, height <- screen-size screen
1709   var result/xmm0: float <- convert height
1710   new-float out, result
1711 }
1712 
1713 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1714   abort "aa"
1715 }
1716 
1717 fn apply-life _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1718   life
1719 }
1720 
1721 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1722   trace-text trace, "eval", "apply columns"
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, "columns 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 'columns' 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 width/eax: int <- copy 0
1749   var dummy/ecx: int <- copy 0
1750   width, dummy <- screen-size screen
1751   var result/xmm0: float <- convert width
1752   new-float out, result
1753 }
1754 
1755 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1756   trace-text trace, "eval", "apply width"
1757   var args-ah/eax: (addr handle cell) <- copy _args-ah
1758   var _args/eax: (addr cell) <- lookup *args-ah
1759   var args/esi: (addr cell) <- copy _args
1760   # TODO: check that args is a pair
1761   var empty-args?/eax: boolean <- nil? args
1762   compare empty-args?, 0/false
1763   {
1764     break-if-=
1765     error trace, "width needs 1 arg but got 0"
1766     return
1767   }
1768   # screen = args->left
1769   var first-ah/eax: (addr handle cell) <- get args, left
1770   var first/eax: (addr cell) <- lookup *first-ah
1771   var first-type/ecx: (addr int) <- get first, type
1772   compare *first-type, 5/screen
1773   {
1774     break-if-=
1775     error trace, "first arg for 'width' is not a screen"
1776     return
1777   }
1778   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1779   var _screen/eax: (addr screen) <- lookup *screen-ah
1780   var screen/edx: (addr screen) <- copy _screen
1781   # compute dimensions
1782   var width/eax: int <- copy 0
1783   var dummy/ecx: int <- copy 0
1784   width, dummy <- screen-size screen
1785   width <- shift-left 3/log2-font-width
1786   var result/xmm0: float <- convert width
1787   new-float out, result
1788 }
1789 
1790 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1791   trace-text trace, "eval", "apply height"
1792   var args-ah/eax: (addr handle cell) <- copy _args-ah
1793   var _args/eax: (addr cell) <- lookup *args-ah
1794   var args/esi: (addr cell) <- copy _args
1795   # TODO: check that args is a pair
1796   var empty-args?/eax: boolean <- nil? args
1797   compare empty-args?, 0/false
1798   {
1799     break-if-=
1800     error trace, "height needs 1 arg but got 0"
1801     return
1802   }
1803   # screen = args->left
1804   var first-ah/eax: (addr handle cell) <- get args, left
1805   var first/eax: (addr cell) <- lookup *first-ah
1806   var first-type/ecx: (addr int) <- get first, type
1807   compare *first-type, 5/screen
1808   {
1809     break-if-=
1810     error trace, "first arg for 'height' is not a screen"
1811     return
1812   }
1813   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1814   var _screen/eax: (addr screen) <- lookup *screen-ah
1815   var screen/edx: (addr screen) <- copy _screen
1816   # compute dimensions
1817   var dummy/eax: int <- copy 0
1818   var height/ecx: int <- copy 0
1819   dummy, height <- screen-size screen
1820   height <- shift-left 4/log2-font-height
1821   var result/xmm0: float <- convert height
1822   new-float out, result
1823 }