# Mu - shell/global.mu

https://github.com/akkartik/mu/blob/main/shell/global.mu

       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 }