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 }