shell/primitives.mu

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