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