# Mu - shell/primitives.mu

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

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