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

       1 # Primitives are functions that are implemented directly in Mu.
       2 # They always evaluate all their arguments.
       3
       4 fn initialize-primitives _self: (addr global-table) {
       5   var self/esi: (addr global-table) <- copy _self
       6   # for numbers
       7   append-primitive self, "+"
       8   append-primitive self, "-"
       9   append-primitive self, "*"
      10   append-primitive self, "/"
      11   append-primitive self, "%"
      12   append-primitive self, "sqrt"
      13   append-primitive self, "abs"
      14   append-primitive self, "sgn"
      15   append-primitive self, "<"
      16   append-primitive self, ">"
      17   append-primitive self, "<="
      18   append-primitive self, ">="
      19   # generic
      20   append-primitive self, "apply"
      21   append-primitive self, "="
      22   append-primitive self, "no"
      23   append-primitive self, "not"
      24   append-primitive self, "dbg"
      25   # for pairs
      26   append-primitive self, "car"
      27   append-primitive self, "cdr"
      28   append-primitive self, "cons"
      29   append-primitive self, "cons?"
      30   # for screens
      31   append-primitive self, "print"
      32   append-primitive self, "clear"
      33   append-primitive self, "lines"
      34   append-primitive self, "columns"
      35   append-primitive self, "up"
      36   append-primitive self, "down"
      37   append-primitive self, "left"
      38   append-primitive self, "right"
      39   append-primitive self, "cr"
      40   append-primitive self, "pixel"
      41   append-primitive self, "line"
      42   append-primitive self, "hline"
      43   append-primitive self, "vline"
      44   append-primitive self, "circle"
      45   append-primitive self, "bezier"
      46   append-primitive self, "width"
      47   append-primitive self, "height"
      48   append-primitive self, "new_screen"
      49   append-primitive self, "blit"
      50   # for keyboards
      51   append-primitive self, "key"
      52   # for streams
      53   append-primitive self, "stream"
      54   append-primitive self, "write"
      55   append-primitive self, "read"
      56   append-primitive self, "rewind"
      57   # misc
      58   append-primitive self, "abort"
      59   # keep sync'd with render-primitives
      60 }
      61
      62 # Slightly misnamed; renders primitives as well as special forms that don't
      63 # evaluate all their arguments.
      64 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
      65   var y/ecx: int <- copy ymax
      66   y <- subtract 0x11/primitives-border
      67   clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg
      68   y <- increment
      69   var right-min/edx: int <- copy xmax
      70   right-min <- subtract 0x1e/primitives-divider
      71   set-cursor-position screen, right-min, y
      72   draw-text-wrapping-right-then-down-from-cursor screen, "primitives", right-min, y, xmax, ymax, 7/fg=grey, 0xdc/bg=green-bg
      73   y <- increment
      74   set-cursor-position screen, right-min, y
      75   draw-text-wrapping-right-then-down-from-cursor screen, "fn apply set if while", right-min, y, xmax, ymax, 0x2a/fg=orange, 0xdc/bg=green-bg
      76   y <- increment
      77   set-cursor-position screen, right-min, y
      78   draw-text-wrapping-right-then-down-from-cursor screen, "booleans", right-min, y, xmax, ymax, 7/fg=grey, 0xdc/bg=green-bg
      79   y <- increment
      80   set-cursor-position screen, right-min, y
      81   draw-text-wrapping-right-then-down-from-cursor screen, "= and or not", right-min, y, xmax, ymax, 0x2a/fg=orange, 0xdc/bg=green-bg
      82   y <- increment
      83   set-cursor-position screen, right-min, y
      84   draw-text-wrapping-right-then-down-from-cursor screen, "lists", right-min, y, xmax, ymax, 7/fg=grey, 0xdc/bg=green-bg
      85   y <- increment
      86   set-cursor-position screen, right-min, y
      87   draw-text-wrapping-right-then-down-from-cursor screen, "cons car cdr no cons?", right-min, y, xmax, ymax, 0x2a/fg=orange, 0xdc/bg=green-bg
      88   y <- increment
      89   set-cursor-position screen, right-min, y
      90   draw-text-wrapping-right-then-down-from-cursor screen, "numbers", right-min, y, xmax, ymax, 7/fg=grey, 0xdc/bg=green-bg
      91   y <- increment
      92   set-cursor-position screen, right-min, y
      93   draw-text-wrapping-right-then-down-from-cursor screen, "+ - * / %", right-min, y, xmax, ymax, 0x2a/fg=orange, 0xdc/bg=green-bg
      94   y <- increment
      95   set-cursor-position screen, right-min, y
      96   draw-text-wrapping-right-then-down-from-cursor screen, "< > <= >=", right-min, y, xmax, ymax, 0x2a/fg=orange, 0xdc/bg=green-bg
      97   y <- increment
      98   set-cursor-position screen, right-min, y
      99   draw-text-wrapping-right-then-down-from-cursor screen, "sqrt abs sgn", right-min, y, xmax, ymax, 0x2a/fg=orange, 0xdc/bg=green-bg
     100 #?   {
     101 #?     compare screen, 0
     102 #?     break-if-!=
     103 #?     var foo/eax: byte <- read-key 0/keyboard
     104 #?     compare foo, 0
     105 #?     loop-if-=
     106 #?   }
     107   y <- copy ymax
     108   y <- subtract 0x10/primitives-border
     109   var left-max/edx: int <- copy xmax
     110   left-max <- subtract 0x20/primitives-divider
     111   var tmpx/eax: int <- copy xmin
     112   tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     113   y <- increment
     114   var tmpx/eax: int <- copy xmin
     115   tmpx <- draw-text-rightward screen, "  print", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     116   tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     117   y <- increment
     118   var tmpx/eax: int <- copy xmin
     119   tmpx <- draw-text-rightward screen, "  lines columns", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     120   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     121   y <- increment
     122   var tmpx/eax: int <- copy xmin
     123   tmpx <- draw-text-rightward screen, "  up down left right", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     124   tmpx <- draw-text-rightward screen, ": screen", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     125   y <- increment
     126   var tmpx/eax: int <- copy xmin
     127   tmpx <- draw-text-rightward screen, "  cr", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     128   tmpx <- draw-text-rightward screen, ": screen   ", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     129   tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, left-max, y, 0x38/fg=trace, 0xdc/bg=green-bg
     130   y <- increment
     131   var tmpx/eax: int <- copy xmin
     132   tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     133   y <- increment
     134   var tmpx/eax: int <- copy xmin
     135   tmpx <- draw-text-rightward screen, "  circle bezier line hline vline pixel", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     136   y <- increment
     137   var tmpx/eax: int <- copy xmin
     138   tmpx <- draw-text-rightward screen, "  width height", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     139   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     140   y <- increment
     141   var tmpx/eax: int <- copy xmin
     142   tmpx <- draw-text-rightward screen, "  new_screen", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     143   tmpx <- draw-text-rightward screen, ": number number -> screen ", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     144   y <- increment
     145   var tmpx/eax: int <- copy xmin
     146   tmpx <- draw-text-rightward screen, "  clear blit", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     147   tmpx <- draw-text-rightward screen, ": screen", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     148   y <- increment
     149   var tmpx/eax: int <- copy xmin
     150   tmpx <- draw-text-rightward screen, "  key", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     151   tmpx <- draw-text-rightward screen, ": keyboard -> grapheme?", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     152   y <- increment
     153   var tmpx/eax: int <- copy xmin
     154   tmpx <- draw-text-rightward screen, "streams", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     155   y <- increment
     156   var tmpx/eax: int <- copy xmin
     157   tmpx <- draw-text-rightward screen, "  stream", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     158   tmpx <- draw-text-rightward screen, ": -> stream ", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     159   y <- increment
     160   var tmpx/eax: int <- copy xmin
     161   tmpx <- draw-text-rightward screen, "  write", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     162   tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     163   y <- increment
     164   var tmpx/eax: int <- copy xmin
     165   tmpx <- draw-text-rightward screen, "  rewind clear", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     166   tmpx <- draw-text-rightward screen, ": stream", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     167   y <- increment
     168   var tmpx/eax: int <- copy xmin
     169   tmpx <- draw-text-rightward screen, "  read", tmpx, left-max, y, 0x2a/fg=orange, 0xdc/bg=green-bg
     170   tmpx <- draw-text-rightward screen, ": stream -> grapheme", tmpx, left-max, y, 7/fg=grey, 0xdc/bg=green-bg
     171 }
     172
     173 fn primitive-global? _x: (addr global) -> _/eax: boolean {
     174   var x/eax: (addr global) <- copy _x
     175   var value-ah/eax: (addr handle cell) <- get x, value
     176   var value/eax: (addr cell) <- lookup *value-ah
     177   compare value, 0/null
     178   {
     179     break-if-!=
     180     return 0/false
     181   }
     182   {
     183     var value-type/eax: (addr int) <- get value, type
     184     compare *value-type, 4/primitive
     185     break-if-=
     186     return 0/false
     187   }
     188   return 1/true
     189 }
     190
     191 fn append-primitive _self: (addr global-table), name: (addr array byte) {
     192   var self/esi: (addr global-table) <- copy _self
     193   compare self, 0
     194   {
     195     break-if-!=
     196     abort "append primitive"
     197     return
     198   }
     199   var final-index-addr/ecx: (addr int) <- get self, final-index
     200   increment *final-index-addr
     201   var curr-index/ecx: int <- copy *final-index-addr
     202   var data-ah/eax: (addr handle array global) <- get self, data
     203   var data/eax: (addr array global) <- lookup *data-ah
     204   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
     205   var curr/esi: (addr global) <- index data, curr-offset
     206   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
     207   copy-array-object name, curr-name-ah
     208   var curr-value-ah/eax: (addr handle cell) <- get curr, value
     209   new-primitive-function curr-value-ah, curr-index
     210 }
     211
     212 # a little strange; goes from value to name and selects primitive based on name
     213 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
     214   var f/esi: (addr cell) <- copy _f
     215   var f-index-a/ecx: (addr int) <- get f, index-data
     216   var f-index/ecx: int <- copy *f-index-a
     217   var globals/eax: (addr global-table) <- copy _globals
     218   compare globals, 0
     219   {
     220     break-if-!=
     221     abort "apply primitive"
     222     return
     223   }
     224   var global-data-ah/eax: (addr handle array global) <- get globals, data
     225   var global-data/eax: (addr array global) <- lookup *global-data-ah
     226   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
     227   var f-value/ecx: (addr global) <- index global-data, f-offset
     228   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
     229   var f-name/eax: (addr array byte) <- lookup *f-name-ah
     230   {
     231     var add?/eax: boolean <- string-equal? f-name, "+"
     232     compare add?, 0/false
     233     break-if-=
     234     apply-add args-ah, out, trace
     235     return
     236   }
     237   {
     238     var subtract?/eax: boolean <- string-equal? f-name, "-"
     239     compare subtract?, 0/false
     240     break-if-=
     241     apply-subtract args-ah, out, trace
     242     return
     243   }
     244   {
     245     var multiply?/eax: boolean <- string-equal? f-name, "*"
     246     compare multiply?, 0/false
     247     break-if-=
     248     apply-multiply args-ah, out, trace
     249     return
     250   }
     251   {
     252     var divide?/eax: boolean <- string-equal? f-name, "/"
     253     compare divide?, 0/false
     254     break-if-=
     255     apply-divide args-ah, out, trace
     256     return
     257   }
     258   # '%' is the remainder operator, because modulo isn't really meaningful for
     259   # non-integers
     260   #
     261   # I considered calling this operator 'rem', but I want to follow Arc in
     262   # using 'rem' for filtering out elements from lists.
     263   #   https://arclanguage.github.io/ref/list.html#rem
     264   {
     265     var remainder?/eax: boolean <- string-equal? f-name, "%"
     266     compare remainder?, 0/false
     267     break-if-=
     268     apply-remainder args-ah, out, trace
     269     return
     270   }
     271   {
     272     var square-root?/eax: boolean <- string-equal? f-name, "sqrt"
     273     compare square-root?, 0/false
     274     break-if-=
     275     apply-square-root args-ah, out, trace
     276     return
     277   }
     278   {
     279     var abs?/eax: boolean <- string-equal? f-name, "abs"
     280     compare abs?, 0/false
     281     break-if-=
     282     apply-abs args-ah, out, trace
     283     return
     284   }
     285   {
     286     var sgn?/eax: boolean <- string-equal? f-name, "sgn"
     287     compare sgn?, 0/false
     288     break-if-=
     289     apply-sgn args-ah, out, trace
     290     return
     291   }
     292   {
     293     var car?/eax: boolean <- string-equal? f-name, "car"
     294     compare car?, 0/false
     295     break-if-=
     296     apply-car args-ah, out, trace
     297     return
     298   }
     299   {
     300     var cdr?/eax: boolean <- string-equal? f-name, "cdr"
     301     compare cdr?, 0/false
     302     break-if-=
     303     apply-cdr args-ah, out, trace
     304     return
     305   }
     306   {
     307     var cons?/eax: boolean <- string-equal? f-name, "cons"
     308     compare cons?, 0/false
     309     break-if-=
     310     apply-cons args-ah, out, trace
     311     return
     312   }
     313   {
     314     var cons-check?/eax: boolean <- string-equal? f-name, "cons?"
     315     compare cons-check?, 0/false
     316     break-if-=
     317     apply-cons-check args-ah, out, trace
     318     return
     319   }
     320   {
     321     var cell-isomorphic?/eax: boolean <- string-equal? f-name, "="
     322     compare cell-isomorphic?, 0/false
     323     break-if-=
     324     apply-cell-isomorphic args-ah, out, trace
     325     return
     326   }
     327   {
     328     var not?/eax: boolean <- string-equal? f-name, "no"
     329     compare not?, 0/false
     330     break-if-=
     331     apply-not args-ah, out, trace
     332     return
     333   }
     334   {
     335     var not?/eax: boolean <- string-equal? f-name, "not"
     336     compare not?, 0/false
     337     break-if-=
     338     apply-not args-ah, out, trace
     339     return
     340   }
     341   {
     342     var debug?/eax: boolean <- string-equal? f-name, "dbg"
     343     compare debug?, 0/false
     344     break-if-=
     345     apply-debug args-ah, out, trace
     346     return
     347   }
     348   {
     349     var lesser?/eax: boolean <- string-equal? f-name, "<"
     350     compare lesser?, 0/false
     351     break-if-=
     352     apply-< args-ah, out, trace
     353     return
     354   }
     355   {
     356     var greater?/eax: boolean <- string-equal? f-name, ">"
     357     compare greater?, 0/false
     358     break-if-=
     359     apply-> args-ah, out, trace
     360     return
     361   }
     362   {
     363     var lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
     364     compare lesser-or-equal?, 0/false
     365     break-if-=
     366     apply-<= args-ah, out, trace
     367     return
     368   }
     369   {
     370     var greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
     371     compare greater-or-equal?, 0/false
     372     break-if-=
     373     apply->= args-ah, out, trace
     374     return
     375   }
     376   {
     377     var print?/eax: boolean <- string-equal? f-name, "print"
     378     compare print?, 0/false
     379     break-if-=
     380     apply-print args-ah, out, trace
     381     return
     382   }
     383   {
     384     var clear?/eax: boolean <- string-equal? f-name, "clear"
     385     compare clear?, 0/false
     386     break-if-=
     387     apply-clear args-ah, out, trace
     388     return
     389   }
     390   {
     391     var lines?/eax: boolean <- string-equal? f-name, "lines"
     392     compare lines?, 0/false
     393     break-if-=
     394     apply-lines args-ah, out, trace
     395     return
     396   }
     397   {
     398     var columns?/eax: boolean <- string-equal? f-name, "columns"
     399     compare columns?, 0/false
     400     break-if-=
     401     apply-columns args-ah, out, trace
     402     return
     403   }
     404   {
     405     var up?/eax: boolean <- string-equal? f-name, "up"
     406     compare up?, 0/false
     407     break-if-=
     408     apply-up args-ah, out, trace
     409     return
     410   }
     411   {
     412     var down?/eax: boolean <- string-equal? f-name, "down"
     413     compare down?, 0/false
     414     break-if-=
     415     apply-down args-ah, out, trace
     416     return
     417   }
     418   {
     419     var left?/eax: boolean <- string-equal? f-name, "left"
     420     compare left?, 0/false
     421     break-if-=
     422     apply-left args-ah, out, trace
     423     return
     424   }
     425   {
     426     var right?/eax: boolean <- string-equal? f-name, "right"
     427     compare right?, 0/false
     428     break-if-=
     429     apply-right args-ah, out, trace
     430     return
     431   }
     432   {
     433     var cr?/eax: boolean <- string-equal? f-name, "cr"
     434     compare cr?, 0/false
     435     break-if-=
     436     apply-cr args-ah, out, trace
     437     return
     438   }
     439   {
     440     var pixel?/eax: boolean <- string-equal? f-name, "pixel"
     441     compare pixel?, 0/false
     442     break-if-=
     443     apply-pixel args-ah, out, trace
     444     return
     445   }
     446   {
     447     var line?/eax: boolean <- string-equal? f-name, "line"
     448     compare line?, 0/false
     449     break-if-=
     450     apply-line args-ah, out, trace
     451     return
     452   }
     453   {
     454     var hline?/eax: boolean <- string-equal? f-name, "hline"
     455     compare hline?, 0/false
     456     break-if-=
     457     apply-hline args-ah, out, trace
     458     return
     459   }
     460   {
     461     var vline?/eax: boolean <- string-equal? f-name, "vline"
     462     compare vline?, 0/false
     463     break-if-=
     464     apply-vline args-ah, out, trace
     465     return
     466   }
     467   {
     468     var circle?/eax: boolean <- string-equal? f-name, "circle"
     469     compare circle?, 0/false
     470     break-if-=
     471     apply-circle args-ah, out, trace
     472     return
     473   }
     474   {
     475     var bezier?/eax: boolean <- string-equal? f-name, "bezier"
     476     compare bezier?, 0/false
     477     break-if-=
     478     apply-bezier args-ah, out, trace
     479     return
     480   }
     481   {
     482     var width?/eax: boolean <- string-equal? f-name, "width"
     483     compare width?, 0/false
     484     break-if-=
     485     apply-width args-ah, out, trace
     486     return
     487   }
     488   {
     489     var height?/eax: boolean <- string-equal? f-name, "height"
     490     compare height?, 0/false
     491     break-if-=
     492     apply-height args-ah, out, trace
     493     return
     494   }
     495   {
     496     var screen?/eax: boolean <- string-equal? f-name, "new_screen"
     497     compare screen?, 0/false
     498     break-if-=
     499     apply-new-screen args-ah, out, trace
     500     return
     501   }
     502   {
     503     var blit?/eax: boolean <- string-equal? f-name, "blit"
     504     compare blit?, 0/false
     505     break-if-=
     506     apply-blit args-ah, out, trace
     507     return
     508   }
     509   {
     510     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
     511     compare wait-for-key?, 0/false
     512     break-if-=
     513     apply-wait-for-key args-ah, out, trace
     514     return
     515   }
     516   {
     517     var stream?/eax: boolean <- string-equal? f-name, "stream"
     518     compare stream?, 0/false
     519     break-if-=
     520     apply-stream args-ah, out, trace
     521     return
     522   }
     523   {
     524     var write?/eax: boolean <- string-equal? f-name, "write"
     525     compare write?, 0/false
     526     break-if-=
     527     apply-write args-ah, out, trace
     528     return
     529   }
     530   {
     531     var rewind?/eax: boolean <- string-equal? f-name, "rewind"
     532     compare rewind?, 0/false
     533     break-if-=
     534     apply-rewind args-ah, out, trace
     535     return
     536   }
     537   {
     538     var read?/eax: boolean <- string-equal? f-name, "read"
     539     compare read?, 0/false
     540     break-if-=
     541     apply-read args-ah, out, trace
     542     return
     543   }
     544   {
     545     var abort?/eax: boolean <- string-equal? f-name, "abort"
     546     compare abort?, 0/false
     547     break-if-=
     548     apply-abort args-ah, out, trace
     549     return
     550   }
     551   abort "unknown primitive function"
     552 }
     553
     554 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
     555   trace-text trace, "eval", "apply +"
     556   var args-ah/eax: (addr handle cell) <- copy _args-ah
     557   var _args/eax: (addr cell) <- lookup *args-ah
     558   var args/esi: (addr cell) <- copy _args
     559   {
     560     var args-type/eax: (addr int) <- get args, type
     561     compare *args-type, 0/pair
     562     break-if-=
     563     error trace, "args to + are not a list"
     564     return
     565   }
     566   var empty-args?/eax: boolean <- nil? args
     567   compare empty-args?, 0/false
     568   {
     569     break-if-=
     570     error trace, "+ needs 2 args but got 0"
     571     return
     572   }
     573   # args->left->value
     574   var first-ah/eax: (addr handle cell) <- get args, left
     575   var first/eax: (addr cell) <- lookup *first-ah
     576   {
     577     var first-type/eax: (addr int) <- get first, type
     578     compare *first-type, 1/number
     579     break-if-=
     580     error trace, "first arg for + is not a number"
     581     return
     582   }
     583   var first-value/ecx: (addr float) <- get first, number-data
     584   # args->right->left->value
     585   var right-ah/eax: (addr handle cell) <- get args, right
     586   var right/eax: (addr cell) <- lookup *right-ah
     587   {
     588     var right-type/eax: (addr int) <- get right, type
     589     compare *right-type, 0/pair
     590     break-if-=
     591     error trace, "+ encountered non-pair"
     592     return
     593   }
     594   {
     595     var nil?/eax: boolean <- nil? right
     596     compare nil?, 0/false
     597     break-if-=
     598     error trace, "+ needs 2 args but got 1"
     599     return
     600   }
     601   var second-ah/eax: (addr handle cell) <- get right, left
     602   var second/eax: (addr cell) <- lookup *second-ah
     603   {
     604     var second-type/eax: (addr int) <- get second, type
     605     compare *second-type, 1/number
     606     break-if-=
     607     error trace, "second arg for + is not a number"
     608     return
     609   }
     610   var second-value/edx: (addr float) <- get second, number-data
     611   # add
     612   var result/xmm0: float <- copy *first-value
     613   result <- add *second-value
     614   new-float out, result
     615 }
     616
     617 fn test-evaluate-missing-arg-in-add {
     618   var t-storage: trace
     619   var t/edi: (addr trace) <- address t-storage
     620   initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible  # we don't use trace UI
     621   #
     622   var nil-storage: (handle cell)
     623   var nil-ah/ecx: (addr handle cell) <- address nil-storage
     624   allocate-pair nil-ah
     625   var one-storage: (handle cell)
     626   var one-ah/edx: (addr handle cell) <- address one-storage
     627   new-integer one-ah, 1
     628   var add-storage: (handle cell)
     629   var add-ah/ebx: (addr handle cell) <- address add-storage
     630   new-symbol add-ah, "+"
     631   # input is (+ 1)
     632   var tmp-storage: (handle cell)
     633   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
     634   new-pair tmp-ah, *one-ah, *nil-ah
     635   new-pair tmp-ah, *add-ah, *tmp-ah
     636 #?   dump-cell tmp-ah
     637   #
     638   var globals-storage: global-table
     639   var globals/edx: (addr global-table) <- address globals-storage
     640   initialize-globals globals
     641   #
     642   evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
     643   # no crash
     644 }
     645
     646 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
     647   trace-text trace, "eval", "apply -"
     648   var args-ah/eax: (addr handle cell) <- copy _args-ah
     649   var _args/eax: (addr cell) <- lookup *args-ah
     650   var args/esi: (addr cell) <- copy _args
     651   {
     652     var args-type/eax: (addr int) <- get args, type
     653     compare *args-type, 0/pair
     654     break-if-=
     655     error trace, "args to - are not a list"
     656     return
     657   }
     658   var empty-args?/eax: boolean <- nil? args
     659   compare empty-args?, 0/false
     660   {
     661     break-if-=
     662     error trace, "- needs 2 args but got 0"
     663     return
     664   }
     665   # args->left->value
     666   var first-ah/eax: (addr handle cell) <- get args, left
     667   var first/eax: (addr cell) <- lookup *first-ah
     668   {
     669     var first-type/eax: (addr int) <- get first, type
     670     compare *first-type, 1/number
     671     break-if-=
     672     error trace, "first arg for - is not a number"
     673     return
     674   }
     675   var first-value/ecx: (addr float) <- get first, number-data
     676   # args->right->left->value
     677   var right-ah/eax: (addr handle cell) <- get args, right
     678   var right/eax: (addr cell) <- lookup *right-ah
     679   {
     680     var right-type/eax: (addr int) <- get right, type
     681     compare *right-type, 0/pair
     682     break-if-=
     683     error trace, "- encountered non-pair"
     684     return
     685   }
     686   {
     687     var nil?/eax: boolean <- nil? right
     688     compare nil?, 0/false
     689     break-if-=
     690     error trace, "- needs 2 args but got 1"
     691     return
     692   }
     693   var second-ah/eax: (addr handle cell) <- get right, left
     694   var second/eax: (addr cell) <- lookup *second-ah
     695   {
     696     var second-type/eax: (addr int) <- get second, type
     697     compare *second-type, 1/number
     698     break-if-=
     699     error trace, "second arg for - is not a number"
     700     return
     701   }
     702   var second-value/edx: (addr float) <- get second, number-data
     703   # subtract
     704   var result/xmm0: float <- copy *first-value
     705   result <- subtract *second-value
     706   new-float out, result
     707 }
     708
     709 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
     710   trace-text trace, "eval", "apply *"
     711   var args-ah/eax: (addr handle cell) <- copy _args-ah
     712   var _args/eax: (addr cell) <- lookup *args-ah
     713   var args/esi: (addr cell) <- copy _args
     714   {
     715     var args-type/eax: (addr int) <- get args, type
     716     compare *args-type, 0/pair
     717     break-if-=
     718     error trace, "args to * are not a list"
     719     return
     720   }
     721   var empty-args?/eax: boolean <- nil? args
     722   compare empty-args?, 0/false
     723   {
     724     break-if-=
     725     error trace, "* needs 2 args but got 0"
     726     return
     727   }
     728   # args->left->value
     729   var first-ah/eax: (addr handle cell) <- get args, left
     730   var first/eax: (addr cell) <- lookup *first-ah
     731   {
     732     var first-type/eax: (addr int) <- get first, type
     733     compare *first-type, 1/number
     734     break-if-=
     735     error trace, "first arg for * is not a number"
     736     return
     737   }
     738   var first-value/ecx: (addr float) <- get first, number-data
     739   # args->right->left->value
     740   var right-ah/eax: (addr handle cell) <- get args, right
     741   var right/eax: (addr cell) <- lookup *right-ah
     742   {
     743     var right-type/eax: (addr int) <- get right, type
     744     compare *right-type, 0/pair
     745     break-if-=
     746     error trace, "* encountered non-pair"
     747     return
     748   }
     749   {
     750     var nil?/eax: boolean <- nil? right
     751     compare nil?, 0/false
     752     break-if-=
     753     error trace, "* needs 2 args but got 1"
     754     return
     755   }
     756   var second-ah/eax: (addr handle cell) <- get right, left
     757   var second/eax: (addr cell) <- lookup *second-ah
     758   {
     759     var second-type/eax: (addr int) <- get second, type
     760     compare *second-type, 1/number
     761     break-if-=
     762     error trace, "second arg for * is not a number"
     763     return
     764   }
     765   var second-value/edx: (addr float) <- get second, number-data
     766   # multiply
     767   var result/xmm0: float <- copy *first-value
     768   result <- multiply *second-value
     769   new-float out, result
     770 }
     771
     772 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
     773   trace-text trace, "eval", "apply /"
     774   var args-ah/eax: (addr handle cell) <- copy _args-ah
     775   var _args/eax: (addr cell) <- lookup *args-ah
     776   var args/esi: (addr cell) <- copy _args
     777   {
     778     var args-type/eax: (addr int) <- get args, type
     779     compare *args-type, 0/pair
     780     break-if-=
     781     error trace, "args to / are not a list"
     782     return
     783   }
     784   var empty-args?/eax: boolean <- nil? args
     785   compare empty-args?, 0/false
     786   {
     787     break-if-=
     788     error trace, "/ needs 2 args but got 0"
     789     return
     790   }
     791   # args->left->value
     792   var first-ah/eax: (addr handle cell) <- get args, left
     793   var first/eax: (addr cell) <- lookup *first-ah
     794   {
     795     var first-type/eax: (addr int) <- get first, type
     796     compare *first-type, 1/number
     797     break-if-=
     798     error trace, "first arg for / is not a number"
     799     return
     800   }
     801   var first-value/ecx: (addr float) <- get first, number-data
     802   # args->right->left->value
     803   var right-ah/eax: (addr handle cell) <- get args, right
     804   var right/eax: (addr cell) <- lookup *right-ah
     805   {
     806     var right-type/eax: (addr int) <- get right, type
     807     compare *right-type, 0/pair
     808     break-if-=
     809     error trace, "/ encountered non-pair"
     810     return
     811   }
     812   {
     813     var nil?/eax: boolean <- nil? right
     814     compare nil?, 0/false
     815     break-if-=
     816     error trace, "/ needs 2 args but got 1"
     817     return
     818   }
     819   var second-ah/eax: (addr handle cell) <- get right, left
     820   var second/eax: (addr cell) <- lookup *second-ah
     821   {
     822     var second-type/eax: (addr int) <- get second, type
     823     compare *second-type, 1/number
     824     break-if-=
     825     error trace, "second arg for / is not a number"
     826     return
     827   }
     828   var second-value/edx: (addr float) <- get second, number-data
     829   # divide
     830   var result/xmm0: float <- copy *first-value
     831   result <- divide *second-value
     832   new-float out, result
     833 }
     834
     835 fn apply-remainder _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
     836   trace-text trace, "eval", "apply %"
     837   var args-ah/eax: (addr handle cell) <- copy _args-ah
     838   var _args/eax: (addr cell) <- lookup *args-ah
     839   var args/esi: (addr cell) <- copy _args
     840   {
     841     var args-type/eax: (addr int) <- get args, type
     842     compare *args-type, 0/pair
     843     break-if-=
     844     error trace, "args to % are not a list"
     845     return
     846   }
     847   var empty-args?/eax: boolean <- nil? args
     848   compare empty-args?, 0/false
     849   {
     850     break-if-=
     851     error trace, "% needs 2 args but got 0"
     852     return
     853   }
     854   # args->left->value
     855   var first-ah/eax: (addr handle cell) <- get args, left
     856   var first/eax: (addr cell) <- lookup *first-ah
     857   {
     858     var first-type/eax: (addr int) <- get first, type
     859     compare *first-type, 1/number
     860     break-if-=
     861     error trace, "first arg for % is not a number"
     862     return
     863   }
     864   var first-value/ecx: (addr float) <- get first, number-data
     865   # args->right->left->value
     866   var right-ah/eax: (addr handle cell) <- get args, right
     867   var right/eax: (addr cell) <- lookup *right-ah
     868   {
     869     var right-type/eax: (addr int) <- get right, type
     870     compare *right-type, 0/pair
     871     break-if-=
     872     error trace, "% encountered non-pair"
     873     return
     874   }
     875   {
     876     var nil?/eax: boolean <- nil? right
     877     compare nil?, 0/false
     878     break-if-=
     879     error trace, "% needs 2 args but got 1"
     880     return
     881   }
     882   var second-ah/eax: (addr handle cell) <- get right, left
     883   var second/eax: (addr cell) <- lookup *second-ah
     884   {
     885     var second-type/eax: (addr int) <- get second, type
     886     compare *second-type, 1/number
     887     break-if-=
     888     error trace, "second arg for % is not a number"
     889     return
     890   }
     891   var second-value/edx: (addr float) <- get second, number-data
     892   # divide
     893   var quotient/xmm0: float <- copy *first-value
     894   quotient <- divide *second-value
     895   var quotient-int/eax: int <- truncate quotient
     896   quotient <- convert quotient-int
     897   var sub-result/xmm1: float <- copy quotient
     898   sub-result <- multiply *second-value
     899   var result/xmm0: float <- copy *first-value
     900   result <- subtract sub-result
     901   new-float out, result
     902 }
     903
     904 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
     905   trace-text trace, "eval", "apply sqrt"
     906   var args-ah/eax: (addr handle cell) <- copy _args-ah
     907   var _args/eax: (addr cell) <- lookup *args-ah
     908   var args/esi: (addr cell) <- copy _args
     909   {
     910     var args-type/eax: (addr int) <- get args, type
     911     compare *args-type, 0/pair
     912     break-if-=
     913     error trace, "args to sqrt are not a list"
     914     return
     915   }
     916   var empty-args?/eax: boolean <- nil? args
     917   compare empty-args?, 0/false
     918   {
     919     break-if-=
     920     error trace, "sqrt needs 1 arg but got 0"
     921     return
     922   }
     923   # args->left->value
     924   var first-ah/eax: (addr handle cell) <- get args, left
     925   var first/eax: (addr cell) <- lookup *first-ah
     926   {
     927     var first-type/eax: (addr int) <- get first, type
     928     compare *first-type, 1/number
     929     break-if-=
     930     error trace, "arg for sqrt is not a number"
     931     return
     932   }
     933   var first-value/eax: (addr float) <- get first, number-data
     934   # square-root
     935   var result/xmm0: float <- square-root *first-value
     936   new-float out, result
     937 }
     938
     939 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
     940   trace-text trace, "eval", "apply abs"
     941   var args-ah/eax: (addr handle cell) <- copy _args-ah
     942   var _args/eax: (addr cell) <- lookup *args-ah
     943   var args/esi: (addr cell) <- copy _args
     944   {
     945     var args-type/eax: (addr int) <- get args, type
     946     compare *args-type, 0/pair
     947     break-if-=
     948     error trace, "args to abs are not a list"
     949     return
     950   }
     951   var empty-args?/eax: boolean <- nil? args
     952   compare empty-args?, 0/false
     953   {
     954     break-if-=
     955     error trace, "abs needs 1 arg but got 0"
     956     return
     957   }
     958   # args->left->value
     959   var first-ah/eax: (addr handle cell) <- get args, left
     960   var first/eax: (addr cell) <- lookup *first-ah
     961   {
     962     var first-type/eax: (addr int) <- get first, type
     963     compare *first-type, 1/number
     964     break-if-=
     965     error trace, "arg for abs is not a number"
     966     return
     967   }
     968   var first-value/ecx: (addr float) <- get first, number-data
     969   #
     970   var result/xmm0: float <- copy *first-value
     971   var zero: float
     972   compare result, zero
     973   {
     974     break-if-float>=
     975     var neg1/eax: int <- copy -1
     976     var neg1-f/xmm1: float <- convert neg1
     977     result <- multiply neg1-f
     978   }
     979   new-float out, result
     980 }
     981
     982 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
     983   trace-text trace, "eval", "apply sgn"
     984   var args-ah/eax: (addr handle cell) <- copy _args-ah
     985   var _args/eax: (addr cell) <- lookup *args-ah
     986   var args/esi: (addr cell) <- copy _args
     987   {
     988     var args-type/eax: (addr int) <- get args, type
     989     compare *args-type, 0/pair
     990     break-if-=
     991     error trace, "args to sgn are not a list"
     992     return
     993   }
     994   var empty-args?/eax: boolean <- nil? args
     995   compare empty-args?, 0/false
     996   {
     997     break-if-=
     998     error trace, "sgn needs 1 arg but got 0"
     999     return
    1000   }
    1001   # args->left->value
    1002   var first-ah/eax: (addr handle cell) <- get args, left
    1003   var first/eax: (addr cell) <- lookup *first-ah
    1004   {
    1005     var first-type/eax: (addr int) <- get first, type
    1006     compare *first-type, 1/number
    1007     break-if-=
    1008     error trace, "arg for sgn is not a number"
    1009     return
    1010   }
    1011   var first-value/ecx: (addr float) <- get first, number-data
    1012   #
    1013   var result/xmm0: float <- copy *first-value
    1014   var zero: float
    1015   $apply-sgn:core: {
    1016     compare result, zero
    1017     break-if-=
    1018     {
    1019       break-if-float>
    1020       var neg1/eax: int <- copy -1
    1021       result <- convert neg1
    1022       break $apply-sgn:core
    1023     }
    1024     {
    1025       break-if-float<
    1026       var one/eax: int <- copy 1
    1027       result <- convert one
    1028       break $apply-sgn:core
    1029     }
    1030   }
    1031   new-float out, result
    1032 }
    1033
    1034 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1035   trace-text trace, "eval", "apply car"
    1036   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1037   var _args/eax: (addr cell) <- lookup *args-ah
    1038   var args/esi: (addr cell) <- copy _args
    1039   {
    1040     var args-type/eax: (addr int) <- get args, type
    1041     compare *args-type, 0/pair
    1042     break-if-=
    1043     error trace, "args to car are not a list"
    1044     return
    1045   }
    1046   var empty-args?/eax: boolean <- nil? args
    1047   compare empty-args?, 0/false
    1048   {
    1049     break-if-=
    1050     error trace, "car needs 1 arg but got 0"
    1051     return
    1052   }
    1053   # args->left
    1054   var first-ah/edx: (addr handle cell) <- get args, left
    1055   var first/eax: (addr cell) <- lookup *first-ah
    1056   {
    1057     var first-type/eax: (addr int) <- get first, type
    1058     compare *first-type, 0/pair
    1059     break-if-=
    1060     error trace, "arg for car is not a pair"
    1061     return
    1062   }
    1063   # nil? return nil
    1064   {
    1065     var nil?/eax: boolean <- nil? first
    1066     compare nil?, 0/false
    1067     break-if-=
    1068     copy-object first-ah, out
    1069     return
    1070   }
    1071   # car
    1072   var result/eax: (addr handle cell) <- get first, left
    1073   copy-object result, out
    1074 }
    1075
    1076 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1077   trace-text trace, "eval", "apply cdr"
    1078   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1079   var _args/eax: (addr cell) <- lookup *args-ah
    1080   var args/esi: (addr cell) <- copy _args
    1081   {
    1082     var args-type/eax: (addr int) <- get args, type
    1083     compare *args-type, 0/pair
    1084     break-if-=
    1085     error trace, "args to cdr are not a list"
    1086     return
    1087   }
    1088   var empty-args?/eax: boolean <- nil? args
    1089   compare empty-args?, 0/false
    1090   {
    1091     break-if-=
    1092     error trace, "cdr needs 1 arg but got 0"
    1093     return
    1094   }
    1095   # args->left
    1096   var first-ah/edx: (addr handle cell) <- get args, left
    1097   var first/eax: (addr cell) <- lookup *first-ah
    1098   {
    1099     var first-type/eax: (addr int) <- get first, type
    1100     compare *first-type, 0/pair
    1101     break-if-=
    1102     error trace, "arg for cdr is not a pair"
    1103     return
    1104   }
    1105   # nil? return nil
    1106   {
    1107     var nil?/eax: boolean <- nil? first
    1108     compare nil?, 0/false
    1109     break-if-=
    1110     copy-object first-ah, out
    1111     return
    1112   }
    1113   # cdr
    1114   var result/eax: (addr handle cell) <- get first, right
    1115   copy-object result, out
    1116 }
    1117
    1118 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1119   trace-text trace, "eval", "apply cons"
    1120   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1121   var _args/eax: (addr cell) <- lookup *args-ah
    1122   var args/esi: (addr cell) <- copy _args
    1123   {
    1124     var args-type/eax: (addr int) <- get args, type
    1125     compare *args-type, 0/pair
    1126     break-if-=
    1127     error trace, "args to 'cons' are not a list"
    1128     return
    1129   }
    1130   var empty-args?/eax: boolean <- nil? args
    1131   compare empty-args?, 0/false
    1132   {
    1133     break-if-=
    1134     error trace, "cons needs 2 args but got 0"
    1135     return
    1136   }
    1137   # args->left
    1138   var first-ah/ecx: (addr handle cell) <- get args, left
    1139   # args->right->left
    1140   var right-ah/eax: (addr handle cell) <- get args, right
    1141   var right/eax: (addr cell) <- lookup *right-ah
    1142   {
    1143     var right-type/eax: (addr int) <- get right, type
    1144     compare *right-type, 0/pair
    1145     break-if-=
    1146     error trace, "'cons' encountered non-pair"
    1147     return
    1148   }
    1149   {
    1150     var nil?/eax: boolean <- nil? right
    1151     compare nil?, 0/false
    1152     break-if-=
    1153     error trace, "'cons' needs 2 args but got 1"
    1154     return
    1155   }
    1156   var second-ah/eax: (addr handle cell) <- get right, left
    1157   # cons
    1158   new-pair out, *first-ah, *second-ah
    1159 }
    1160
    1161 fn apply-cons-check _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1162   trace-text trace, "eval", "apply cons?"
    1163   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1164   var _args/eax: (addr cell) <- lookup *args-ah
    1165   var args/esi: (addr cell) <- copy _args
    1166   {
    1167     var args-type/eax: (addr int) <- get args, type
    1168     compare *args-type, 0/pair
    1169     break-if-=
    1170     error trace, "args to cons? are not a list"
    1171     return
    1172   }
    1173   var empty-args?/eax: boolean <- nil? args
    1174   compare empty-args?, 0/false
    1175   {
    1176     break-if-=
    1177     error trace, "cons? needs 1 arg but got 0"
    1178     return
    1179   }
    1180   # args->left
    1181   var first-ah/edx: (addr handle cell) <- get args, left
    1182   var first/eax: (addr cell) <- lookup *first-ah
    1183   {
    1184     var first-type/eax: (addr int) <- get first, type
    1185     compare *first-type, 0/pair
    1186     break-if-=
    1187     nil out
    1188     return
    1189   }
    1190   new-integer out, 1
    1191 }
    1192
    1193
    1194 fn apply-cell-isomorphic _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1195   trace-text trace, "eval", "apply '='"
    1196   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1197   var _args/eax: (addr cell) <- lookup *args-ah
    1198   var args/esi: (addr cell) <- copy _args
    1199   {
    1200     var args-type/eax: (addr int) <- get args, type
    1201     compare *args-type, 0/pair
    1202     break-if-=
    1203     error trace, "args to '=' are not a list"
    1204     return
    1205   }
    1206   var empty-args?/eax: boolean <- nil? args
    1207   compare empty-args?, 0/false
    1208   {
    1209     break-if-=
    1210     error trace, "'=' needs 2 args but got 0"
    1211     return
    1212   }
    1213   # args->left
    1214   var first-ah/ecx: (addr handle cell) <- get args, left
    1215   # args->right->left
    1216   var right-ah/eax: (addr handle cell) <- get args, right
    1217   var right/eax: (addr cell) <- lookup *right-ah
    1218   {
    1219     var right-type/eax: (addr int) <- get right, type
    1220     compare *right-type, 0/pair
    1221     break-if-=
    1222     error trace, "'=' encountered non-pair"
    1223     return
    1224   }
    1225   {
    1226     var nil?/eax: boolean <- nil? right
    1227     compare nil?, 0/false
    1228     break-if-=
    1229     error trace, "'=' needs 2 args but got 1"
    1230     return
    1231   }
    1232   var second-ah/edx: (addr handle cell) <- get right, left
    1233   # compare
    1234   var _first/eax: (addr cell) <- lookup *first-ah
    1235   var first/ecx: (addr cell) <- copy _first
    1236   var second/eax: (addr cell) <- lookup *second-ah
    1237   var match?/eax: boolean <- cell-isomorphic? first, second, trace
    1238   compare match?, 0/false
    1239   {
    1240     break-if-!=
    1241     nil out
    1242     return
    1243   }
    1244   new-integer out, 1/true
    1245 }
    1246
    1247 fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1248   trace-text trace, "eval", "apply 'not'"
    1249   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1250   var _args/eax: (addr cell) <- lookup *args-ah
    1251   var args/esi: (addr cell) <- copy _args
    1252   {
    1253     var args-type/eax: (addr int) <- get args, type
    1254     compare *args-type, 0/pair
    1255     break-if-=
    1256     error trace, "args to 'not' are not a list"
    1257     return
    1258   }
    1259   var empty-args?/eax: boolean <- nil? args
    1260   compare empty-args?, 0/false
    1261   {
    1262     break-if-=
    1263     error trace, "'not' needs 1 arg but got 0"
    1264     return
    1265   }
    1266   # args->left
    1267   var first-ah/eax: (addr handle cell) <- get args, left
    1268   var first/eax: (addr cell) <- lookup *first-ah
    1269   # not
    1270   var nil?/eax: boolean <- nil? first
    1271   compare nil?, 0/false
    1272   {
    1273     break-if-!=
    1274     nil out
    1275     return
    1276   }
    1277   new-integer out, 1
    1278 }
    1279
    1280 fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1281   trace-text trace, "eval", "apply 'debug'"
    1282   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1283   var _args/eax: (addr cell) <- lookup *args-ah
    1284   var args/esi: (addr cell) <- copy _args
    1285   {
    1286     var args-type/eax: (addr int) <- get args, type
    1287     compare *args-type, 0/pair
    1288     break-if-=
    1289     error trace, "args to 'debug' are not a list"
    1290     return
    1291   }
    1292   var empty-args?/eax: boolean <- nil? args
    1293   compare empty-args?, 0/false
    1294   {
    1295     break-if-=
    1296     error trace, "'debug' needs 1 arg but got 0"
    1297     return
    1298   }
    1299   # dump args->left uglily to screen and wait for a keypress
    1300   var first-ah/eax: (addr handle cell) <- get args, left
    1301   dump-cell-from-cursor-over-full-screen first-ah, 7/fg 0/bg
    1302   {
    1303     var foo/eax: byte <- read-key 0/keyboard
    1304     compare foo, 0
    1305     loop-if-=
    1306   }
    1307   # return nothing
    1308 }
    1309
    1310 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1311   trace-text trace, "eval", "apply '<'"
    1312   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1313   var _args/eax: (addr cell) <- lookup *args-ah
    1314   var args/esi: (addr cell) <- copy _args
    1315   {
    1316     var args-type/eax: (addr int) <- get args, type
    1317     compare *args-type, 0/pair
    1318     break-if-=
    1319     error trace, "args to '<' are not a list"
    1320     return
    1321   }
    1322   var empty-args?/eax: boolean <- nil? args
    1323   compare empty-args?, 0/false
    1324   {
    1325     break-if-=
    1326     error trace, "'<' needs 2 args but got 0"
    1327     return
    1328   }
    1329   # args->left
    1330   var first-ah/ecx: (addr handle cell) <- get args, left
    1331   # args->right->left
    1332   var right-ah/eax: (addr handle cell) <- get args, right
    1333   var right/eax: (addr cell) <- lookup *right-ah
    1334   {
    1335     var right-type/eax: (addr int) <- get right, type
    1336     compare *right-type, 0/pair
    1337     break-if-=
    1338     error trace, "'<' encountered non-pair"
    1339     return
    1340   }
    1341   {
    1342     var nil?/eax: boolean <- nil? right
    1343     compare nil?, 0/false
    1344     break-if-=
    1345     error trace, "'<' needs 2 args but got 1"
    1346     return
    1347   }
    1348   var second-ah/edx: (addr handle cell) <- get right, left
    1349   # compare
    1350   var _first/eax: (addr cell) <- lookup *first-ah
    1351   var first/ecx: (addr cell) <- copy _first
    1352   {
    1353     var first-type/eax: (addr int) <- get first, type
    1354     compare *first-type, 1/number
    1355     break-if-=
    1356     error trace, "first arg for '<' is not a number"
    1357     return
    1358   }
    1359   var first-value/ecx: (addr float) <- get first, number-data
    1360   var first-float/xmm0: float <- copy *first-value
    1361   var second/eax: (addr cell) <- lookup *second-ah
    1362   {
    1363     var second-type/eax: (addr int) <- get second, type
    1364     compare *second-type, 1/number
    1365     break-if-=
    1366     error trace, "second arg for '<' is not a number"
    1367     return
    1368   }
    1369   var second-value/eax: (addr float) <- get second, number-data
    1370   compare first-float, *second-value
    1371   {
    1372     break-if-float<
    1373     nil out
    1374     return
    1375   }
    1376   new-integer out, 1/true
    1377 }
    1378
    1379 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1380   trace-text trace, "eval", "apply '>'"
    1381   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1382   var _args/eax: (addr cell) <- lookup *args-ah
    1383   var args/esi: (addr cell) <- copy _args
    1384   {
    1385     var args-type/eax: (addr int) <- get args, type
    1386     compare *args-type, 0/pair
    1387     break-if-=
    1388     error trace, "args to '>' are not a list"
    1389     return
    1390   }
    1391   var empty-args?/eax: boolean <- nil? args
    1392   compare empty-args?, 0/false
    1393   {
    1394     break-if-=
    1395     error trace, "'>' needs 2 args but got 0"
    1396     return
    1397   }
    1398   # args->left
    1399   var first-ah/ecx: (addr handle cell) <- get args, left
    1400   # args->right->left
    1401   var right-ah/eax: (addr handle cell) <- get args, right
    1402   var right/eax: (addr cell) <- lookup *right-ah
    1403   {
    1404     var right-type/eax: (addr int) <- get right, type
    1405     compare *right-type, 0/pair
    1406     break-if-=
    1407     error trace, "'>' encountered non-pair"
    1408     return
    1409   }
    1410   {
    1411     var nil?/eax: boolean <- nil? right
    1412     compare nil?, 0/false
    1413     break-if-=
    1414     error trace, "'>' needs 2 args but got 1"
    1415     return
    1416   }
    1417   var second-ah/edx: (addr handle cell) <- get right, left
    1418   # compare
    1419   var _first/eax: (addr cell) <- lookup *first-ah
    1420   var first/ecx: (addr cell) <- copy _first
    1421   {
    1422     var first-type/eax: (addr int) <- get first, type
    1423     compare *first-type, 1/number
    1424     break-if-=
    1425     error trace, "first arg for '>' is not a number"
    1426     return
    1427   }
    1428   var first-value/ecx: (addr float) <- get first, number-data
    1429   var first-float/xmm0: float <- copy *first-value
    1430   var second/eax: (addr cell) <- lookup *second-ah
    1431   {
    1432     var second-type/eax: (addr int) <- get second, type
    1433     compare *second-type, 1/number
    1434     break-if-=
    1435     error trace, "second arg for '>' is not a number"
    1436     return
    1437   }
    1438   var second-value/eax: (addr float) <- get second, number-data
    1439   compare first-float, *second-value
    1440   {
    1441     break-if-float>
    1442     nil out
    1443     return
    1444   }
    1445   new-integer out, 1/true
    1446 }
    1447
    1448 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1449   trace-text trace, "eval", "apply '<='"
    1450   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1451   var _args/eax: (addr cell) <- lookup *args-ah
    1452   var args/esi: (addr cell) <- copy _args
    1453   {
    1454     var args-type/eax: (addr int) <- get args, type
    1455     compare *args-type, 0/pair
    1456     break-if-=
    1457     error trace, "args to '<=' are not a list"
    1458     return
    1459   }
    1460   var empty-args?/eax: boolean <- nil? args
    1461   compare empty-args?, 0/false
    1462   {
    1463     break-if-=
    1464     error trace, "'<=' needs 2 args but got 0"
    1465     return
    1466   }
    1467   # args->left
    1468   var first-ah/ecx: (addr handle cell) <- get args, left
    1469   # args->right->left
    1470   var right-ah/eax: (addr handle cell) <- get args, right
    1471   var right/eax: (addr cell) <- lookup *right-ah
    1472   {
    1473     var right-type/eax: (addr int) <- get right, type
    1474     compare *right-type, 0/pair
    1475     break-if-=
    1476     error trace, "'<=' encountered non-pair"
    1477     return
    1478   }
    1479   {
    1480     var nil?/eax: boolean <- nil? right
    1481     compare nil?, 0/false
    1482     break-if-=
    1483     error trace, "'<=' needs 2 args but got 1"
    1484     return
    1485   }
    1486   var second-ah/edx: (addr handle cell) <- get right, left
    1487   # compare
    1488   var _first/eax: (addr cell) <- lookup *first-ah
    1489   var first/ecx: (addr cell) <- copy _first
    1490   {
    1491     var first-type/eax: (addr int) <- get first, type
    1492     compare *first-type, 1/number
    1493     break-if-=
    1494     error trace, "first arg for '<=' is not a number"
    1495     return
    1496   }
    1497   var first-value/ecx: (addr float) <- get first, number-data
    1498   var first-float/xmm0: float <- copy *first-value
    1499   var second/eax: (addr cell) <- lookup *second-ah
    1500   {
    1501     var second-type/eax: (addr int) <- get second, type
    1502     compare *second-type, 1/number
    1503     break-if-=
    1504     error trace, "second arg for '<=' is not a number"
    1505     return
    1506   }
    1507   var second-value/eax: (addr float) <- get second, number-data
    1508   compare first-float, *second-value
    1509   {
    1510     break-if-float<=
    1511     nil out
    1512     return
    1513   }
    1514   new-integer out, 1/true
    1515 }
    1516
    1517 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1518   trace-text trace, "eval", "apply '>='"
    1519   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1520   var _args/eax: (addr cell) <- lookup *args-ah
    1521   var args/esi: (addr cell) <- copy _args
    1522   {
    1523     var args-type/eax: (addr int) <- get args, type
    1524     compare *args-type, 0/pair
    1525     break-if-=
    1526     error trace, "args to '>=' are not a list"
    1527     return
    1528   }
    1529   var empty-args?/eax: boolean <- nil? args
    1530   compare empty-args?, 0/false
    1531   {
    1532     break-if-=
    1533     error trace, "'>=' needs 2 args but got 0"
    1534     return
    1535   }
    1536   # args->left
    1537   var first-ah/ecx: (addr handle cell) <- get args, left
    1538   # args->right->left
    1539   var right-ah/eax: (addr handle cell) <- get args, right
    1540   var right/eax: (addr cell) <- lookup *right-ah
    1541   {
    1542     var right-type/eax: (addr int) <- get right, type
    1543     compare *right-type, 0/pair
    1544     break-if-=
    1545     error trace, "'>=' encountered non-pair"
    1546     return
    1547   }
    1548   {
    1549     var nil?/eax: boolean <- nil? right
    1550     compare nil?, 0/false
    1551     break-if-=
    1552     error trace, "'>=' needs 2 args but got 1"
    1553     return
    1554   }
    1555   var second-ah/edx: (addr handle cell) <- get right, left
    1556   # compare
    1557   var _first/eax: (addr cell) <- lookup *first-ah
    1558   var first/ecx: (addr cell) <- copy _first
    1559   {
    1560     var first-type/eax: (addr int) <- get first, type
    1561     compare *first-type, 1/number
    1562     break-if-=
    1563     error trace, "first arg for '>=' is not a number"
    1564     return
    1565   }
    1566   var first-value/ecx: (addr float) <- get first, number-data
    1567   var first-float/xmm0: float <- copy *first-value
    1568   var second/eax: (addr cell) <- lookup *second-ah
    1569   {
    1570     var second-type/eax: (addr int) <- get second, type
    1571     compare *second-type, 1/number
    1572     break-if-=
    1573     error trace, "second arg for '>=' is not a number"
    1574     return
    1575   }
    1576   var second-value/eax: (addr float) <- get second, number-data
    1577   compare first-float, *second-value
    1578   {
    1579     break-if-float>=
    1580     nil out
    1581     return
    1582   }
    1583   new-integer out, 1/true
    1584 }
    1585
    1586 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1587   trace-text trace, "eval", "apply 'print'"
    1588   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1589   var _args/eax: (addr cell) <- lookup *args-ah
    1590   var args/esi: (addr cell) <- copy _args
    1591   {
    1592     var args-type/eax: (addr int) <- get args, type
    1593     compare *args-type, 0/pair
    1594     break-if-=
    1595     error trace, "args to 'print' are not a list"
    1596     return
    1597   }
    1598   var empty-args?/eax: boolean <- nil? args
    1599   compare empty-args?, 0/false
    1600   {
    1601     break-if-=
    1602     error trace, "'print' needs 2 args but got 0"
    1603     return
    1604   }
    1605   # screen = args->left
    1606   var first-ah/eax: (addr handle cell) <- get args, left
    1607   var first/eax: (addr cell) <- lookup *first-ah
    1608   {
    1609     var first-type/eax: (addr int) <- get first, type
    1610     compare *first-type, 5/screen
    1611     break-if-=
    1612     error trace, "first arg for 'print' is not a screen"
    1613     return
    1614   }
    1615   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    1616   var _screen/eax: (addr screen) <- lookup *screen-ah
    1617   var screen/ecx: (addr screen) <- copy _screen
    1618   # args->right->left
    1619   var right-ah/eax: (addr handle cell) <- get args, right
    1620   var right/eax: (addr cell) <- lookup *right-ah
    1621   {
    1622     var right-type/eax: (addr int) <- get right, type
    1623     compare *right-type, 0/pair
    1624     break-if-=
    1625     error trace, "'print' encountered non-pair"
    1626     return
    1627   }
    1628   {
    1629     var nil?/eax: boolean <- nil? right
    1630     compare nil?, 0/false
    1631     break-if-=
    1632     error trace, "'print' needs 2 args but got 1"
    1633     return
    1634   }
    1635   var second-ah/eax: (addr handle cell) <- get right, left
    1636   var stream-storage: (stream byte 0x100)
    1637   var stream/edi: (addr stream byte) <- address stream-storage
    1638   print-cell second-ah, stream, trace
    1639   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
    1640   # return what was printed
    1641   copy-object second-ah, out
    1642 }
    1643
    1644 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1645   trace-text trace, "eval", "apply 'clear'"
    1646   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1647   var _args/eax: (addr cell) <- lookup *args-ah
    1648   var args/esi: (addr cell) <- copy _args
    1649   {
    1650     var args-type/eax: (addr int) <- get args, type
    1651     compare *args-type, 0/pair
    1652     break-if-=
    1653     error trace, "args to 'clear' are not a list"
    1654     return
    1655   }
    1656   var empty-args?/eax: boolean <- nil? args
    1657   compare empty-args?, 0/false
    1658   {
    1659     break-if-=
    1660     error trace, "'clear' needs 1 arg but got 0"
    1661     return
    1662   }
    1663   # screen = args->left
    1664   var first-ah/eax: (addr handle cell) <- get args, left
    1665   var first/eax: (addr cell) <- lookup *first-ah
    1666   var first-type/ecx: (addr int) <- get first, type
    1667   compare *first-type, 3/stream
    1668   {
    1669     break-if-!=
    1670     var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
    1671     var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
    1672     var stream-data/ebx: (addr stream byte) <- copy _stream-data
    1673     clear-stream stream-data
    1674     return
    1675   }
    1676   compare *first-type, 5/screen
    1677   {
    1678     break-if-!=
    1679     var screen-ah/eax: (addr handle screen) <- get first, screen-data
    1680     var _screen/eax: (addr screen) <- lookup *screen-ah
    1681     var screen/ecx: (addr screen) <- copy _screen
    1682     clear-screen screen
    1683     return
    1684   }
    1685   error trace, "first arg for 'clear' is not a screen or a stream"
    1686 }
    1687
    1688 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1689   trace-text trace, "eval", "apply 'up'"
    1690   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1691   var _args/eax: (addr cell) <- lookup *args-ah
    1692   var args/esi: (addr cell) <- copy _args
    1693   {
    1694     var args-type/eax: (addr int) <- get args, type
    1695     compare *args-type, 0/pair
    1696     break-if-=
    1697     error trace, "args to 'up' are not a list"
    1698     return
    1699   }
    1700   var empty-args?/eax: boolean <- nil? args
    1701   compare empty-args?, 0/false
    1702   {
    1703     break-if-=
    1704     error trace, "'up' needs 1 arg but got 0"
    1705     return
    1706   }
    1707   # screen = args->left
    1708   var first-ah/eax: (addr handle cell) <- get args, left
    1709   var first/eax: (addr cell) <- lookup *first-ah
    1710   {
    1711     var first-type/eax: (addr int) <- get first, type
    1712     compare *first-type, 5/screen
    1713     break-if-=
    1714     error trace, "first arg for 'up' is not a screen"
    1715     return
    1716   }
    1717   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    1718   var _screen/eax: (addr screen) <- lookup *screen-ah
    1719   var screen/ecx: (addr screen) <- copy _screen
    1720   #
    1721   move-cursor-up screen
    1722 }
    1723
    1724 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1725   trace-text trace, "eval", "apply 'down'"
    1726   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1727   var _args/eax: (addr cell) <- lookup *args-ah
    1728   var args/esi: (addr cell) <- copy _args
    1729   {
    1730     var args-type/eax: (addr int) <- get args, type
    1731     compare *args-type, 0/pair
    1732     break-if-=
    1733     error trace, "args to 'down' are not a list"
    1734     return
    1735   }
    1736   var empty-args?/eax: boolean <- nil? args
    1737   compare empty-args?, 0/false
    1738   {
    1739     break-if-=
    1740     error trace, "'down' needs 1 arg but got 0"
    1741     return
    1742   }
    1743   # screen = args->left
    1744   var first-ah/eax: (addr handle cell) <- get args, left
    1745   var first/eax: (addr cell) <- lookup *first-ah
    1746   {
    1747     var first-type/eax: (addr int) <- get first, type
    1748     compare *first-type, 5/screen
    1749     break-if-=
    1750     error trace, "first arg for 'down' is not a screen"
    1751     return
    1752   }
    1753   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    1754   var _screen/eax: (addr screen) <- lookup *screen-ah
    1755   var screen/ecx: (addr screen) <- copy _screen
    1756   #
    1757   move-cursor-down screen
    1758 }
    1759
    1760 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1761   trace-text trace, "eval", "apply 'left'"
    1762   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1763   var _args/eax: (addr cell) <- lookup *args-ah
    1764   var args/esi: (addr cell) <- copy _args
    1765   {
    1766     var args-type/eax: (addr int) <- get args, type
    1767     compare *args-type, 0/pair
    1768     break-if-=
    1769     error trace, "args to 'left' are not a list"
    1770     return
    1771   }
    1772   var empty-args?/eax: boolean <- nil? args
    1773   compare empty-args?, 0/false
    1774   {
    1775     break-if-=
    1776     error trace, "'left' needs 1 arg but got 0"
    1777     return
    1778   }
    1779   # screen = args->left
    1780   var first-ah/eax: (addr handle cell) <- get args, left
    1781   var first/eax: (addr cell) <- lookup *first-ah
    1782   {
    1783     var first-type/eax: (addr int) <- get first, type
    1784     compare *first-type, 5/screen
    1785     break-if-=
    1786     error trace, "first arg for 'left' is not a screen"
    1787     return
    1788   }
    1789   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    1790   var _screen/eax: (addr screen) <- lookup *screen-ah
    1791   var screen/ecx: (addr screen) <- copy _screen
    1792   #
    1793   move-cursor-left screen
    1794 }
    1795
    1796 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1797   trace-text trace, "eval", "apply 'right'"
    1798   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1799   var _args/eax: (addr cell) <- lookup *args-ah
    1800   var args/esi: (addr cell) <- copy _args
    1801   {
    1802     var args-type/eax: (addr int) <- get args, type
    1803     compare *args-type, 0/pair
    1804     break-if-=
    1805     error trace, "args to 'right' are not a list"
    1806     return
    1807   }
    1808   var empty-args?/eax: boolean <- nil? args
    1809   compare empty-args?, 0/false
    1810   {
    1811     break-if-=
    1812     error trace, "'right' needs 1 arg but got 0"
    1813     return
    1814   }
    1815   # screen = args->left
    1816   var first-ah/eax: (addr handle cell) <- get args, left
    1817   var first/eax: (addr cell) <- lookup *first-ah
    1818   {
    1819     var first-type/eax: (addr int) <- get first, type
    1820     compare *first-type, 5/screen
    1821     break-if-=
    1822     error trace, "first arg for 'right' is not a screen"
    1823     return
    1824   }
    1825   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    1826   var _screen/eax: (addr screen) <- lookup *screen-ah
    1827   var screen/ecx: (addr screen) <- copy _screen
    1828   #
    1829   move-cursor-right screen
    1830 }
    1831
    1832 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1833   trace-text trace, "eval", "apply 'cr'"
    1834   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1835   var _args/eax: (addr cell) <- lookup *args-ah
    1836   var args/esi: (addr cell) <- copy _args
    1837   {
    1838     var args-type/eax: (addr int) <- get args, type
    1839     compare *args-type, 0/pair
    1840     break-if-=
    1841     error trace, "args to 'cr' are not a list"
    1842     return
    1843   }
    1844   var empty-args?/eax: boolean <- nil? args
    1845   compare empty-args?, 0/false
    1846   {
    1847     break-if-=
    1848     error trace, "'cr' needs 1 arg but got 0"
    1849     return
    1850   }
    1851   # screen = args->left
    1852   var first-ah/eax: (addr handle cell) <- get args, left
    1853   var first/eax: (addr cell) <- lookup *first-ah
    1854   {
    1855     var first-type/eax: (addr int) <- get first, type
    1856     compare *first-type, 5/screen
    1857     break-if-=
    1858     error trace, "first arg for 'cr' is not a screen"
    1859     return
    1860   }
    1861   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    1862   var _screen/eax: (addr screen) <- lookup *screen-ah
    1863   var screen/ecx: (addr screen) <- copy _screen
    1864   #
    1865   move-cursor-to-left-margin-of-next-line screen
    1866 }
    1867
    1868 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1869   trace-text trace, "eval", "apply 'pixel'"
    1870   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1871   var _args/eax: (addr cell) <- lookup *args-ah
    1872   var args/esi: (addr cell) <- copy _args
    1873   {
    1874     var args-type/eax: (addr int) <- get args, type
    1875     compare *args-type, 0/pair
    1876     break-if-=
    1877     error trace, "args to 'pixel' are not a list"
    1878     return
    1879   }
    1880   var empty-args?/eax: boolean <- nil? args
    1881   compare empty-args?, 0/false
    1882   {
    1883     break-if-=
    1884     error trace, "'pixel' needs 4 args but got 0"
    1885     return
    1886   }
    1887   # screen = args->left
    1888   var first-ah/eax: (addr handle cell) <- get args, left
    1889   var first/eax: (addr cell) <- lookup *first-ah
    1890   {
    1891     var first-type/eax: (addr int) <- get first, type
    1892     compare *first-type, 5/screen
    1893     break-if-=
    1894     error trace, "first arg for 'pixel' is not a screen"
    1895     return
    1896   }
    1897   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    1898   var _screen/eax: (addr screen) <- lookup *screen-ah
    1899   var screen/edi: (addr screen) <- copy _screen
    1900   # x = args->right->left->value
    1901   var rest-ah/eax: (addr handle cell) <- get args, right
    1902   var _rest/eax: (addr cell) <- lookup *rest-ah
    1903   var rest/esi: (addr cell) <- copy _rest
    1904   {
    1905     var rest-type/eax: (addr int) <- get rest, type
    1906     compare *rest-type, 0/pair
    1907     break-if-=
    1908     error trace, "'pixel' encountered non-pair"
    1909     return
    1910   }
    1911   {
    1912     var rest-nil?/eax: boolean <- nil? rest
    1913     compare rest-nil?, 0/false
    1914     break-if-=
    1915     error trace, "'pixel' needs 4 args but got 1"
    1916     return
    1917   }
    1918   var second-ah/eax: (addr handle cell) <- get rest, left
    1919   var second/eax: (addr cell) <- lookup *second-ah
    1920   {
    1921     var second-type/eax: (addr int) <- get second, type
    1922     compare *second-type, 1/number
    1923     break-if-=
    1924     error trace, "second arg for 'pixel' is not an int (x coordinate)"
    1925     return
    1926   }
    1927   var second-value/eax: (addr float) <- get second, number-data
    1928   var x/edx: int <- convert *second-value
    1929   # y = rest->right->left->value
    1930   var rest-ah/eax: (addr handle cell) <- get rest, right
    1931   var _rest/eax: (addr cell) <- lookup *rest-ah
    1932   rest <- copy _rest
    1933   {
    1934     var rest-type/eax: (addr int) <- get rest, type
    1935     compare *rest-type, 0/pair
    1936     break-if-=
    1937     error trace, "'pixel' encountered non-pair"
    1938     return
    1939   }
    1940   {
    1941     var rest-nil?/eax: boolean <- nil? rest
    1942     compare rest-nil?, 0/false
    1943     break-if-=
    1944     error trace, "'pixel' needs 4 args but got 2"
    1945     return
    1946   }
    1947   var third-ah/eax: (addr handle cell) <- get rest, left
    1948   var third/eax: (addr cell) <- lookup *third-ah
    1949   {
    1950     var third-type/eax: (addr int) <- get third, type
    1951     compare *third-type, 1/number
    1952     break-if-=
    1953     error trace, "third arg for 'pixel' is not an int (y coordinate)"
    1954     return
    1955   }
    1956   var third-value/eax: (addr float) <- get third, number-data
    1957   var y/ebx: int <- convert *third-value
    1958   # color = rest->right->left->value
    1959   var rest-ah/eax: (addr handle cell) <- get rest, right
    1960   var _rest/eax: (addr cell) <- lookup *rest-ah
    1961   rest <- copy _rest
    1962   {
    1963     var rest-type/eax: (addr int) <- get rest, type
    1964     compare *rest-type, 0/pair
    1965     break-if-=
    1966     error trace, "'pixel' encountered non-pair"
    1967     return
    1968   }
    1969   {
    1970     var rest-nil?/eax: boolean <- nil? rest
    1971     compare rest-nil?, 0/false
    1972     break-if-=
    1973     error trace, "'pixel' needs 4 args but got 3"
    1974     return
    1975   }
    1976   var fourth-ah/eax: (addr handle cell) <- get rest, left
    1977   var fourth/eax: (addr cell) <- lookup *fourth-ah
    1978   {
    1979     var fourth-type/eax: (addr int) <- get fourth, type
    1980     compare *fourth-type, 1/number
    1981     break-if-=
    1982     error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
    1983     return
    1984   }
    1985   var fourth-value/eax: (addr float) <- get fourth, number-data
    1986   var color/eax: int <- convert *fourth-value
    1987   pixel screen, x, y, color
    1988   # return nothing
    1989 }
    1990
    1991 fn apply-line _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    1992   trace-text trace, "eval", "apply 'line'"
    1993   var args-ah/eax: (addr handle cell) <- copy _args-ah
    1994   var _args/eax: (addr cell) <- lookup *args-ah
    1995   var args/esi: (addr cell) <- copy _args
    1996   {
    1997     var args-type/eax: (addr int) <- get args, type
    1998     compare *args-type, 0/pair
    1999     break-if-=
    2000     error trace, "args to 'line' are not a list"
    2001     return
    2002   }
    2003   var empty-args?/eax: boolean <- nil? args
    2004   compare empty-args?, 0/false
    2005   {
    2006     break-if-=
    2007     error trace, "'line' needs 6 args but got 0"
    2008     return
    2009   }
    2010   # screen = args->left
    2011   var first-ah/eax: (addr handle cell) <- get args, left
    2012   var first/eax: (addr cell) <- lookup *first-ah
    2013   {
    2014     var first-type/eax: (addr int) <- get first, type
    2015     compare *first-type, 5/screen
    2016     break-if-=
    2017     error trace, "first arg for 'line' is not a screen"
    2018     return
    2019   }
    2020   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    2021   var _screen/eax: (addr screen) <- lookup *screen-ah
    2022   var screen/edi: (addr screen) <- copy _screen
    2023   # x1 = args->right->left->value
    2024   var rest-ah/eax: (addr handle cell) <- get args, right
    2025   var _rest/eax: (addr cell) <- lookup *rest-ah
    2026   var rest/esi: (addr cell) <- copy _rest
    2027   {
    2028     var rest-type/eax: (addr int) <- get rest, type
    2029     compare *rest-type, 0/pair
    2030     break-if-=
    2031     error trace, "'line' encountered non-pair"
    2032     return
    2033   }
    2034   {
    2035     var rest-nil?/eax: boolean <- nil? rest
    2036     compare rest-nil?, 0/false
    2037     break-if-=
    2038     error trace, "'line' needs 6 args but got 1"
    2039     return
    2040   }
    2041   var second-ah/eax: (addr handle cell) <- get rest, left
    2042   var second/eax: (addr cell) <- lookup *second-ah
    2043   {
    2044     var second-type/eax: (addr int) <- get second, type
    2045     compare *second-type, 1/number
    2046     break-if-=
    2047     error trace, "second arg for 'line' is not a number (screen x coordinate of start point)"
    2048     return
    2049   }
    2050   var second-value/eax: (addr float) <- get second, number-data
    2051   var x1/edx: int <- convert *second-value
    2052   # y1 = rest->right->left->value
    2053   var rest-ah/eax: (addr handle cell) <- get rest, right
    2054   var _rest/eax: (addr cell) <- lookup *rest-ah
    2055   rest <- copy _rest
    2056   {
    2057     var rest-type/eax: (addr int) <- get rest, type
    2058     compare *rest-type, 0/pair
    2059     break-if-=
    2060     error trace, "'line' encountered non-pair"
    2061     return
    2062   }
    2063   {
    2064     var rest-nil?/eax: boolean <- nil? rest
    2065     compare rest-nil?, 0/false
    2066     break-if-=
    2067     error trace, "'line' needs 6 args but got 2"
    2068     return
    2069   }
    2070   var third-ah/eax: (addr handle cell) <- get rest, left
    2071   var third/eax: (addr cell) <- lookup *third-ah
    2072   {
    2073     var third-type/eax: (addr int) <- get third, type
    2074     compare *third-type, 1/number
    2075     break-if-=
    2076     error trace, "third arg for 'line' is not a number (screen y coordinate of start point)"
    2077     return
    2078   }
    2079   var third-value/eax: (addr float) <- get third, number-data
    2080   var y1/ebx: int <- convert *third-value
    2081   # x2 = rest->right->left->value
    2082   var rest-ah/eax: (addr handle cell) <- get rest, right
    2083   var _rest/eax: (addr cell) <- lookup *rest-ah
    2084   var rest/esi: (addr cell) <- copy _rest
    2085   {
    2086     var rest-type/eax: (addr int) <- get rest, type
    2087     compare *rest-type, 0/pair
    2088     break-if-=
    2089     error trace, "'line' encountered non-pair"
    2090     return
    2091   }
    2092   {
    2093     var rest-nil?/eax: boolean <- nil? rest
    2094     compare rest-nil?, 0/false
    2095     break-if-=
    2096     error trace, "'line' needs 6 args but got 3"
    2097     return
    2098   }
    2099   var fourth-ah/eax: (addr handle cell) <- get rest, left
    2100   var fourth/eax: (addr cell) <- lookup *fourth-ah
    2101   {
    2102     var fourth-type/eax: (addr int) <- get fourth, type
    2103     compare *fourth-type, 1/number
    2104     break-if-=
    2105     error trace, "fourth arg for 'line' is not a number (screen x coordinate of end point)"
    2106     return
    2107   }
    2108   var fourth-value/eax: (addr float) <- get fourth, number-data
    2109   var x2/ecx: int <- convert *fourth-value
    2110   # y2 = rest->right->left->value
    2111   var rest-ah/eax: (addr handle cell) <- get rest, right
    2112   var _rest/eax: (addr cell) <- lookup *rest-ah
    2113   rest <- copy _rest
    2114   {
    2115     var rest-type/eax: (addr int) <- get rest, type
    2116     compare *rest-type, 0/pair
    2117     break-if-=
    2118     error trace, "'line' encountered non-pair"
    2119     return
    2120   }
    2121   {
    2122     var rest-nil?/eax: boolean <- nil? rest
    2123     compare rest-nil?, 0/false
    2124     break-if-=
    2125     error trace, "'line' needs 6 args but got 4"
    2126     return
    2127   }
    2128   var fifth-ah/eax: (addr handle cell) <- get rest, left
    2129   var fifth/eax: (addr cell) <- lookup *fifth-ah
    2130   {
    2131     var fifth-type/eax: (addr int) <- get fifth, type
    2132     compare *fifth-type, 1/number
    2133     break-if-=
    2134     error trace, "fifth arg for 'line' is not a number (screen y coordinate of end point)"
    2135     return
    2136   }
    2137   var fifth-value/eax: (addr float) <- get fifth, number-data
    2138   var tmp/eax: int <- convert *fifth-value
    2139   var y2: int
    2140   copy-to y2, tmp
    2141   # color = rest->right->left->value
    2142   var rest-ah/eax: (addr handle cell) <- get rest, right
    2143   var _rest/eax: (addr cell) <- lookup *rest-ah
    2144   rest <- copy _rest
    2145   {
    2146     var rest-type/eax: (addr int) <- get rest, type
    2147     compare *rest-type, 0/pair
    2148     break-if-=
    2149     error trace, "'line' encountered non-pair"
    2150     return
    2151   }
    2152   {
    2153     var rest-nil?/eax: boolean <- nil? rest
    2154     compare rest-nil?, 0/false
    2155     break-if-=
    2156     error trace, "'line' needs 6 args but got 5"
    2157     return
    2158   }
    2159   var sixth-ah/eax: (addr handle cell) <- get rest, left
    2160   var sixth/eax: (addr cell) <- lookup *sixth-ah
    2161   {
    2162     var sixth-type/eax: (addr int) <- get sixth, type
    2163     compare *sixth-type, 1/number
    2164     break-if-=
    2165     error trace, "sixth arg for 'line' is not an int (color; 0..0xff)"
    2166     return
    2167   }
    2168   var sixth-value/eax: (addr float) <- get sixth, number-data
    2169   var color/eax: int <- convert *sixth-value
    2170   draw-line screen, x1, y1, x2, y2, color
    2171   # return nothing
    2172 }
    2173
    2174 fn apply-hline _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    2175   trace-text trace, "eval", "apply 'hline'"
    2176   var args-ah/eax: (addr handle cell) <- copy _args-ah
    2177   var _args/eax: (addr cell) <- lookup *args-ah
    2178   var args/esi: (addr cell) <- copy _args
    2179   {
    2180     var args-type/eax: (addr int) <- get args, type
    2181     compare *args-type, 0/pair
    2182     break-if-=
    2183     error trace, "args to 'hline' are not a list"
    2184     return
    2185   }
    2186   var empty-args?/eax: boolean <- nil? args
    2187   compare empty-args?, 0/false
    2188   {
    2189     break-if-=
    2190     error trace, "'hline' needs 5 args but got 0"
    2191     return
    2192   }
    2193   # screen = args->left
    2194   var first-ah/eax: (addr handle cell) <- get args, left
    2195   var first/eax: (addr cell) <- lookup *first-ah
    2196   {
    2197     var first-type/eax: (addr int) <- get first, type
    2198     compare *first-type, 5/screen
    2199     break-if-=
    2200     error trace, "first arg for 'hline' is not a screen"
    2201     return
    2202   }
    2203   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    2204   var _screen/eax: (addr screen) <- lookup *screen-ah
    2205   var screen/edi: (addr screen) <- copy _screen
    2206   # y = args->right->left->value
    2207   var rest-ah/eax: (addr handle cell) <- get args, right
    2208   var _rest/eax: (addr cell) <- lookup *rest-ah
    2209   var rest/esi: (addr cell) <- copy _rest
    2210   {
    2211     var rest-type/eax: (addr int) <- get rest, type
    2212     compare *rest-type, 0/pair
    2213     break-if-=
    2214     error trace, "'hline' encountered non-pair"
    2215     return
    2216   }
    2217   {
    2218     var rest-nil?/eax: boolean <- nil? rest
    2219     compare rest-nil?, 0/false
    2220     break-if-=
    2221     error trace, "'hline' needs 5 args but got 1"
    2222     return
    2223   }
    2224   var second-ah/eax: (addr handle cell) <- get rest, left
    2225   var second/eax: (addr cell) <- lookup *second-ah
    2226   {
    2227     var second-type/eax: (addr int) <- get second, type
    2228     compare *second-type, 1/number
    2229     break-if-=
    2230     error trace, "second arg for 'hline' is not a number (screen y coordinate)"
    2231     return
    2232   }
    2233   var second-value/eax: (addr float) <- get second, number-data
    2234   var y/edx: int <- convert *second-value
    2235   # x1 = rest->right->left->value
    2236   var rest-ah/eax: (addr handle cell) <- get rest, right
    2237   var _rest/eax: (addr cell) <- lookup *rest-ah
    2238   rest <- copy _rest
    2239   {
    2240     var rest-type/eax: (addr int) <- get rest, type
    2241     compare *rest-type, 0/pair
    2242     break-if-=
    2243     error trace, "'hline' encountered non-pair"
    2244     return
    2245   }
    2246   {
    2247     var rest-nil?/eax: boolean <- nil? rest
    2248     compare rest-nil?, 0/false
    2249     break-if-=
    2250     error trace, "'hline' needs 5 args but got 2"
    2251     return
    2252   }
    2253   var third-ah/eax: (addr handle cell) <- get rest, left
    2254   var third/eax: (addr cell) <- lookup *third-ah
    2255   {
    2256     var third-type/eax: (addr int) <- get third, type
    2257     compare *third-type, 1/number
    2258     break-if-=
    2259     error trace, "third arg for 'hline' is not a number (screen x coordinate of start point)"
    2260     return
    2261   }
    2262   var third-value/eax: (addr float) <- get third, number-data
    2263   var x1/ebx: int <- convert *third-value
    2264   # x2 = rest->right->left->value
    2265   var rest-ah/eax: (addr handle cell) <- get rest, right
    2266   var _rest/eax: (addr cell) <- lookup *rest-ah
    2267   var rest/esi: (addr cell) <- copy _rest
    2268   {
    2269     var rest-type/eax: (addr int) <- get rest, type
    2270     compare *rest-type, 0/pair
    2271     break-if-=
    2272     error trace, "'hline' encountered non-pair"
    2273     return
    2274   }
    2275   {
    2276     var rest-nil?/eax: boolean <- nil? rest
    2277     compare rest-nil?, 0/false
    2278     break-if-=
    2279     error trace, "'hline' needs 5 args but got 3"
    2280     return
    2281   }
    2282   var fourth-ah/eax: (addr handle cell) <- get rest, left
    2283   var fourth/eax: (addr cell) <- lookup *fourth-ah
    2284   {
    2285     var fourth-type/eax: (addr int) <- get fourth, type
    2286     compare *fourth-type, 1/number
    2287     break-if-=
    2288     error trace, "fourth arg for 'hline' is not a number (screen x coordinate of end point)"
    2289     return
    2290   }
    2291   var fourth-value/eax: (addr float) <- get fourth, number-data
    2292   var x2/ecx: int <- convert *fourth-value
    2293   # color = rest->right->left->value
    2294   var rest-ah/eax: (addr handle cell) <- get rest, right
    2295   var _rest/eax: (addr cell) <- lookup *rest-ah
    2296   rest <- copy _rest
    2297   {
    2298     var rest-type/eax: (addr int) <- get rest, type
    2299     compare *rest-type, 0/pair
    2300     break-if-=
    2301     error trace, "'hline' encountered non-pair"
    2302     return
    2303   }
    2304   {
    2305     var rest-nil?/eax: boolean <- nil? rest
    2306     compare rest-nil?, 0/false
    2307     break-if-=
    2308     error trace, "'hline' needs 5 args but got 5"
    2309     return
    2310   }
    2311   var fifth-ah/eax: (addr handle cell) <- get rest, left
    2312   var fifth/eax: (addr cell) <- lookup *fifth-ah
    2313   {
    2314     var fifth-type/eax: (addr int) <- get fifth, type
    2315     compare *fifth-type, 1/number
    2316     break-if-=
    2317     error trace, "fifth arg for 'hline' is not an int (color; 0..0xff)"
    2318     return
    2319   }
    2320   var fifth-value/eax: (addr float) <- get fifth, number-data
    2321   var color/eax: int <- convert *fifth-value
    2322   draw-horizontal-line screen, y, x1, x2, color
    2323   # return nothing
    2324 }
    2325
    2326 fn apply-vline _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    2327   trace-text trace, "eval", "apply 'vline'"
    2328   var args-ah/eax: (addr handle cell) <- copy _args-ah
    2329   var _args/eax: (addr cell) <- lookup *args-ah
    2330   var args/esi: (addr cell) <- copy _args
    2331   {
    2332     var args-type/eax: (addr int) <- get args, type
    2333     compare *args-type, 0/pair
    2334     break-if-=
    2335     error trace, "args to 'vline' are not a list"
    2336     return
    2337   }
    2338   var empty-args?/eax: boolean <- nil? args
    2339   compare empty-args?, 0/false
    2340   {
    2341     break-if-=
    2342     error trace, "'vline' needs 5 args but got 0"
    2343     return
    2344   }
    2345   # screen = args->left
    2346   var first-ah/eax: (addr handle cell) <- get args, left
    2347   var first/eax: (addr cell) <- lookup *first-ah
    2348   {
    2349     var first-type/eax: (addr int) <- get first, type
    2350     compare *first-type, 5/screen
    2351     break-if-=
    2352     error trace, "first arg for 'vline' is not a screen"
    2353     return
    2354   }
    2355   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    2356   var _screen/eax: (addr screen) <- lookup *screen-ah
    2357   var screen/edi: (addr screen) <- copy _screen
    2358   # x = args->right->left->value
    2359   var rest-ah/eax: (addr handle cell) <- get args, right
    2360   var _rest/eax: (addr cell) <- lookup *rest-ah
    2361   var rest/esi: (addr cell) <- copy _rest
    2362   {
    2363     var rest-type/eax: (addr int) <- get rest, type
    2364     compare *rest-type, 0/pair
    2365     break-if-=
    2366     error trace, "'vline' encountered non-pair"
    2367     return
    2368   }
    2369   {
    2370     var rest-nil?/eax: boolean <- nil? rest
    2371     compare rest-nil?, 0/false
    2372     break-if-=
    2373     error trace, "'vline' needs 5 args but got 1"
    2374     return
    2375   }
    2376   var second-ah/eax: (addr handle cell) <- get rest, left
    2377   var second/eax: (addr cell) <- lookup *second-ah
    2378   {
    2379     var second-type/eax: (addr int) <- get second, type
    2380     compare *second-type, 1/number
    2381     break-if-=
    2382     error trace, "second arg for 'vline' is not a number (screen x coordinate)"
    2383     return
    2384   }
    2385   var second-value/eax: (addr float) <- get second, number-data
    2386   var x/edx: int <- convert *second-value
    2387   # y1 = rest->right->left->value
    2388   var rest-ah/eax: (addr handle cell) <- get rest, right
    2389   var _rest/eax: (addr cell) <- lookup *rest-ah
    2390   rest <- copy _rest
    2391   {
    2392     var rest-type/eax: (addr int) <- get rest, type
    2393     compare *rest-type, 0/pair
    2394     break-if-=
    2395     error trace, "'vline' encountered non-pair"
    2396     return
    2397   }
    2398   {
    2399     var rest-nil?/eax: boolean <- nil? rest
    2400     compare rest-nil?, 0/false
    2401     break-if-=
    2402     error trace, "'vline' needs 5 args but got 2"
    2403     return
    2404   }
    2405   var third-ah/eax: (addr handle cell) <- get rest, left
    2406   var third/eax: (addr cell) <- lookup *third-ah
    2407   {
    2408     var third-type/eax: (addr int) <- get third, type
    2409     compare *third-type, 1/number
    2410     break-if-=
    2411     error trace, "third arg for 'vline' is not a number (screen y coordinate of start point)"
    2412     return
    2413   }
    2414   var third-value/eax: (addr float) <- get third, number-data
    2415   var y1/ebx: int <- convert *third-value
    2416   # y2 = rest->right->left->value
    2417   var rest-ah/eax: (addr handle cell) <- get rest, right
    2418   var _rest/eax: (addr cell) <- lookup *rest-ah
    2419   var rest/esi: (addr cell) <- copy _rest
    2420   {
    2421     var rest-type/eax: (addr int) <- get rest, type
    2422     compare *rest-type, 0/pair
    2423     break-if-=
    2424     error trace, "'vline' encountered non-pair"
    2425     return
    2426   }
    2427   {
    2428     var rest-nil?/eax: boolean <- nil? rest
    2429     compare rest-nil?, 0/false
    2430     break-if-=
    2431     error trace, "'vline' needs 5 args but got 3"
    2432     return
    2433   }
    2434   var fourth-ah/eax: (addr handle cell) <- get rest, left
    2435   var fourth/eax: (addr cell) <- lookup *fourth-ah
    2436   {
    2437     var fourth-type/eax: (addr int) <- get fourth, type
    2438     compare *fourth-type, 1/number
    2439     break-if-=
    2440     error trace, "fourth arg for 'vline' is not a number (screen y coordinate of end point)"
    2441     return
    2442   }
    2443   var fourth-value/eax: (addr float) <- get fourth, number-data
    2444   var y2/ecx: int <- convert *fourth-value
    2445   # color = rest->right->left->value
    2446   var rest-ah/eax: (addr handle cell) <- get rest, right
    2447   var _rest/eax: (addr cell) <- lookup *rest-ah
    2448   rest <- copy _rest
    2449   {
    2450     var rest-type/eax: (addr int) <- get rest, type
    2451     compare *rest-type, 0/pair
    2452     break-if-=
    2453     error trace, "'vline' encountered non-pair"
    2454     return
    2455   }
    2456   {
    2457     var rest-nil?/eax: boolean <- nil? rest
    2458     compare rest-nil?, 0/false
    2459     break-if-=
    2460     error trace, "'vline' needs 5 args but got 5"
    2461     return
    2462   }
    2463   var fifth-ah/eax: (addr handle cell) <- get rest, left
    2464   var fifth/eax: (addr cell) <- lookup *fifth-ah
    2465   {
    2466     var fifth-type/eax: (addr int) <- get fifth, type
    2467     compare *fifth-type, 1/number
    2468     break-if-=
    2469     error trace, "fifth arg for 'vline' is not an int (color; 0..0xff)"
    2470     return
    2471   }
    2472   var fifth-value/eax: (addr float) <- get fifth, number-data
    2473   var color/eax: int <- convert *fifth-value
    2474   draw-vertical-line screen, x, y1, y2, color
    2475   # return nothing
    2476 }
    2477
    2478 fn apply-circle _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    2479   trace-text trace, "eval", "apply 'circle'"
    2480   var args-ah/eax: (addr handle cell) <- copy _args-ah
    2481   var _args/eax: (addr cell) <- lookup *args-ah
    2482   var args/esi: (addr cell) <- copy _args
    2483   {
    2484     var args-type/eax: (addr int) <- get args, type
    2485     compare *args-type, 0/pair
    2486     break-if-=
    2487     error trace, "args to 'circle' are not a list"
    2488     return
    2489   }
    2490   var empty-args?/eax: boolean <- nil? args
    2491   compare empty-args?, 0/false
    2492   {
    2493     break-if-=
    2494     error trace, "'circle' needs 5 args but got 0"
    2495     return
    2496   }
    2497   # screen = args->left
    2498   var first-ah/eax: (addr handle cell) <- get args, left
    2499   var first/eax: (addr cell) <- lookup *first-ah
    2500   {
    2501     var first-type/eax: (addr int) <- get first, type
    2502     compare *first-type, 5/screen
    2503     break-if-=
    2504     error trace, "first arg for 'circle' is not a screen"
    2505     return
    2506   }
    2507   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    2508   var _screen/eax: (addr screen) <- lookup *screen-ah
    2509   var screen/edi: (addr screen) <- copy _screen
    2510   # cx = args->right->left->value
    2511   var rest-ah/eax: (addr handle cell) <- get args, right
    2512   var _rest/eax: (addr cell) <- lookup *rest-ah
    2513   var rest/esi: (addr cell) <- copy _rest
    2514   {
    2515     var rest-type/eax: (addr int) <- get rest, type
    2516     compare *rest-type, 0/pair
    2517     break-if-=
    2518     error trace, "'circle' encountered non-pair"
    2519     return
    2520   }
    2521   {
    2522     var rest-nil?/eax: boolean <- nil? rest
    2523     compare rest-nil?, 0/false
    2524     break-if-=
    2525     error trace, "'circle' needs 5 args but got 1"
    2526     return
    2527   }
    2528   var second-ah/eax: (addr handle cell) <- get rest, left
    2529   var second/eax: (addr cell) <- lookup *second-ah
    2530   {
    2531     var second-type/eax: (addr int) <- get second, type
    2532     compare *second-type, 1/number
    2533     break-if-=
    2534     error trace, "second arg for 'circle' is not a number (screen x coordinate of center)"
    2535     return
    2536   }
    2537   var second-value/eax: (addr float) <- get second, number-data
    2538   var cx/edx: int <- convert *second-value
    2539   # cy = rest->right->left->value
    2540   var rest-ah/eax: (addr handle cell) <- get rest, right
    2541   var _rest/eax: (addr cell) <- lookup *rest-ah
    2542   rest <- copy _rest
    2543   {
    2544     var rest-type/eax: (addr int) <- get rest, type
    2545     compare *rest-type, 0/pair
    2546     break-if-=
    2547     error trace, "'circle' encountered non-pair"
    2548     return
    2549   }
    2550   {
    2551     var rest-nil?/eax: boolean <- nil? rest
    2552     compare rest-nil?, 0/false
    2553     break-if-=
    2554     error trace, "'circle' needs 5 args but got 2"
    2555     return
    2556   }
    2557   var third-ah/eax: (addr handle cell) <- get rest, left
    2558   var third/eax: (addr cell) <- lookup *third-ah
    2559   {
    2560     var third-type/eax: (addr int) <- get third, type
    2561     compare *third-type, 1/number
    2562     break-if-=
    2563     error trace, "third arg for 'circle' is not a number (screen y coordinate of center)"
    2564     return
    2565   }
    2566   var third-value/eax: (addr float) <- get third, number-data
    2567   var cy/ebx: int <- convert *third-value
    2568   # r = rest->right->left->value
    2569   var rest-ah/eax: (addr handle cell) <- get rest, right
    2570   var _rest/eax: (addr cell) <- lookup *rest-ah
    2571   var rest/esi: (addr cell) <- copy _rest
    2572   {
    2573     var rest-type/eax: (addr int) <- get rest, type
    2574     compare *rest-type, 0/pair
    2575     break-if-=
    2576     error trace, "'circle' encountered non-pair"
    2577     return
    2578   }
    2579   {
    2580     var rest-nil?/eax: boolean <- nil? rest
    2581     compare rest-nil?, 0/false
    2582     break-if-=
    2583     error trace, "'circle' needs 5 args but got 3"
    2584     return
    2585   }
    2586   var fourth-ah/eax: (addr handle cell) <- get rest, left
    2587   var fourth/eax: (addr cell) <- lookup *fourth-ah
    2588   {
    2589     var fourth-type/eax: (addr int) <- get fourth, type
    2590     compare *fourth-type, 1/number
    2591     break-if-=
    2592     error trace, "fourth arg for 'circle' is not a number (screen radius)"
    2593     return
    2594   }
    2595   var fourth-value/eax: (addr float) <- get fourth, number-data
    2596   var r/ecx: int <- convert *fourth-value
    2597   # color = rest->right->left->value
    2598   var rest-ah/eax: (addr handle cell) <- get rest, right
    2599   var _rest/eax: (addr cell) <- lookup *rest-ah
    2600   rest <- copy _rest
    2601   {
    2602     var rest-type/eax: (addr int) <- get rest, type
    2603     compare *rest-type, 0/pair
    2604     break-if-=
    2605     error trace, "'circle' encountered non-pair"
    2606     return
    2607   }
    2608   {
    2609     var rest-nil?/eax: boolean <- nil? rest
    2610     compare rest-nil?, 0/false
    2611     break-if-=
    2612     error trace, "'circle' needs 5 args but got 5"
    2613     return
    2614   }
    2615   var fifth-ah/eax: (addr handle cell) <- get rest, left
    2616   var fifth/eax: (addr cell) <- lookup *fifth-ah
    2617   {
    2618     var fifth-type/eax: (addr int) <- get fifth, type
    2619     compare *fifth-type, 1/number
    2620     break-if-=
    2621     error trace, "fifth arg for 'circle' is not an int (color; 0..0xff)"
    2622     return
    2623   }
    2624   var fifth-value/eax: (addr float) <- get fifth, number-data
    2625   var color/eax: int <- convert *fifth-value
    2626   draw-circle screen, cx, cy, r, color
    2627   # return nothing
    2628 }
    2629
    2630 fn apply-bezier _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    2631   trace-text trace, "eval", "apply 'bezier'"
    2632   var args-ah/eax: (addr handle cell) <- copy _args-ah
    2633   var _args/eax: (addr cell) <- lookup *args-ah
    2634   var args/esi: (addr cell) <- copy _args
    2635   {
    2636     var args-type/eax: (addr int) <- get args, type
    2637     compare *args-type, 0/pair
    2638     break-if-=
    2639     error trace, "args to 'bezier' are not a list"
    2640     return
    2641   }
    2642   var empty-args?/eax: boolean <- nil? args
    2643   compare empty-args?, 0/false
    2644   {
    2645     break-if-=
    2646     error trace, "'bezier' needs 8 args but got 0"
    2647     return
    2648   }
    2649   # screen = args->left
    2650   var first-ah/eax: (addr handle cell) <- get args, left
    2651   var first/eax: (addr cell) <- lookup *first-ah
    2652   {
    2653     var first-type/eax: (addr int) <- get first, type
    2654     compare *first-type, 5/screen
    2655     break-if-=
    2656     error trace, "first arg for 'bezier' is not a screen"
    2657     return
    2658   }
    2659   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    2660   var _screen/eax: (addr screen) <- lookup *screen-ah
    2661   var screen/edi: (addr screen) <- copy _screen
    2662   # x0 = args->right->left->value
    2663   var rest-ah/eax: (addr handle cell) <- get args, right
    2664   var _rest/eax: (addr cell) <- lookup *rest-ah
    2665   var rest/esi: (addr cell) <- copy _rest
    2666   {
    2667     var rest-type/eax: (addr int) <- get rest, type
    2668     compare *rest-type, 0/pair
    2669     break-if-=
    2670     error trace, "'bezier' encountered non-pair"
    2671     return
    2672   }
    2673   {
    2674     var rest-nil?/eax: boolean <- nil? rest
    2675     compare rest-nil?, 0/false
    2676     break-if-=
    2677     error trace, "'bezier' needs 8 args but got 1"
    2678     return
    2679   }
    2680   var second-ah/eax: (addr handle cell) <- get rest, left
    2681   var second/eax: (addr cell) <- lookup *second-ah
    2682   {
    2683     var second-type/eax: (addr int) <- get second, type
    2684     compare *second-type, 1/number
    2685     break-if-=
    2686     error trace, "second arg for 'bezier' is not a number (screen x coordinate of start point)"
    2687     return
    2688   }
    2689   var second-value/eax: (addr float) <- get second, number-data
    2690   var x0/edx: int <- convert *second-value
    2691   # y0 = rest->right->left->value
    2692   var rest-ah/eax: (addr handle cell) <- get rest, right
    2693   var _rest/eax: (addr cell) <- lookup *rest-ah
    2694   rest <- copy _rest
    2695   {
    2696     var rest-type/eax: (addr int) <- get rest, type
    2697     compare *rest-type, 0/pair
    2698     break-if-=
    2699     error trace, "'bezier' encountered non-pair"
    2700     return
    2701   }
    2702   {
    2703     var rest-nil?/eax: boolean <- nil? rest
    2704     compare rest-nil?, 0/false
    2705     break-if-=
    2706     error trace, "'bezier' needs 8 args but got 2"
    2707     return
    2708   }
    2709   var third-ah/eax: (addr handle cell) <- get rest, left
    2710   var third/eax: (addr cell) <- lookup *third-ah
    2711   {
    2712     var third-type/eax: (addr int) <- get third, type
    2713     compare *third-type, 1/number
    2714     break-if-=
    2715     error trace, "third arg for 'bezier' is not a number (screen y coordinate of start point)"
    2716     return
    2717   }
    2718   var third-value/eax: (addr float) <- get third, number-data
    2719   var y0/ebx: int <- convert *third-value
    2720   # x1 = rest->right->left->value
    2721   var rest-ah/eax: (addr handle cell) <- get rest, right
    2722   var _rest/eax: (addr cell) <- lookup *rest-ah
    2723   var rest/esi: (addr cell) <- copy _rest
    2724   {
    2725     var rest-type/eax: (addr int) <- get rest, type
    2726     compare *rest-type, 0/pair
    2727     break-if-=
    2728     error trace, "'bezier' encountered non-pair"
    2729     return
    2730   }
    2731   {
    2732     var rest-nil?/eax: boolean <- nil? rest
    2733     compare rest-nil?, 0/false
    2734     break-if-=
    2735     error trace, "'bezier' needs 8 args but got 3"
    2736     return
    2737   }
    2738   var fourth-ah/eax: (addr handle cell) <- get rest, left
    2739   var fourth/eax: (addr cell) <- lookup *fourth-ah
    2740   {
    2741     var fourth-type/eax: (addr int) <- get fourth, type
    2742     compare *fourth-type, 1/number
    2743     break-if-=
    2744     error trace, "fourth arg for 'bezier' is not a number (screen x coordinate of control point)"
    2745     return
    2746   }
    2747   var fourth-value/eax: (addr float) <- get fourth, number-data
    2748   var tmp/eax: int <- convert *fourth-value
    2749   var x1: int
    2750   copy-to x1, tmp
    2751   # y1 = rest->right->left->value
    2752   var rest-ah/eax: (addr handle cell) <- get rest, right
    2753   var _rest/eax: (addr cell) <- lookup *rest-ah
    2754   rest <- copy _rest
    2755   {
    2756     var rest-type/eax: (addr int) <- get rest, type
    2757     compare *rest-type, 0/pair
    2758     break-if-=
    2759     error trace, "'bezier' encountered non-pair"
    2760     return
    2761   }
    2762   {
    2763     var rest-nil?/eax: boolean <- nil? rest
    2764     compare rest-nil?, 0/false
    2765     break-if-=
    2766     error trace, "'bezier' needs 8 args but got 4"
    2767     return
    2768   }
    2769   var fifth-ah/eax: (addr handle cell) <- get rest, left
    2770   var fifth/eax: (addr cell) <- lookup *fifth-ah
    2771   {
    2772     var fifth-type/eax: (addr int) <- get fifth, type
    2773     compare *fifth-type, 1/number
    2774     break-if-=
    2775     error trace, "fifth arg for 'bezier' is not a number (screen y coordinate of control point)"
    2776     return
    2777   }
    2778   var fifth-value/eax: (addr float) <- get fifth, number-data
    2779   var tmp/eax: int <- convert *fifth-value
    2780   var y1: int
    2781   copy-to y1, tmp
    2782   # x2 = rest->right->left->value
    2783   var rest-ah/eax: (addr handle cell) <- get rest, right
    2784   var _rest/eax: (addr cell) <- lookup *rest-ah
    2785   var rest/esi: (addr cell) <- copy _rest
    2786   {
    2787     var rest-type/eax: (addr int) <- get rest, type
    2788     compare *rest-type, 0/pair
    2789     break-if-=
    2790     error trace, "'bezier' encountered non-pair"
    2791     return
    2792   }
    2793   {
    2794     var rest-nil?/eax: boolean <- nil? rest
    2795     compare rest-nil?, 0/false
    2796     break-if-=
    2797     error trace, "'bezier' needs 8 args but got 3"
    2798     return
    2799   }
    2800   var sixth-ah/eax: (addr handle cell) <- get rest, left
    2801   var sixth/eax: (addr cell) <- lookup *sixth-ah
    2802   {
    2803     var sixth-type/eax: (addr int) <- get sixth, type
    2804     compare *sixth-type, 1/number
    2805     break-if-=
    2806     error trace, "sixth arg for 'bezier' is not a number (screen x coordinate of end point)"
    2807     return
    2808   }
    2809   var sixth-value/eax: (addr float) <- get sixth, number-data
    2810   var tmp/eax: int <- convert *sixth-value
    2811   var x2: int
    2812   copy-to x2, tmp
    2813   # y2 = rest->right->left->value
    2814   var rest-ah/eax: (addr handle cell) <- get rest, right
    2815   var _rest/eax: (addr cell) <- lookup *rest-ah
    2816   rest <- copy _rest
    2817   {
    2818     var rest-type/eax: (addr int) <- get rest, type
    2819     compare *rest-type, 0/pair
    2820     break-if-=
    2821     error trace, "'bezier' encountered non-pair"
    2822     return
    2823   }
    2824   {
    2825     var rest-nil?/eax: boolean <- nil? rest
    2826     compare rest-nil?, 0/false
    2827     break-if-=
    2828     error trace, "'bezier' needs 8 args but got 4"
    2829     return
    2830   }
    2831   var seventh-ah/eax: (addr handle cell) <- get rest, left
    2832   var seventh/eax: (addr cell) <- lookup *seventh-ah
    2833   {
    2834     var seventh-type/eax: (addr int) <- get seventh, type
    2835     compare *seventh-type, 1/number
    2836     break-if-=
    2837     error trace, "seventh arg for 'bezier' is not a number (screen y coordinate of end point)"
    2838     return
    2839   }
    2840   var seventh-value/eax: (addr float) <- get seventh, number-data
    2841   var tmp/eax: int <- convert *seventh-value
    2842   var y2: int
    2843   copy-to y2, tmp
    2844   # color = rest->right->left->value
    2845   var rest-ah/eax: (addr handle cell) <- get rest, right
    2846   var _rest/eax: (addr cell) <- lookup *rest-ah
    2847   rest <- copy _rest
    2848   {
    2849     var rest-type/eax: (addr int) <- get rest, type
    2850     compare *rest-type, 0/pair
    2851     break-if-=
    2852     error trace, "'bezier' encountered non-pair"
    2853     return
    2854   }
    2855   {
    2856     var rest-nil?/eax: boolean <- nil? rest
    2857     compare rest-nil?, 0/false
    2858     break-if-=
    2859     error trace, "'bezier' needs 8 args but got 5"
    2860     return
    2861   }
    2862   var eighth-ah/eax: (addr handle cell) <- get rest, left
    2863   var eighth/eax: (addr cell) <- lookup *eighth-ah
    2864   {
    2865     var eighth-type/eax: (addr int) <- get eighth, type
    2866     compare *eighth-type, 1/number
    2867     break-if-=
    2868     error trace, "eighth arg for 'bezier' is not an int (color; 0..0xff)"
    2869     return
    2870   }
    2871   var eighth-value/eax: (addr float) <- get eighth, number-data
    2872   var color/eax: int <- convert *eighth-value
    2873   draw-monotonic-bezier screen, x0, y0, x1, y1, x2, y2, color
    2874   # return nothing
    2875 }
    2876
    2877 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    2878   trace-text trace, "eval", "apply 'key'"
    2879   var args-ah/eax: (addr handle cell) <- copy _args-ah
    2880   var _args/eax: (addr cell) <- lookup *args-ah
    2881   var args/esi: (addr cell) <- copy _args
    2882   {
    2883     var args-type/eax: (addr int) <- get args, type
    2884     compare *args-type, 0/pair
    2885     break-if-=
    2886     error trace, "args to 'key' are not a list"
    2887     return
    2888   }
    2889   var empty-args?/eax: boolean <- nil? args
    2890   compare empty-args?, 0/false
    2891   {
    2892     break-if-=
    2893     error trace, "'key' needs 1 arg but got 0"
    2894     return
    2895   }
    2896   # keyboard = args->left
    2897   var first-ah/eax: (addr handle cell) <- get args, left
    2898   var first/eax: (addr cell) <- lookup *first-ah
    2899   {
    2900     var first-type/eax: (addr int) <- get first, type
    2901     compare *first-type, 6/keyboard
    2902     break-if-=
    2903     error trace, "first arg for 'key' is not a keyboard"
    2904     return
    2905   }
    2906   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
    2907   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
    2908   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
    2909   var result/eax: int <- wait-for-key keyboard
    2910   # return key typed
    2911   new-integer out, result
    2912 }
    2913
    2914 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
    2915   # if keyboard is 0, use real keyboard
    2916   {
    2917     compare keyboard, 0/real-keyboard
    2918     break-if-!=
    2919     var key/eax: byte <- read-key 0/real-keyboard
    2920     var result/eax: int <- copy key
    2921     return result
    2922   }
    2923   # otherwise read from fake keyboard
    2924   var g/eax: grapheme <- read-from-gap-buffer keyboard
    2925   var result/eax: int <- copy g
    2926   return result
    2927 }
    2928
    2929 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    2930   trace-text trace, "eval", "apply stream"
    2931   allocate-stream out
    2932 }
    2933
    2934 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    2935   trace-text trace, "eval", "apply 'write'"
    2936   var args-ah/eax: (addr handle cell) <- copy _args-ah
    2937   var _args/eax: (addr cell) <- lookup *args-ah
    2938   var args/esi: (addr cell) <- copy _args
    2939   {
    2940     var args-type/eax: (addr int) <- get args, type
    2941     compare *args-type, 0/pair
    2942     break-if-=
    2943     error trace, "args to 'write' are not a list"
    2944     return
    2945   }
    2946   var empty-args?/eax: boolean <- nil? args
    2947   compare empty-args?, 0/false
    2948   {
    2949     break-if-=
    2950     error trace, "'write' needs 2 args but got 0"
    2951     return
    2952   }
    2953   # stream = args->left
    2954   var first-ah/edx: (addr handle cell) <- get args, left
    2955   var first/eax: (addr cell) <- lookup *first-ah
    2956   {
    2957     var first-type/eax: (addr int) <- get first, type
    2958     compare *first-type, 3/stream
    2959     break-if-=
    2960     error trace, "first arg for 'write' is not a stream"
    2961     return
    2962   }
    2963   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
    2964   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
    2965   var stream-data/ebx: (addr stream byte) <- copy _stream-data
    2966   # args->right->left
    2967   var right-ah/eax: (addr handle cell) <- get args, right
    2968   var right/eax: (addr cell) <- lookup *right-ah
    2969   {
    2970     var right-type/eax: (addr int) <- get right, type
    2971     compare *right-type, 0/pair
    2972     break-if-=
    2973     error trace, "'write' encountered non-pair"
    2974     return
    2975   }
    2976   {
    2977     var nil?/eax: boolean <- nil? right
    2978     compare nil?, 0/false
    2979     break-if-=
    2980     error trace, "'write' needs 2 args but got 1"
    2981     return
    2982   }
    2983   var second-ah/eax: (addr handle cell) <- get right, left
    2984   var second/eax: (addr cell) <- lookup *second-ah
    2985   {
    2986     var second-type/eax: (addr int) <- get second, type
    2987     compare *second-type, 1/number
    2988     break-if-=
    2989     error trace, "second arg for 'write' is not a number/grapheme"
    2990     return
    2991   }
    2992   var second-value/eax: (addr float) <- get second, number-data
    2993   var x-float/xmm0: float <- copy *second-value
    2994   var x/eax: int <- convert x-float
    2995   var x-grapheme/eax: grapheme <- copy x
    2996   write-grapheme stream-data, x-grapheme
    2997   # return the stream
    2998   copy-object first-ah, out
    2999 }
    3000
    3001 fn apply-rewind _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    3002   trace-text trace, "eval", "apply 'rewind'"
    3003   var args-ah/eax: (addr handle cell) <- copy _args-ah
    3004   var _args/eax: (addr cell) <- lookup *args-ah
    3005   var args/esi: (addr cell) <- copy _args
    3006   {
    3007     var args-type/eax: (addr int) <- get args, type
    3008     compare *args-type, 0/pair
    3009     break-if-=
    3010     error trace, "args to 'rewind' are not a list"
    3011     return
    3012   }
    3013   var empty-args?/eax: boolean <- nil? args
    3014   compare empty-args?, 0/false
    3015   {
    3016     break-if-=
    3017     error trace, "'rewind' needs 1 arg but got 0"
    3018     return
    3019   }
    3020   # stream = args->left
    3021   var first-ah/edx: (addr handle cell) <- get args, left
    3022   var first/eax: (addr cell) <- lookup *first-ah
    3023   {
    3024     var first-type/eax: (addr int) <- get first, type
    3025     compare *first-type, 3/stream
    3026     break-if-=
    3027     error trace, "first arg for 'rewind' is not a stream"
    3028     return
    3029   }
    3030   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
    3031   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
    3032   var stream-data/ebx: (addr stream byte) <- copy _stream-data
    3033   rewind-stream stream-data
    3034   copy-object first-ah, out
    3035 }
    3036
    3037 fn apply-read _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    3038   trace-text trace, "eval", "apply 'read'"
    3039   var args-ah/eax: (addr handle cell) <- copy _args-ah
    3040   var _args/eax: (addr cell) <- lookup *args-ah
    3041   var args/esi: (addr cell) <- copy _args
    3042   {
    3043     var args-type/eax: (addr int) <- get args, type
    3044     compare *args-type, 0/pair
    3045     break-if-=
    3046     error trace, "args to 'read' are not a list"
    3047     return
    3048   }
    3049   var empty-args?/eax: boolean <- nil? args
    3050   compare empty-args?, 0/false
    3051   {
    3052     break-if-=
    3053     error trace, "'read' needs 1 arg but got 0"
    3054     return
    3055   }
    3056   # stream = args->left
    3057   var first-ah/edx: (addr handle cell) <- get args, left
    3058   var first/eax: (addr cell) <- lookup *first-ah
    3059   {
    3060     var first-type/eax: (addr int) <- get first, type
    3061     compare *first-type, 3/stream
    3062     break-if-=
    3063     error trace, "first arg for 'read' is not a stream"
    3064     return
    3065   }
    3066   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
    3067   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
    3068   var stream-data/ebx: (addr stream byte) <- copy _stream-data
    3069 #?   rewind-stream stream-data
    3070   var result-grapheme/eax: grapheme <- read-grapheme stream-data
    3071   var result/eax: int <- copy result-grapheme
    3072   new-integer out, result
    3073 }
    3074
    3075 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    3076   trace-text trace, "eval", "apply 'lines'"
    3077   var args-ah/eax: (addr handle cell) <- copy _args-ah
    3078   var _args/eax: (addr cell) <- lookup *args-ah
    3079   var args/esi: (addr cell) <- copy _args
    3080   {
    3081     var args-type/eax: (addr int) <- get args, type
    3082     compare *args-type, 0/pair
    3083     break-if-=
    3084     error trace, "args to 'lines' are not a list"
    3085     return
    3086   }
    3087   var empty-args?/eax: boolean <- nil? args
    3088   compare empty-args?, 0/false
    3089   {
    3090     break-if-=
    3091     error trace, "'lines' needs 1 arg but got 0"
    3092     return
    3093   }
    3094   # screen = args->left
    3095   var first-ah/eax: (addr handle cell) <- get args, left
    3096   var first/eax: (addr cell) <- lookup *first-ah
    3097   {
    3098     var first-type/eax: (addr int) <- get first, type
    3099     compare *first-type, 5/screen
    3100     break-if-=
    3101     error trace, "first arg for 'lines' is not a screen"
    3102     return
    3103   }
    3104   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    3105   var _screen/eax: (addr screen) <- lookup *screen-ah
    3106   var screen/edx: (addr screen) <- copy _screen
    3107   # compute dimensions
    3108   var dummy/eax: int <- copy 0
    3109   var height/ecx: int <- copy 0
    3110   dummy, height <- screen-size screen
    3111   var result/xmm0: float <- convert height
    3112   new-float out, result
    3113 }
    3114
    3115 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    3116   abort "aa"
    3117 }
    3118
    3119 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    3120   trace-text trace, "eval", "apply 'columns'"
    3121   var args-ah/eax: (addr handle cell) <- copy _args-ah
    3122   var _args/eax: (addr cell) <- lookup *args-ah
    3123   var args/esi: (addr cell) <- copy _args
    3124   {
    3125     var args-type/eax: (addr int) <- get args, type
    3126     compare *args-type, 0/pair
    3127     break-if-=
    3128     error trace, "args to 'columns' are not a list"
    3129     return
    3130   }
    3131   var empty-args?/eax: boolean <- nil? args
    3132   compare empty-args?, 0/false
    3133   {
    3134     break-if-=
    3135     error trace, "'columns' needs 1 arg but got 0"
    3136     return
    3137   }
    3138   # screen = args->left
    3139   var first-ah/eax: (addr handle cell) <- get args, left
    3140   var first/eax: (addr cell) <- lookup *first-ah
    3141   {
    3142     var first-type/eax: (addr int) <- get first, type
    3143     compare *first-type, 5/screen
    3144     break-if-=
    3145     error trace, "first arg for 'columns' is not a screen"
    3146     return
    3147   }
    3148   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    3149   var _screen/eax: (addr screen) <- lookup *screen-ah
    3150   var screen/edx: (addr screen) <- copy _screen
    3151   # compute dimensions
    3152   var width/eax: int <- copy 0
    3153   var dummy/ecx: int <- copy 0
    3154   width, dummy <- screen-size screen
    3155   var result/xmm0: float <- convert width
    3156   new-float out, result
    3157 }
    3158
    3159 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    3160   trace-text trace, "eval", "apply 'width'"
    3161   var args-ah/eax: (addr handle cell) <- copy _args-ah
    3162   var _args/eax: (addr cell) <- lookup *args-ah
    3163   var args/esi: (addr cell) <- copy _args
    3164   {
    3165     var args-type/eax: (addr int) <- get args, type
    3166     compare *args-type, 0/pair
    3167     break-if-=
    3168     error trace, "args to 'width' are not a list"
    3169     return
    3170   }
    3171   var empty-args?/eax: boolean <- nil? args
    3172   compare empty-args?, 0/false
    3173   {
    3174     break-if-=
    3175     error trace, "'width' needs 1 arg but got 0"
    3176     return
    3177   }
    3178   # screen = args->left
    3179   var first-ah/eax: (addr handle cell) <- get args, left
    3180   var first/eax: (addr cell) <- lookup *first-ah
    3181   {
    3182     var first-type/eax: (addr int) <- get first, type
    3183     compare *first-type, 5/screen
    3184     break-if-=
    3185     error trace, "first arg for 'width' is not a screen"
    3186     return
    3187   }
    3188   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    3189   var _screen/eax: (addr screen) <- lookup *screen-ah
    3190   var screen/edx: (addr screen) <- copy _screen
    3191   # compute dimensions
    3192   var width/eax: int <- copy 0
    3193   var dummy/ecx: int <- copy 0
    3194   width, dummy <- screen-size screen
    3195   width <- shift-left 3/log2-font-width
    3196   var result/xmm0: float <- convert width
    3197   new-float out, result
    3198 }
    3199
    3200 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    3201   trace-text trace, "eval", "apply 'height'"
    3202   var args-ah/eax: (addr handle cell) <- copy _args-ah
    3203   var _args/eax: (addr cell) <- lookup *args-ah
    3204   var args/esi: (addr cell) <- copy _args
    3205   {
    3206     var args-type/eax: (addr int) <- get args, type
    3207     compare *args-type, 0/pair
    3208     break-if-=
    3209     error trace, "args to 'height' are not a list"
    3210     return
    3211   }
    3212   var empty-args?/eax: boolean <- nil? args
    3213   compare empty-args?, 0/false
    3214   {
    3215     break-if-=
    3216     error trace, "'height' needs 1 arg but got 0"
    3217     return
    3218   }
    3219   # screen = args->left
    3220   var first-ah/eax: (addr handle cell) <- get args, left
    3221   var first/eax: (addr cell) <- lookup *first-ah
    3222   {
    3223     var first-type/eax: (addr int) <- get first, type
    3224     compare *first-type, 5/screen
    3225     break-if-=
    3226     error trace, "first arg for 'height' is not a screen"
    3227     return
    3228   }
    3229   var screen-ah/eax: (addr handle screen) <- get first, screen-data
    3230   var _screen/eax: (addr screen) <- lookup *screen-ah
    3231   var screen/edx: (addr screen) <- copy _screen
    3232   # compute dimensions
    3233   var dummy/eax: int <- copy 0
    3234   var height/ecx: int <- copy 0
    3235   dummy, height <- screen-size screen
    3236   height <- shift-left 4/log2-font-height
    3237   var result/xmm0: float <- convert height
    3238   new-float out, result
    3239 }
    3240
    3241 fn apply-new-screen _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    3242   trace-text trace, "eval", "apply 'screen'"
    3243   var args-ah/eax: (addr handle cell) <- copy _args-ah
    3244   var _args/eax: (addr cell) <- lookup *args-ah
    3245   var args/esi: (addr cell) <- copy _args
    3246   {
    3247     var args-type/eax: (addr int) <- get args, type
    3248     compare *args-type, 0/pair
    3249     break-if-=
    3250     error trace, "args to 'screen' are not a list"
    3251     return
    3252   }
    3253   var empty-args?/eax: boolean <- nil? args
    3254   compare empty-args?, 0/false
    3255   {
    3256     break-if-=
    3257     error trace, "'screen' needs 2 args but got 0"
    3258     return
    3259   }
    3260   # args->left->value
    3261   var first-ah/eax: (addr handle cell) <- get args, left
    3262   var first/eax: (addr cell) <- lookup *first-ah
    3263   {
    3264     var first-type/eax: (addr int) <- get first, type
    3265     compare *first-type, 1/number
    3266     break-if-=
    3267     error trace, "first arg for 'screen' is not a number (screen width in pixels)"
    3268     return
    3269   }
    3270   var first-value-a/ecx: (addr float) <- get first, number-data
    3271   var first-value/ecx: int <- convert *first-value-a
    3272   # args->right->left->value
    3273   var right-ah/eax: (addr handle cell) <- get args, right
    3274   var right/eax: (addr cell) <- lookup *right-ah
    3275   {
    3276     var right-type/eax: (addr int) <- get right, type
    3277     compare *right-type, 0/pair
    3278     break-if-=
    3279     error trace, "'screen' encountered non-pair"
    3280     return
    3281   }
    3282   {
    3283     var nil?/eax: boolean <- nil? right
    3284     compare nil?, 0/false
    3285     break-if-=
    3286     error trace, "'screen' needs 2 args but got 1"
    3287     return
    3288   }
    3289   var second-ah/eax: (addr handle cell) <- get right, left
    3290   var second/eax: (addr cell) <- lookup *second-ah
    3291   {
    3292     var second-type/eax: (addr int) <- get second, type
    3293     compare *second-type, 1/number
    3294     break-if-=
    3295     error trace, "second arg for 'screen' is not a number (screen height in pixels)"
    3296     return
    3297   }
    3298   var second-value-a/edx: (addr float) <- get second, number-data
    3299   var second-value/edx: int <- convert *second-value-a
    3300   # create fake screen
    3301   new-fake-screen out, first-value, second-value, 1/pixel-graphics
    3302 }
    3303
    3304 fn apply-blit _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
    3305   trace-text trace, "eval", "apply 'blit'"
    3306   var args-ah/eax: (addr handle cell) <- copy _args-ah
    3307   var _args/eax: (addr cell) <- lookup *args-ah
    3308   var args/esi: (addr cell) <- copy _args
    3309   {
    3310     var args-type/eax: (addr int) <- get args, type
    3311     compare *args-type, 0/pair
    3312     break-if-=
    3313     error trace, "args to 'blit' are not a list"
    3314     return
    3315   }
    3316   var empty-args?/eax: boolean <- nil? args
    3317   compare empty-args?, 0/false
    3318   {
    3319     break-if-=
    3320     error trace, "'blit' needs 2 args but got 0"
    3321     return
    3322   }
    3323   # screen = args->left
    3324   var first-ah/eax: (addr handle cell) <- get args, left
    3325   var first/eax: (addr cell) <- lookup *first-ah
    3326   {
    3327     var first-type/eax: (addr int) <- get first, type
    3328     compare *first-type, 5/screen
    3329     break-if-=
    3330     error trace, "first arg for 'blit' is not a screen"
    3331     return
    3332   }
    3333   var src-ah/eax: (addr handle screen) <- get first, screen-data
    3334   var _src/eax: (addr screen) <- lookup *src-ah
    3335   var src/ecx: (addr screen) <- copy _src
    3336   # args->right->left
    3337   var right-ah/eax: (addr handle cell) <- get args, right
    3338   var right/eax: (addr cell) <- lookup *right-ah
    3339   {
    3340     var right-type/eax: (addr int) <- get right, type
    3341     compare *right-type, 0/pair
    3342     break-if-=
    3343     error trace, "'blit' encountered non-pair"
    3344     return
    3345   }
    3346   {
    3347     var nil?/eax: boolean <- nil? right
    3348     compare nil?, 0/false
    3349     break-if-=
    3350     error trace, "'blit' needs 2 args but got 1"
    3351     return
    3352   }
    3353   var second-ah/eax: (addr handle cell) <- get right, left
    3354   var second/eax: (addr cell) <- lookup *second-ah
    3355   {
    3356     var second-type/eax: (addr int) <- get second, type
    3357     compare *second-type, 5/screen
    3358     break-if-=
    3359     error trace, "second arg for 'blit' is not a screen"
    3360     return
    3361   }
    3362   var dest-ah/eax: (addr handle screen) <- get second, screen-data
    3363   var dest/eax: (addr screen) <- lookup *dest-ah
    3364   #
    3365   convert-graphemes-to-pixels src
    3366   copy-pixels src, dest
    3367 }