https://github.com/akkartik/mu/blob/main/shell/primitives.mu
   1 fn initialize-primitives _self: (addr global-table) {
   2   var self/esi: (addr global-table) <- copy _self
   3   # for numbers
   4   append-primitive self, "+"
   5   append-primitive self, "-"
   6   append-primitive self, "*"
   7   append-primitive self, "/"
   8   append-primitive self, "%"
   9   append-primitive self, "sqrt"
  10   append-primitive self, "abs"
  11   append-primitive self, "sgn"
  12   append-primitive self, "<"
  13   append-primitive self, ">"
  14   append-primitive self, "<="
  15   append-primitive self, ">="
  16   # generic
  17   append-primitive self, "apply"
  18   append-primitive self, "="
  19   append-primitive self, "no"
  20   append-primitive self, "not"
  21   append-primitive self, "dbg"
  22   # for pairs
  23   append-primitive self, "car"
  24   append-primitive self, "cdr"
  25   append-primitive self, "cons"
  26   # for screens
  27   append-primitive self, "print"
  28   append-primitive self, "clear"
  29   append-primitive self, "lines"
  30   append-primitive self, "columns"
  31   append-primitive self, "up"
  32   append-primitive self, "down"
  33   append-primitive self, "left"
  34   append-primitive self, "right"
  35   append-primitive self, "cr"
  36   append-primitive self, "pixel"
  37   append-primitive self, "width"
  38   append-primitive self, "height"
  39   # for keyboards
  40   append-primitive self, "key"
  41   # for streams
  42   append-primitive self, "stream"
  43   append-primitive self, "write"
  44   # misc
  45   append-primitive self, "abort"
  46   # keep sync'd with render-primitives
  47 }
  48 
  49 fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int {
  50   var y/ecx: int <- copy ymax
  51   y <- subtract 0x10
  52   clear-rect screen, xmin, y, xmax, ymax, 0xdc/bg=green-bg
  53   y <- increment
  54   var tmpx/eax: int <- copy xmin
  55   tmpx <- draw-text-rightward screen, "cursor graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  56   y <- increment
  57   var tmpx/eax: int <- copy xmin
  58   tmpx <- draw-text-rightward screen, "  print", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
  59   tmpx <- draw-text-rightward screen, ": screen a -> a", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  60   y <- increment
  61   var tmpx/eax: int <- copy xmin
  62   tmpx <- draw-text-rightward screen, "  lines columns", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
  63   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  64   y <- increment
  65   var tmpx/eax: int <- copy xmin
  66   tmpx <- draw-text-rightward screen, "  up down left right", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
  67   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  68   y <- increment
  69   var tmpx/eax: int <- copy xmin
  70   tmpx <- draw-text-rightward screen, "  cr", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
  71   tmpx <- draw-text-rightward screen, ": screen   ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  72   tmpx <- draw-text-rightward screen, "# move cursor down and to left margin", tmpx, xmax, y, 0x38/fg=trace, 0xdc/bg=green-bg
  73   y <- increment
  74   var tmpx/eax: int <- copy xmin
  75   tmpx <- draw-text-rightward screen, "pixel graphics", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  76   y <- increment
  77   var tmpx/eax: int <- copy xmin
  78   tmpx <- draw-text-rightward screen, "  width height", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
  79   tmpx <- draw-text-rightward screen, ": screen -> number", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  80   y <- increment
  81   var tmpx/eax: int <- copy xmin
  82   tmpx <- draw-text-rightward screen, "  pixel", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
  83   tmpx <- draw-text-rightward screen, ": screen x y color", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  84   y <- increment
  85   var tmpx/eax: int <- copy xmin
  86   tmpx <- draw-text-rightward screen, "screen/keyboard", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  87   y <- increment
  88   var tmpx/eax: int <- copy xmin
  89   tmpx <- draw-text-rightward screen, "  clear", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
  90   tmpx <- draw-text-rightward screen, ": screen", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  91   y <- increment
  92   var tmpx/eax: int <- copy xmin
  93   tmpx <- draw-text-rightward screen, "  key", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
  94   tmpx <- draw-text-rightward screen, ": () -> grapheme?", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  95   y <- increment
  96   var tmpx/eax: int <- copy xmin
  97   tmpx <- draw-text-rightward screen, "streams", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
  98   y <- increment
  99   var tmpx/eax: int <- copy xmin
 100   tmpx <- draw-text-rightward screen, "  stream", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
 101   tmpx <- draw-text-rightward screen, ": () -> stream ", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
 102   y <- increment
 103   var tmpx/eax: int <- copy xmin
 104   tmpx <- draw-text-rightward screen, "  write", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
 105   tmpx <- draw-text-rightward screen, ": stream grapheme -> stream", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg
 106   y <- increment
 107   var tmpx/eax: int <- copy xmin
 108   tmpx <- draw-text-rightward screen, "fn apply set if while cons car cdr no not and or = ", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
 109   # numbers
 110   tmpx <- draw-text-rightward screen, "< > <= >= + - * / % sqrt abs sgn", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg
 111 }
 112 
 113 fn primitive-global? _x: (addr global) -> _/eax: boolean {
 114   var x/eax: (addr global) <- copy _x
 115   var value-ah/eax: (addr handle cell) <- get x, value
 116   var value/eax: (addr cell) <- lookup *value-ah
 117   compare value, 0/null
 118   {
 119     break-if-!=
 120     return 0/false
 121   }
 122   var value-type/eax: (addr int) <- get value, type
 123   compare *value-type, 4/primitive
 124   {
 125     break-if-=
 126     return 0/false
 127   }
 128   return 1/true
 129 }
 130 
 131 fn append-primitive _self: (addr global-table), name: (addr array byte) {
 132   var self/esi: (addr global-table) <- copy _self
 133   compare self, 0
 134   {
 135     break-if-!=
 136     abort "append primitive"
 137     return
 138   }
 139   var final-index-addr/ecx: (addr int) <- get self, final-index
 140   increment *final-index-addr
 141   var curr-index/ecx: int <- copy *final-index-addr
 142   var data-ah/eax: (addr handle array global) <- get self, data
 143   var data/eax: (addr array global) <- lookup *data-ah
 144   var curr-offset/esi: (offset global) <- compute-offset data, curr-index
 145   var curr/esi: (addr global) <- index data, curr-offset
 146   var curr-name-ah/eax: (addr handle array byte) <- get curr, name
 147   copy-array-object name, curr-name-ah
 148   var curr-value-ah/eax: (addr handle cell) <- get curr, value
 149   new-primitive-function curr-value-ah, curr-index
 150 }
 151 
 152 # a little strange; goes from value to name and selects primitive based on name
 153 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
 154   var f/esi: (addr cell) <- copy _f
 155   var f-index-a/ecx: (addr int) <- get f, index-data
 156   var f-index/ecx: int <- copy *f-index-a
 157   var globals/eax: (addr global-table) <- copy _globals
 158   compare globals, 0
 159   {
 160     break-if-!=
 161     abort "apply primitive"
 162     return
 163   }
 164   var global-data-ah/eax: (addr handle array global) <- get globals, data
 165   var global-data/eax: (addr array global) <- lookup *global-data-ah
 166   var f-offset/ecx: (offset global) <- compute-offset global-data, f-index
 167   var f-value/ecx: (addr global) <- index global-data, f-offset
 168   var f-name-ah/ecx: (addr handle array byte) <- get f-value, name
 169   var f-name/eax: (addr array byte) <- lookup *f-name-ah
 170   {
 171     var add?/eax: boolean <- string-equal? f-name, "+"
 172     compare add?, 0/false
 173     break-if-=
 174     apply-add args-ah, out, trace
 175     return
 176   }
 177   {
 178     var subtract?/eax: boolean <- string-equal? f-name, "-"
 179     compare subtract?, 0/false
 180     break-if-=
 181     apply-subtract args-ah, out, trace
 182     return
 183   }
 184   {
 185     var multiply?/eax: boolean <- string-equal? f-name, "*"
 186     compare multiply?, 0/false
 187     break-if-=
 188     apply-multiply args-ah, out, trace
 189     return
 190   }
 191   {
 192     var divide?/eax: boolean <- string-equal? f-name, "/"
 193     compare divide?, 0/false
 194     break-if-=
 195     apply-divide args-ah, out, trace
 196     return
 197   }
 198   # '%' is the remainder operator, because modulo isn't really meaningful for
 199   # non-integers
 200   #
 201   # I considered calling this operator 'rem', but I want to follow Arc in
 202   # using 'rem' for filtering out elements from lists.
 203   #   https://arclanguage.github.io/ref/list.html#rem
 204   {
 205     var remainder?/eax: boolean <- string-equal? f-name, "%"
 206     compare remainder?, 0/false
 207     break-if-=
 208     apply-remainder args-ah, out, trace
 209     return
 210   }
 211   {
 212     var square-root?/eax: boolean <- string-equal? f-name, "sqrt"
 213     compare square-root?, 0/false
 214     break-if-=
 215     apply-square-root args-ah, out, trace
 216     return
 217   }
 218   {
 219     var abs?/eax: boolean <- string-equal? f-name, "abs"
 220     compare abs?, 0/false
 221     break-if-=
 222     apply-abs args-ah, out, trace
 223     return
 224   }
 225   {
 226     var sgn?/eax: boolean <- string-equal? f-name, "sgn"
 227     compare sgn?, 0/false
 228     break-if-=
 229     apply-sgn args-ah, out, trace
 230     return
 231   }
 232   {
 233     var car?/eax: boolean <- string-equal? f-name, "car"
 234     compare car?, 0/false
 235     break-if-=
 236     apply-car args-ah, out, trace
 237     return
 238   }
 239   {
 240     var cdr?/eax: boolean <- string-equal? f-name, "cdr"
 241     compare cdr?, 0/false
 242     break-if-=
 243     apply-cdr args-ah, out, trace
 244     return
 245   }
 246   {
 247     var cons?/eax: boolean <- string-equal? f-name, "cons"
 248     compare cons?, 0/false
 249     break-if-=
 250     apply-cons args-ah, out, trace
 251     return
 252   }
 253   {
 254     var structurally-equal?/eax: boolean <- string-equal? f-name, "="
 255     compare structurally-equal?, 0/false
 256     break-if-=
 257     apply-structurally-equal args-ah, out, trace
 258     return
 259   }
 260   {
 261     var not?/eax: boolean <- string-equal? f-name, "no"
 262     compare not?, 0/false
 263     break-if-=
 264     apply-not args-ah, out, trace
 265     return
 266   }
 267   {
 268     var not?/eax: boolean <- string-equal? f-name, "not"
 269     compare not?, 0/false
 270     break-if-=
 271     apply-not args-ah, out, trace
 272     return
 273   }
 274   {
 275     var debug?/eax: boolean <- string-equal? f-name, "dbg"
 276     compare debug?, 0/false
 277     break-if-=
 278     apply-debug args-ah, out, trace
 279     return
 280   }
 281   {
 282     var lesser?/eax: boolean <- string-equal? f-name, "<"
 283     compare lesser?, 0/false
 284     break-if-=
 285     apply-< args-ah, out, trace
 286     return
 287   }
 288   {
 289     var greater?/eax: boolean <- string-equal? f-name, ">"
 290     compare greater?, 0/false
 291     break-if-=
 292     apply-> args-ah, out, trace
 293     return
 294   }
 295   {
 296     var lesser-or-equal?/eax: boolean <- string-equal? f-name, "<="
 297     compare lesser-or-equal?, 0/false
 298     break-if-=
 299     apply-<= args-ah, out, trace
 300     return
 301   }
 302   {
 303     var greater-or-equal?/eax: boolean <- string-equal? f-name, ">="
 304     compare greater-or-equal?, 0/false
 305     break-if-=
 306     apply->= args-ah, out, trace
 307     return
 308   }
 309   {
 310     var print?/eax: boolean <- string-equal? f-name, "print"
 311     compare print?, 0/false
 312     break-if-=
 313     apply-print args-ah, out, trace
 314     return
 315   }
 316   {
 317     var clear?/eax: boolean <- string-equal? f-name, "clear"
 318     compare clear?, 0/false
 319     break-if-=
 320     apply-clear args-ah, out, trace
 321     return
 322   }
 323   {
 324     var lines?/eax: boolean <- string-equal? f-name, "lines"
 325     compare lines?, 0/false
 326     break-if-=
 327     apply-lines args-ah, out, trace
 328     return
 329   }
 330   {
 331     var columns?/eax: boolean <- string-equal? f-name, "columns"
 332     compare columns?, 0/false
 333     break-if-=
 334     apply-columns args-ah, out, trace
 335     return
 336   }
 337   {
 338     var up?/eax: boolean <- string-equal? f-name, "up"
 339     compare up?, 0/false
 340     break-if-=
 341     apply-up args-ah, out, trace
 342     return
 343   }
 344   {
 345     var down?/eax: boolean <- string-equal? f-name, "down"
 346     compare down?, 0/false
 347     break-if-=
 348     apply-down args-ah, out, trace
 349     return
 350   }
 351   {
 352     var left?/eax: boolean <- string-equal? f-name, "left"
 353     compare left?, 0/false
 354     break-if-=
 355     apply-left args-ah, out, trace
 356     return
 357   }
 358   {
 359     var right?/eax: boolean <- string-equal? f-name, "right"
 360     compare right?, 0/false
 361     break-if-=
 362     apply-right args-ah, out, trace
 363     return
 364   }
 365   {
 366     var cr?/eax: boolean <- string-equal? f-name, "cr"
 367     compare cr?, 0/false
 368     break-if-=
 369     apply-cr args-ah, out, trace
 370     return
 371   }
 372   {
 373     var pixel?/eax: boolean <- string-equal? f-name, "pixel"
 374     compare pixel?, 0/false
 375     break-if-=
 376     apply-pixel args-ah, out, trace
 377     return
 378   }
 379   {
 380     var width?/eax: boolean <- string-equal? f-name, "width"
 381     compare width?, 0/false
 382     break-if-=
 383     apply-width args-ah, out, trace
 384     return
 385   }
 386   {
 387     var height?/eax: boolean <- string-equal? f-name, "height"
 388     compare height?, 0/false
 389     break-if-=
 390     apply-height args-ah, out, trace
 391     return
 392   }
 393   {
 394     var wait-for-key?/eax: boolean <- string-equal? f-name, "key"
 395     compare wait-for-key?, 0/false
 396     break-if-=
 397     apply-wait-for-key args-ah, out, trace
 398     return
 399   }
 400   {
 401     var stream?/eax: boolean <- string-equal? f-name, "stream"
 402     compare stream?, 0/false
 403     break-if-=
 404     apply-stream args-ah, out, trace
 405     return
 406   }
 407   {
 408     var write?/eax: boolean <- string-equal? f-name, "write"
 409     compare write?, 0/false
 410     break-if-=
 411     apply-write args-ah, out, trace
 412     return
 413   }
 414   {
 415     var abort?/eax: boolean <- string-equal? f-name, "abort"
 416     compare abort?, 0/false
 417     break-if-=
 418     apply-abort args-ah, out, trace
 419     return
 420   }
 421   abort "unknown primitive function"
 422 }
 423 
 424 fn apply-add _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 425   trace-text trace, "eval", "apply +"
 426   var args-ah/eax: (addr handle cell) <- copy _args-ah
 427   var _args/eax: (addr cell) <- lookup *args-ah
 428   var args/esi: (addr cell) <- copy _args
 429   {
 430     var args-type/ecx: (addr int) <- get args, type
 431     compare *args-type, 0/pair
 432     break-if-=
 433     error trace, "args to + are not a list"
 434     return
 435   }
 436   var empty-args?/eax: boolean <- nil? args
 437   compare empty-args?, 0/false
 438   {
 439     break-if-=
 440     error trace, "+ needs 2 args but got 0"
 441     return
 442   }
 443   # args->left->value
 444   var first-ah/eax: (addr handle cell) <- get args, left
 445   var first/eax: (addr cell) <- lookup *first-ah
 446   var first-type/ecx: (addr int) <- get first, type
 447   compare *first-type, 1/number
 448   {
 449     break-if-=
 450     error trace, "first arg for + is not a number"
 451     return
 452   }
 453   var first-value/ecx: (addr float) <- get first, number-data
 454   # args->right->left->value
 455   var right-ah/eax: (addr handle cell) <- get args, right
 456   var right/eax: (addr cell) <- lookup *right-ah
 457   {
 458     var right-type/ecx: (addr int) <- get right, type
 459     compare *right-type, 0/pair
 460     break-if-=
 461     error trace, "+ encountered non-pair"
 462     return
 463   }
 464   {
 465     var nil?/eax: boolean <- nil? right
 466     compare nil?, 0/false
 467     break-if-=
 468     error trace, "+ needs 2 args but got 1"
 469     return
 470   }
 471   var second-ah/eax: (addr handle cell) <- get right, left
 472   var second/eax: (addr cell) <- lookup *second-ah
 473   var second-type/edx: (addr int) <- get second, type
 474   compare *second-type, 1/number
 475   {
 476     break-if-=
 477     error trace, "second arg for + is not a number"
 478     return
 479   }
 480   var second-value/edx: (addr float) <- get second, number-data
 481   # add
 482   var result/xmm0: float <- copy *first-value
 483   result <- add *second-value
 484   new-float out, result
 485 }
 486 
 487 fn test-evaluate-missing-arg-in-add {
 488   var t-storage: trace
 489   var t/edi: (addr trace) <- address t-storage
 490   initialize-trace t, 0x100/max-depth, 0x100/capacity, 0/visible  # we don't use trace UI
 491   #
 492   var nil-storage: (handle cell)
 493   var nil-ah/ecx: (addr handle cell) <- address nil-storage
 494   allocate-pair nil-ah
 495   var one-storage: (handle cell)
 496   var one-ah/edx: (addr handle cell) <- address one-storage
 497   new-integer one-ah, 1
 498   var add-storage: (handle cell)
 499   var add-ah/ebx: (addr handle cell) <- address add-storage
 500   new-symbol add-ah, "+"
 501   # input is (+ 1)
 502   var tmp-storage: (handle cell)
 503   var tmp-ah/esi: (addr handle cell) <- address tmp-storage
 504   new-pair tmp-ah, *one-ah, *nil-ah
 505   new-pair tmp-ah, *add-ah, *tmp-ah
 506 #?   dump-cell tmp-ah
 507   #
 508   var globals-storage: global-table
 509   var globals/edx: (addr global-table) <- address globals-storage
 510   initialize-globals globals
 511   #
 512   evaluate tmp-ah, tmp-ah, *nil-ah, globals, t, 0/no-screen, 0/no-keyboard, 0/definitions-created, 0/call-number
 513   # no crash
 514 }
 515 
 516 fn apply-subtract _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 517   trace-text trace, "eval", "apply -"
 518   var args-ah/eax: (addr handle cell) <- copy _args-ah
 519   var _args/eax: (addr cell) <- lookup *args-ah
 520   var args/esi: (addr cell) <- copy _args
 521   {
 522     var args-type/ecx: (addr int) <- get args, type
 523     compare *args-type, 0/pair
 524     break-if-=
 525     error trace, "args to - are not a list"
 526     return
 527   }
 528   var empty-args?/eax: boolean <- nil? args
 529   compare empty-args?, 0/false
 530   {
 531     break-if-=
 532     error trace, "- needs 2 args but got 0"
 533     return
 534   }
 535   # args->left->value
 536   var first-ah/eax: (addr handle cell) <- get args, left
 537   var first/eax: (addr cell) <- lookup *first-ah
 538   var first-type/ecx: (addr int) <- get first, type
 539   compare *first-type, 1/number
 540   {
 541     break-if-=
 542     error trace, "first arg for - is not a number"
 543     return
 544   }
 545   var first-value/ecx: (addr float) <- get first, number-data
 546   # args->right->left->value
 547   var right-ah/eax: (addr handle cell) <- get args, right
 548   var right/eax: (addr cell) <- lookup *right-ah
 549   {
 550     var right-type/ecx: (addr int) <- get right, type
 551     compare *right-type, 0/pair
 552     break-if-=
 553     error trace, "- encountered non-pair"
 554     return
 555   }
 556   {
 557     var nil?/eax: boolean <- nil? right
 558     compare nil?, 0/false
 559     break-if-=
 560     error trace, "- needs 2 args but got 1"
 561     return
 562   }
 563   var second-ah/eax: (addr handle cell) <- get right, left
 564   var second/eax: (addr cell) <- lookup *second-ah
 565   var second-type/edx: (addr int) <- get second, type
 566   compare *second-type, 1/number
 567   {
 568     break-if-=
 569     error trace, "second arg for - is not a number"
 570     return
 571   }
 572   var second-value/edx: (addr float) <- get second, number-data
 573   # subtract
 574   var result/xmm0: float <- copy *first-value
 575   result <- subtract *second-value
 576   new-float out, result
 577 }
 578 
 579 fn apply-multiply _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 580   trace-text trace, "eval", "apply *"
 581   var args-ah/eax: (addr handle cell) <- copy _args-ah
 582   var _args/eax: (addr cell) <- lookup *args-ah
 583   var args/esi: (addr cell) <- copy _args
 584   {
 585     var args-type/ecx: (addr int) <- get args, type
 586     compare *args-type, 0/pair
 587     break-if-=
 588     error trace, "args to * are not a list"
 589     return
 590   }
 591   var empty-args?/eax: boolean <- nil? args
 592   compare empty-args?, 0/false
 593   {
 594     break-if-=
 595     error trace, "* needs 2 args but got 0"
 596     return
 597   }
 598   # args->left->value
 599   var first-ah/eax: (addr handle cell) <- get args, left
 600   var first/eax: (addr cell) <- lookup *first-ah
 601   var first-type/ecx: (addr int) <- get first, type
 602   compare *first-type, 1/number
 603   {
 604     break-if-=
 605     error trace, "first arg for * is not a number"
 606     return
 607   }
 608   var first-value/ecx: (addr float) <- get first, number-data
 609   # args->right->left->value
 610   var right-ah/eax: (addr handle cell) <- get args, right
 611   var right/eax: (addr cell) <- lookup *right-ah
 612   {
 613     var right-type/ecx: (addr int) <- get right, type
 614     compare *right-type, 0/pair
 615     break-if-=
 616     error trace, "* encountered non-pair"
 617     return
 618   }
 619   {
 620     var nil?/eax: boolean <- nil? right
 621     compare nil?, 0/false
 622     break-if-=
 623     error trace, "* needs 2 args but got 1"
 624     return
 625   }
 626   var second-ah/eax: (addr handle cell) <- get right, left
 627   var second/eax: (addr cell) <- lookup *second-ah
 628   var second-type/edx: (addr int) <- get second, type
 629   compare *second-type, 1/number
 630   {
 631     break-if-=
 632     error trace, "second arg for * is not a number"
 633     return
 634   }
 635   var second-value/edx: (addr float) <- get second, number-data
 636   # multiply
 637   var result/xmm0: float <- copy *first-value
 638   result <- multiply *second-value
 639   new-float out, result
 640 }
 641 
 642 fn apply-divide _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 643   trace-text trace, "eval", "apply /"
 644   var args-ah/eax: (addr handle cell) <- copy _args-ah
 645   var _args/eax: (addr cell) <- lookup *args-ah
 646   var args/esi: (addr cell) <- copy _args
 647   {
 648     var args-type/ecx: (addr int) <- get args, type
 649     compare *args-type, 0/pair
 650     break-if-=
 651     error trace, "args to / are not a list"
 652     return
 653   }
 654   var empty-args?/eax: boolean <- nil? args
 655   compare empty-args?, 0/false
 656   {
 657     break-if-=
 658     error trace, "/ needs 2 args but got 0"
 659     return
 660   }
 661   # args->left->value
 662   var first-ah/eax: (addr handle cell) <- get args, left
 663   var first/eax: (addr cell) <- lookup *first-ah
 664   var first-type/ecx: (addr int) <- get first, type
 665   compare *first-type, 1/number
 666   {
 667     break-if-=
 668     error trace, "first arg for / is not a number"
 669     return
 670   }
 671   var first-value/ecx: (addr float) <- get first, number-data
 672   # args->right->left->value
 673   var right-ah/eax: (addr handle cell) <- get args, right
 674   var right/eax: (addr cell) <- lookup *right-ah
 675   {
 676     var right-type/ecx: (addr int) <- get right, type
 677     compare *right-type, 0/pair
 678     break-if-=
 679     error trace, "/ encountered non-pair"
 680     return
 681   }
 682   {
 683     var nil?/eax: boolean <- nil? right
 684     compare nil?, 0/false
 685     break-if-=
 686     error trace, "/ needs 2 args but got 1"
 687     return
 688   }
 689   var second-ah/eax: (addr handle cell) <- get right, left
 690   var second/eax: (addr cell) <- lookup *second-ah
 691   var second-type/edx: (addr int) <- get second, type
 692   compare *second-type, 1/number
 693   {
 694     break-if-=
 695     error trace, "second arg for / is not a number"
 696     return
 697   }
 698   var second-value/edx: (addr float) <- get second, number-data
 699   # divide
 700   var result/xmm0: float <- copy *first-value
 701   result <- divide *second-value
 702   new-float out, result
 703 }
 704 
 705 fn apply-remainder _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 706   trace-text trace, "eval", "apply %"
 707   var args-ah/eax: (addr handle cell) <- copy _args-ah
 708   var _args/eax: (addr cell) <- lookup *args-ah
 709   var args/esi: (addr cell) <- copy _args
 710   {
 711     var args-type/ecx: (addr int) <- get args, type
 712     compare *args-type, 0/pair
 713     break-if-=
 714     error trace, "args to % are not a list"
 715     return
 716   }
 717   var empty-args?/eax: boolean <- nil? args
 718   compare empty-args?, 0/false
 719   {
 720     break-if-=
 721     error trace, "% needs 2 args but got 0"
 722     return
 723   }
 724   # args->left->value
 725   var first-ah/eax: (addr handle cell) <- get args, left
 726   var first/eax: (addr cell) <- lookup *first-ah
 727   var first-type/ecx: (addr int) <- get first, type
 728   compare *first-type, 1/number
 729   {
 730     break-if-=
 731     error trace, "first arg for % is not a number"
 732     return
 733   }
 734   var first-value/ecx: (addr float) <- get first, number-data
 735   # args->right->left->value
 736   var right-ah/eax: (addr handle cell) <- get args, right
 737   var right/eax: (addr cell) <- lookup *right-ah
 738   {
 739     var right-type/ecx: (addr int) <- get right, type
 740     compare *right-type, 0/pair
 741     break-if-=
 742     error trace, "% encountered non-pair"
 743     return
 744   }
 745   {
 746     var nil?/eax: boolean <- nil? right
 747     compare nil?, 0/false
 748     break-if-=
 749     error trace, "% needs 2 args but got 1"
 750     return
 751   }
 752   var second-ah/eax: (addr handle cell) <- get right, left
 753   var second/eax: (addr cell) <- lookup *second-ah
 754   var second-type/edx: (addr int) <- get second, type
 755   compare *second-type, 1/number
 756   {
 757     break-if-=
 758     error trace, "second arg for % is not a number"
 759     return
 760   }
 761   var second-value/edx: (addr float) <- get second, number-data
 762   # divide
 763   var quotient/xmm0: float <- copy *first-value
 764   quotient <- divide *second-value
 765   var quotient-int/eax: int <- truncate quotient
 766   quotient <- convert quotient-int
 767   var sub-result/xmm1: float <- copy quotient
 768   sub-result <- multiply *second-value
 769   var result/xmm0: float <- copy *first-value
 770   result <- subtract sub-result
 771   new-float out, result
 772 }
 773 
 774 fn apply-square-root _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 775   trace-text trace, "eval", "apply sqrt"
 776   var args-ah/eax: (addr handle cell) <- copy _args-ah
 777   var _args/eax: (addr cell) <- lookup *args-ah
 778   var args/esi: (addr cell) <- copy _args
 779   {
 780     var args-type/ecx: (addr int) <- get args, type
 781     compare *args-type, 0/pair
 782     break-if-=
 783     error trace, "args to sqrt are not a list"
 784     return
 785   }
 786   var empty-args?/eax: boolean <- nil? args
 787   compare empty-args?, 0/false
 788   {
 789     break-if-=
 790     error trace, "sqrt needs 1 arg but got 0"
 791     return
 792   }
 793   # args->left->value
 794   var first-ah/eax: (addr handle cell) <- get args, left
 795   var first/eax: (addr cell) <- lookup *first-ah
 796   var first-type/ecx: (addr int) <- get first, type
 797   compare *first-type, 1/number
 798   {
 799     break-if-=
 800     error trace, "arg for sqrt is not a number"
 801     return
 802   }
 803   var first-value/ecx: (addr float) <- get first, number-data
 804   # square-root
 805   var result/xmm0: float <- square-root *first-value
 806   new-float out, result
 807 }
 808 
 809 fn apply-abs _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 810   trace-text trace, "eval", "apply abs"
 811   var args-ah/eax: (addr handle cell) <- copy _args-ah
 812   var _args/eax: (addr cell) <- lookup *args-ah
 813   var args/esi: (addr cell) <- copy _args
 814   {
 815     var args-type/ecx: (addr int) <- get args, type
 816     compare *args-type, 0/pair
 817     break-if-=
 818     error trace, "args to abs are not a list"
 819     return
 820   }
 821   var empty-args?/eax: boolean <- nil? args
 822   compare empty-args?, 0/false
 823   {
 824     break-if-=
 825     error trace, "abs needs 1 arg but got 0"
 826     return
 827   }
 828   # args->left->value
 829   var first-ah/eax: (addr handle cell) <- get args, left
 830   var first/eax: (addr cell) <- lookup *first-ah
 831   var first-type/ecx: (addr int) <- get first, type
 832   compare *first-type, 1/number
 833   {
 834     break-if-=
 835     error trace, "arg for abs is not a number"
 836     return
 837   }
 838   var first-value/ecx: (addr float) <- get first, number-data
 839   #
 840   var result/xmm0: float <- copy *first-value
 841   var zero: float
 842   compare result, zero
 843   {
 844     break-if-float>=
 845     var neg1/eax: int <- copy -1
 846     var neg1-f/xmm1: float <- convert neg1
 847     result <- multiply neg1-f
 848   }
 849   new-float out, result
 850 }
 851 
 852 fn apply-sgn _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 853   trace-text trace, "eval", "apply sgn"
 854   var args-ah/eax: (addr handle cell) <- copy _args-ah
 855   var _args/eax: (addr cell) <- lookup *args-ah
 856   var args/esi: (addr cell) <- copy _args
 857   {
 858     var args-type/ecx: (addr int) <- get args, type
 859     compare *args-type, 0/pair
 860     break-if-=
 861     error trace, "args to sgn are not a list"
 862     return
 863   }
 864   var empty-args?/eax: boolean <- nil? args
 865   compare empty-args?, 0/false
 866   {
 867     break-if-=
 868     error trace, "sgn needs 1 arg but got 0"
 869     return
 870   }
 871   # args->left->value
 872   var first-ah/eax: (addr handle cell) <- get args, left
 873   var first/eax: (addr cell) <- lookup *first-ah
 874   var first-type/ecx: (addr int) <- get first, type
 875   compare *first-type, 1/number
 876   {
 877     break-if-=
 878     error trace, "arg for sgn is not a number"
 879     return
 880   }
 881   var first-value/ecx: (addr float) <- get first, number-data
 882   #
 883   var result/xmm0: float <- copy *first-value
 884   var zero: float
 885   $apply-sgn:core: {
 886     compare result, zero
 887     break-if-=
 888     {
 889       break-if-float>
 890       var neg1/eax: int <- copy -1
 891       result <- convert neg1
 892       break $apply-sgn:core
 893     }
 894     {
 895       break-if-float<
 896       var one/eax: int <- copy 1
 897       result <- convert one
 898       break $apply-sgn:core
 899     }
 900   }
 901   new-float out, result
 902 }
 903 
 904 fn apply-car _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 905   trace-text trace, "eval", "apply car"
 906   var args-ah/eax: (addr handle cell) <- copy _args-ah
 907   var _args/eax: (addr cell) <- lookup *args-ah
 908   var args/esi: (addr cell) <- copy _args
 909   {
 910     var args-type/ecx: (addr int) <- get args, type
 911     compare *args-type, 0/pair
 912     break-if-=
 913     error trace, "args to car are not a list"
 914     return
 915   }
 916   var empty-args?/eax: boolean <- nil? args
 917   compare empty-args?, 0/false
 918   {
 919     break-if-=
 920     error trace, "car needs 1 arg but got 0"
 921     return
 922   }
 923   # args->left
 924   var first-ah/edx: (addr handle cell) <- get args, left
 925   var first/eax: (addr cell) <- lookup *first-ah
 926   var first-type/ecx: (addr int) <- get first, type
 927   compare *first-type, 0/pair
 928   {
 929     break-if-=
 930     error trace, "arg for car is not a pair"
 931     return
 932   }
 933   # nil? return nil
 934   {
 935     var nil?/eax: boolean <- nil? first
 936     compare nil?, 0/false
 937     break-if-=
 938     copy-object first-ah, out
 939     return
 940   }
 941   # car
 942   var result/eax: (addr handle cell) <- get first, left
 943   copy-object result, out
 944 }
 945 
 946 fn apply-cdr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 947   trace-text trace, "eval", "apply cdr"
 948   var args-ah/eax: (addr handle cell) <- copy _args-ah
 949   var _args/eax: (addr cell) <- lookup *args-ah
 950   var args/esi: (addr cell) <- copy _args
 951   {
 952     var args-type/ecx: (addr int) <- get args, type
 953     compare *args-type, 0/pair
 954     break-if-=
 955     error trace, "args to cdr are not a list"
 956     return
 957   }
 958   var empty-args?/eax: boolean <- nil? args
 959   compare empty-args?, 0/false
 960   {
 961     break-if-=
 962     error trace, "cdr needs 1 arg but got 0"
 963     return
 964   }
 965   # args->left
 966   var first-ah/edx: (addr handle cell) <- get args, left
 967   var first/eax: (addr cell) <- lookup *first-ah
 968   var first-type/ecx: (addr int) <- get first, type
 969   compare *first-type, 0/pair
 970   {
 971     break-if-=
 972     error trace, "arg for cdr is not a pair"
 973     return
 974   }
 975   # nil? return nil
 976   {
 977     var nil?/eax: boolean <- nil? first
 978     compare nil?, 0/false
 979     break-if-=
 980     copy-object first-ah, out
 981     return
 982   }
 983   # cdr
 984   var result/eax: (addr handle cell) <- get first, right
 985   copy-object result, out
 986 }
 987 
 988 fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
 989   trace-text trace, "eval", "apply cons"
 990   var args-ah/eax: (addr handle cell) <- copy _args-ah
 991   var _args/eax: (addr cell) <- lookup *args-ah
 992   var args/esi: (addr cell) <- copy _args
 993   {
 994     var args-type/ecx: (addr int) <- get args, type
 995     compare *args-type, 0/pair
 996     break-if-=
 997     error trace, "args to 'cons' are not a list"
 998     return
 999   }
1000   var empty-args?/eax: boolean <- nil? args
1001   compare empty-args?, 0/false
1002   {
1003     break-if-=
1004     error trace, "cons needs 2 args but got 0"
1005     return
1006   }
1007   # args->left
1008   var first-ah/ecx: (addr handle cell) <- get args, left
1009   # args->right->left
1010   var right-ah/eax: (addr handle cell) <- get args, right
1011   var right/eax: (addr cell) <- lookup *right-ah
1012   {
1013     var right-type/ecx: (addr int) <- get right, type
1014     compare *right-type, 0/pair
1015     break-if-=
1016     error trace, "'cons' encountered non-pair"
1017     return
1018   }
1019   {
1020     var nil?/eax: boolean <- nil? right
1021     compare nil?, 0/false
1022     break-if-=
1023     error trace, "'cons' needs 2 args but got 1"
1024     return
1025   }
1026   var second-ah/eax: (addr handle cell) <- get right, left
1027   # cons
1028   new-pair out, *first-ah, *second-ah
1029 }
1030 
1031 fn apply-structurally-equal _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1032   trace-text trace, "eval", "apply '='"
1033   var args-ah/eax: (addr handle cell) <- copy _args-ah
1034   var _args/eax: (addr cell) <- lookup *args-ah
1035   var args/esi: (addr cell) <- copy _args
1036   {
1037     var args-type/ecx: (addr int) <- get args, type
1038     compare *args-type, 0/pair
1039     break-if-=
1040     error trace, "args to '=' are not a list"
1041     return
1042   }
1043   var empty-args?/eax: boolean <- nil? args
1044   compare empty-args?, 0/false
1045   {
1046     break-if-=
1047     error trace, "'=' needs 2 args but got 0"
1048     return
1049   }
1050   # args->left
1051   var first-ah/ecx: (addr handle cell) <- get args, left
1052   # args->right->left
1053   var right-ah/eax: (addr handle cell) <- get args, right
1054   var right/eax: (addr cell) <- lookup *right-ah
1055   {
1056     var right-type/ecx: (addr int) <- get right, type
1057     compare *right-type, 0/pair
1058     break-if-=
1059     error trace, "'=' encountered non-pair"
1060     return
1061   }
1062   {
1063     var nil?/eax: boolean <- nil? right
1064     compare nil?, 0/false
1065     break-if-=
1066     error trace, "'=' needs 2 args but got 1"
1067     return
1068   }
1069   var second-ah/edx: (addr handle cell) <- get right, left
1070   # compare
1071   var _first/eax: (addr cell) <- lookup *first-ah
1072   var first/ecx: (addr cell) <- copy _first
1073   var second/eax: (addr cell) <- lookup *second-ah
1074   var match?/eax: boolean <- cell-isomorphic? first, second, trace
1075   compare match?, 0/false
1076   {
1077     break-if-!=
1078     nil out
1079     return
1080   }
1081   new-integer out, 1/true
1082 }
1083 
1084 fn apply-not _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1085   trace-text trace, "eval", "apply 'not'"
1086   var args-ah/eax: (addr handle cell) <- copy _args-ah
1087   var _args/eax: (addr cell) <- lookup *args-ah
1088   var args/esi: (addr cell) <- copy _args
1089   {
1090     var args-type/ecx: (addr int) <- get args, type
1091     compare *args-type, 0/pair
1092     break-if-=
1093     error trace, "args to 'not' are not a list"
1094     return
1095   }
1096   var empty-args?/eax: boolean <- nil? args
1097   compare empty-args?, 0/false
1098   {
1099     break-if-=
1100     error trace, "'not' needs 1 arg but got 0"
1101     return
1102   }
1103   # args->left
1104   var first-ah/eax: (addr handle cell) <- get args, left
1105   var first/eax: (addr cell) <- lookup *first-ah
1106   # not
1107   var nil?/eax: boolean <- nil? first
1108   compare nil?, 0/false
1109   {
1110     break-if-!=
1111     nil out
1112     return
1113   }
1114   new-integer out, 1
1115 }
1116 
1117 fn apply-debug _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1118   trace-text trace, "eval", "apply 'debug'"
1119   var args-ah/eax: (addr handle cell) <- copy _args-ah
1120   var _args/eax: (addr cell) <- lookup *args-ah
1121   var args/esi: (addr cell) <- copy _args
1122   {
1123     var args-type/ecx: (addr int) <- get args, type
1124     compare *args-type, 0/pair
1125     break-if-=
1126     error trace, "args to 'debug' are not a list"
1127     return
1128   }
1129   var empty-args?/eax: boolean <- nil? args
1130   compare empty-args?, 0/false
1131   {
1132     break-if-=
1133     error trace, "'debug' needs 1 arg but got 0"
1134     return
1135   }
1136   # dump args->left uglily to screen and wait for a keypress
1137   var first-ah/eax: (addr handle cell) <- get args, left
1138   dump-cell-from-cursor-over-full-screen first-ah, 7/fg 0/bg
1139   {
1140     var foo/eax: byte <- read-key 0/keyboard
1141     compare foo, 0
1142     loop-if-=
1143   }
1144   # return nothing
1145 }
1146 
1147 fn apply-< _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1148   trace-text trace, "eval", "apply '<'"
1149   var args-ah/eax: (addr handle cell) <- copy _args-ah
1150   var _args/eax: (addr cell) <- lookup *args-ah
1151   var args/esi: (addr cell) <- copy _args
1152   {
1153     var args-type/ecx: (addr int) <- get args, type
1154     compare *args-type, 0/pair
1155     break-if-=
1156     error trace, "args to '<' are not a list"
1157     return
1158   }
1159   var empty-args?/eax: boolean <- nil? args
1160   compare empty-args?, 0/false
1161   {
1162     break-if-=
1163     error trace, "'<' needs 2 args but got 0"
1164     return
1165   }
1166   # args->left
1167   var first-ah/ecx: (addr handle cell) <- get args, left
1168   # args->right->left
1169   var right-ah/eax: (addr handle cell) <- get args, right
1170   var right/eax: (addr cell) <- lookup *right-ah
1171   {
1172     var right-type/ecx: (addr int) <- get right, type
1173     compare *right-type, 0/pair
1174     break-if-=
1175     error trace, "'<' encountered non-pair"
1176     return
1177   }
1178   {
1179     var nil?/eax: boolean <- nil? right
1180     compare nil?, 0/false
1181     break-if-=
1182     error trace, "'<' needs 2 args but got 1"
1183     return
1184   }
1185   var second-ah/edx: (addr handle cell) <- get right, left
1186   # compare
1187   var _first/eax: (addr cell) <- lookup *first-ah
1188   var first/ecx: (addr cell) <- copy _first
1189   var first-type/eax: (addr int) <- get first, type
1190   compare *first-type, 1/number
1191   {
1192     break-if-=
1193     error trace, "first arg for '<' is not a number"
1194     return
1195   }
1196   var first-value/ecx: (addr float) <- get first, number-data
1197   var first-float/xmm0: float <- copy *first-value
1198   var second/eax: (addr cell) <- lookup *second-ah
1199   var second-type/edx: (addr int) <- get second, type
1200   compare *second-type, 1/number
1201   {
1202     break-if-=
1203     error trace, "second arg for '<' is not a number"
1204     return
1205   }
1206   var second-value/eax: (addr float) <- get second, number-data
1207   compare first-float, *second-value
1208   {
1209     break-if-float<
1210     nil out
1211     return
1212   }
1213   new-integer out, 1/true
1214 }
1215 
1216 fn apply-> _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1217   trace-text trace, "eval", "apply '>'"
1218   var args-ah/eax: (addr handle cell) <- copy _args-ah
1219   var _args/eax: (addr cell) <- lookup *args-ah
1220   var args/esi: (addr cell) <- copy _args
1221   {
1222     var args-type/ecx: (addr int) <- get args, type
1223     compare *args-type, 0/pair
1224     break-if-=
1225     error trace, "args to '>' are not a list"
1226     return
1227   }
1228   var empty-args?/eax: boolean <- nil? args
1229   compare empty-args?, 0/false
1230   {
1231     break-if-=
1232     error trace, "'>' needs 2 args but got 0"
1233     return
1234   }
1235   # args->left
1236   var first-ah/ecx: (addr handle cell) <- get args, left
1237   # args->right->left
1238   var right-ah/eax: (addr handle cell) <- get args, right
1239   var right/eax: (addr cell) <- lookup *right-ah
1240   {
1241     var right-type/ecx: (addr int) <- get right, type
1242     compare *right-type, 0/pair
1243     break-if-=
1244     error trace, "'>' encountered non-pair"
1245     return
1246   }
1247   {
1248     var nil?/eax: boolean <- nil? right
1249     compare nil?, 0/false
1250     break-if-=
1251     error trace, "'>' needs 2 args but got 1"
1252     return
1253   }
1254   var second-ah/edx: (addr handle cell) <- get right, left
1255   # compare
1256   var _first/eax: (addr cell) <- lookup *first-ah
1257   var first/ecx: (addr cell) <- copy _first
1258   var first-type/eax: (addr int) <- get first, type
1259   compare *first-type, 1/number
1260   {
1261     break-if-=
1262     error trace, "first arg for '>' is not a number"
1263     return
1264   }
1265   var first-value/ecx: (addr float) <- get first, number-data
1266   var first-float/xmm0: float <- copy *first-value
1267   var second/eax: (addr cell) <- lookup *second-ah
1268   var second-type/edx: (addr int) <- get second, type
1269   compare *second-type, 1/number
1270   {
1271     break-if-=
1272     error trace, "second arg for '>' is not a number"
1273     return
1274   }
1275   var second-value/eax: (addr float) <- get second, number-data
1276   compare first-float, *second-value
1277   {
1278     break-if-float>
1279     nil out
1280     return
1281   }
1282   new-integer out, 1/true
1283 }
1284 
1285 fn apply-<= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1286   trace-text trace, "eval", "apply '<='"
1287   var args-ah/eax: (addr handle cell) <- copy _args-ah
1288   var _args/eax: (addr cell) <- lookup *args-ah
1289   var args/esi: (addr cell) <- copy _args
1290   {
1291     var args-type/ecx: (addr int) <- get args, type
1292     compare *args-type, 0/pair
1293     break-if-=
1294     error trace, "args to '<=' are not a list"
1295     return
1296   }
1297   var empty-args?/eax: boolean <- nil? args
1298   compare empty-args?, 0/false
1299   {
1300     break-if-=
1301     error trace, "'<=' needs 2 args but got 0"
1302     return
1303   }
1304   # args->left
1305   var first-ah/ecx: (addr handle cell) <- get args, left
1306   # args->right->left
1307   var right-ah/eax: (addr handle cell) <- get args, right
1308   var right/eax: (addr cell) <- lookup *right-ah
1309   {
1310     var right-type/ecx: (addr int) <- get right, type
1311     compare *right-type, 0/pair
1312     break-if-=
1313     error trace, "'<=' encountered non-pair"
1314     return
1315   }
1316   {
1317     var nil?/eax: boolean <- nil? right
1318     compare nil?, 0/false
1319     break-if-=
1320     error trace, "'<=' needs 2 args but got 1"
1321     return
1322   }
1323   var second-ah/edx: (addr handle cell) <- get right, left
1324   # compare
1325   var _first/eax: (addr cell) <- lookup *first-ah
1326   var first/ecx: (addr cell) <- copy _first
1327   var first-type/eax: (addr int) <- get first, type
1328   compare *first-type, 1/number
1329   {
1330     break-if-=
1331     error trace, "first arg for '<=' is not a number"
1332     return
1333   }
1334   var first-value/ecx: (addr float) <- get first, number-data
1335   var first-float/xmm0: float <- copy *first-value
1336   var second/eax: (addr cell) <- lookup *second-ah
1337   var second-type/edx: (addr int) <- get second, type
1338   compare *second-type, 1/number
1339   {
1340     break-if-=
1341     error trace, "second arg for '<=' is not a number"
1342     return
1343   }
1344   var second-value/eax: (addr float) <- get second, number-data
1345   compare first-float, *second-value
1346   {
1347     break-if-float<=
1348     nil out
1349     return
1350   }
1351   new-integer out, 1/true
1352 }
1353 
1354 fn apply->= _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1355   trace-text trace, "eval", "apply '>='"
1356   var args-ah/eax: (addr handle cell) <- copy _args-ah
1357   var _args/eax: (addr cell) <- lookup *args-ah
1358   var args/esi: (addr cell) <- copy _args
1359   {
1360     var args-type/ecx: (addr int) <- get args, type
1361     compare *args-type, 0/pair
1362     break-if-=
1363     error trace, "args to '>=' are not a list"
1364     return
1365   }
1366   var empty-args?/eax: boolean <- nil? args
1367   compare empty-args?, 0/false
1368   {
1369     break-if-=
1370     error trace, "'>=' needs 2 args but got 0"
1371     return
1372   }
1373   # args->left
1374   var first-ah/ecx: (addr handle cell) <- get args, left
1375   # args->right->left
1376   var right-ah/eax: (addr handle cell) <- get args, right
1377   var right/eax: (addr cell) <- lookup *right-ah
1378   {
1379     var right-type/ecx: (addr int) <- get right, type
1380     compare *right-type, 0/pair
1381     break-if-=
1382     error trace, "'>=' encountered non-pair"
1383     return
1384   }
1385   {
1386     var nil?/eax: boolean <- nil? right
1387     compare nil?, 0/false
1388     break-if-=
1389     error trace, "'>=' needs 2 args but got 1"
1390     return
1391   }
1392   var second-ah/edx: (addr handle cell) <- get right, left
1393   # compare
1394   var _first/eax: (addr cell) <- lookup *first-ah
1395   var first/ecx: (addr cell) <- copy _first
1396   var first-type/eax: (addr int) <- get first, type
1397   compare *first-type, 1/number
1398   {
1399     break-if-=
1400     error trace, "first arg for '>=' is not a number"
1401     return
1402   }
1403   var first-value/ecx: (addr float) <- get first, number-data
1404   var first-float/xmm0: float <- copy *first-value
1405   var second/eax: (addr cell) <- lookup *second-ah
1406   var second-type/edx: (addr int) <- get second, type
1407   compare *second-type, 1/number
1408   {
1409     break-if-=
1410     error trace, "second arg for '>=' is not a number"
1411     return
1412   }
1413   var second-value/eax: (addr float) <- get second, number-data
1414   compare first-float, *second-value
1415   {
1416     break-if-float>=
1417     nil out
1418     return
1419   }
1420   new-integer out, 1/true
1421 }
1422 
1423 fn apply-print _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1424   trace-text trace, "eval", "apply 'print'"
1425   var args-ah/eax: (addr handle cell) <- copy _args-ah
1426   var _args/eax: (addr cell) <- lookup *args-ah
1427   var args/esi: (addr cell) <- copy _args
1428   {
1429     var args-type/ecx: (addr int) <- get args, type
1430     compare *args-type, 0/pair
1431     break-if-=
1432     error trace, "args to 'print' are not a list"
1433     return
1434   }
1435   var empty-args?/eax: boolean <- nil? args
1436   compare empty-args?, 0/false
1437   {
1438     break-if-=
1439     error trace, "'print' needs 2 args but got 0"
1440     return
1441   }
1442   # screen = args->left
1443   var first-ah/eax: (addr handle cell) <- get args, left
1444   var first/eax: (addr cell) <- lookup *first-ah
1445   var first-type/ecx: (addr int) <- get first, type
1446   compare *first-type, 5/screen
1447   {
1448     break-if-=
1449     error trace, "first arg for 'print' is not a screen"
1450     return
1451   }
1452   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1453   var _screen/eax: (addr screen) <- lookup *screen-ah
1454   var screen/ecx: (addr screen) <- copy _screen
1455   # args->right->left
1456   var right-ah/eax: (addr handle cell) <- get args, right
1457   var right/eax: (addr cell) <- lookup *right-ah
1458   {
1459     var right-type/ecx: (addr int) <- get right, type
1460     compare *right-type, 0/pair
1461     break-if-=
1462     error trace, "'print' encountered non-pair"
1463     return
1464   }
1465   {
1466     var nil?/eax: boolean <- nil? right
1467     compare nil?, 0/false
1468     break-if-=
1469     error trace, "'print' needs 2 args but got 1"
1470     return
1471   }
1472   var second-ah/eax: (addr handle cell) <- get right, left
1473   var stream-storage: (stream byte 0x100)
1474   var stream/edi: (addr stream byte) <- address stream-storage
1475   print-cell second-ah, stream, trace
1476   draw-stream-wrapping-right-then-down-from-cursor-over-full-screen screen, stream, 7/fg, 0/bg
1477   # return what was printed
1478   copy-object second-ah, out
1479 }
1480 
1481 fn apply-clear _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1482   trace-text trace, "eval", "apply 'clear'"
1483   var args-ah/eax: (addr handle cell) <- copy _args-ah
1484   var _args/eax: (addr cell) <- lookup *args-ah
1485   var args/esi: (addr cell) <- copy _args
1486   {
1487     var args-type/ecx: (addr int) <- get args, type
1488     compare *args-type, 0/pair
1489     break-if-=
1490     error trace, "args to 'clear' are not a list"
1491     return
1492   }
1493   var empty-args?/eax: boolean <- nil? args
1494   compare empty-args?, 0/false
1495   {
1496     break-if-=
1497     error trace, "'clear' needs 1 arg but got 0"
1498     return
1499   }
1500   # screen = args->left
1501   var first-ah/eax: (addr handle cell) <- get args, left
1502   var first/eax: (addr cell) <- lookup *first-ah
1503   var first-type/ecx: (addr int) <- get first, type
1504   compare *first-type, 5/screen
1505   {
1506     break-if-=
1507     error trace, "first arg for 'clear' is not a screen"
1508     return
1509   }
1510   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1511   var _screen/eax: (addr screen) <- lookup *screen-ah
1512   var screen/ecx: (addr screen) <- copy _screen
1513   #
1514   clear-screen screen
1515 }
1516 
1517 fn apply-up _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1518   trace-text trace, "eval", "apply 'up'"
1519   var args-ah/eax: (addr handle cell) <- copy _args-ah
1520   var _args/eax: (addr cell) <- lookup *args-ah
1521   var args/esi: (addr cell) <- copy _args
1522   {
1523     var args-type/ecx: (addr int) <- get args, type
1524     compare *args-type, 0/pair
1525     break-if-=
1526     error trace, "args to 'up' are not a list"
1527     return
1528   }
1529   var empty-args?/eax: boolean <- nil? args
1530   compare empty-args?, 0/false
1531   {
1532     break-if-=
1533     error trace, "'up' needs 1 arg but got 0"
1534     return
1535   }
1536   # screen = args->left
1537   var first-ah/eax: (addr handle cell) <- get args, left
1538   var first/eax: (addr cell) <- lookup *first-ah
1539   var first-type/ecx: (addr int) <- get first, type
1540   compare *first-type, 5/screen
1541   {
1542     break-if-=
1543     error trace, "first arg for 'up' is not a screen"
1544     return
1545   }
1546   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1547   var _screen/eax: (addr screen) <- lookup *screen-ah
1548   var screen/ecx: (addr screen) <- copy _screen
1549   #
1550   move-cursor-up screen
1551 }
1552 
1553 fn apply-down _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1554   trace-text trace, "eval", "apply 'down'"
1555   var args-ah/eax: (addr handle cell) <- copy _args-ah
1556   var _args/eax: (addr cell) <- lookup *args-ah
1557   var args/esi: (addr cell) <- copy _args
1558   {
1559     var args-type/ecx: (addr int) <- get args, type
1560     compare *args-type, 0/pair
1561     break-if-=
1562     error trace, "args to 'down' are not a list"
1563     return
1564   }
1565   var empty-args?/eax: boolean <- nil? args
1566   compare empty-args?, 0/false
1567   {
1568     break-if-=
1569     error trace, "'down' needs 1 arg but got 0"
1570     return
1571   }
1572   # screen = args->left
1573   var first-ah/eax: (addr handle cell) <- get args, left
1574   var first/eax: (addr cell) <- lookup *first-ah
1575   var first-type/ecx: (addr int) <- get first, type
1576   compare *first-type, 5/screen
1577   {
1578     break-if-=
1579     error trace, "first arg for 'down' is not a screen"
1580     return
1581   }
1582   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1583   var _screen/eax: (addr screen) <- lookup *screen-ah
1584   var screen/ecx: (addr screen) <- copy _screen
1585   #
1586   move-cursor-down screen
1587 }
1588 
1589 fn apply-left _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1590   trace-text trace, "eval", "apply 'left'"
1591   var args-ah/eax: (addr handle cell) <- copy _args-ah
1592   var _args/eax: (addr cell) <- lookup *args-ah
1593   var args/esi: (addr cell) <- copy _args
1594   {
1595     var args-type/ecx: (addr int) <- get args, type
1596     compare *args-type, 0/pair
1597     break-if-=
1598     error trace, "args to 'left' are not a list"
1599     return
1600   }
1601   var empty-args?/eax: boolean <- nil? args
1602   compare empty-args?, 0/false
1603   {
1604     break-if-=
1605     error trace, "'left' needs 1 arg but got 0"
1606     return
1607   }
1608   # screen = args->left
1609   var first-ah/eax: (addr handle cell) <- get args, left
1610   var first/eax: (addr cell) <- lookup *first-ah
1611   var first-type/ecx: (addr int) <- get first, type
1612   compare *first-type, 5/screen
1613   {
1614     break-if-=
1615     error trace, "first arg for 'left' is not a screen"
1616     return
1617   }
1618   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1619   var _screen/eax: (addr screen) <- lookup *screen-ah
1620   var screen/ecx: (addr screen) <- copy _screen
1621   #
1622   move-cursor-left screen
1623 }
1624 
1625 fn apply-right _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1626   trace-text trace, "eval", "apply 'right'"
1627   var args-ah/eax: (addr handle cell) <- copy _args-ah
1628   var _args/eax: (addr cell) <- lookup *args-ah
1629   var args/esi: (addr cell) <- copy _args
1630   {
1631     var args-type/ecx: (addr int) <- get args, type
1632     compare *args-type, 0/pair
1633     break-if-=
1634     error trace, "args to 'right' are not a list"
1635     return
1636   }
1637   var empty-args?/eax: boolean <- nil? args
1638   compare empty-args?, 0/false
1639   {
1640     break-if-=
1641     error trace, "'right' needs 1 arg but got 0"
1642     return
1643   }
1644   # screen = args->left
1645   var first-ah/eax: (addr handle cell) <- get args, left
1646   var first/eax: (addr cell) <- lookup *first-ah
1647   var first-type/ecx: (addr int) <- get first, type
1648   compare *first-type, 5/screen
1649   {
1650     break-if-=
1651     error trace, "first arg for 'right' is not a screen"
1652     return
1653   }
1654   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1655   var _screen/eax: (addr screen) <- lookup *screen-ah
1656   var screen/ecx: (addr screen) <- copy _screen
1657   #
1658   move-cursor-right screen
1659 }
1660 
1661 fn apply-cr _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1662   trace-text trace, "eval", "apply 'cr'"
1663   var args-ah/eax: (addr handle cell) <- copy _args-ah
1664   var _args/eax: (addr cell) <- lookup *args-ah
1665   var args/esi: (addr cell) <- copy _args
1666   {
1667     var args-type/ecx: (addr int) <- get args, type
1668     compare *args-type, 0/pair
1669     break-if-=
1670     error trace, "args to 'cr' are not a list"
1671     return
1672   }
1673   var empty-args?/eax: boolean <- nil? args
1674   compare empty-args?, 0/false
1675   {
1676     break-if-=
1677     error trace, "'cr' needs 1 arg but got 0"
1678     return
1679   }
1680   # screen = args->left
1681   var first-ah/eax: (addr handle cell) <- get args, left
1682   var first/eax: (addr cell) <- lookup *first-ah
1683   var first-type/ecx: (addr int) <- get first, type
1684   compare *first-type, 5/screen
1685   {
1686     break-if-=
1687     error trace, "first arg for 'cr' is not a screen"
1688     return
1689   }
1690   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1691   var _screen/eax: (addr screen) <- lookup *screen-ah
1692   var screen/ecx: (addr screen) <- copy _screen
1693   #
1694   move-cursor-to-left-margin-of-next-line screen
1695 }
1696 
1697 fn apply-pixel _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1698   trace-text trace, "eval", "apply 'pixel'"
1699   var args-ah/eax: (addr handle cell) <- copy _args-ah
1700   var _args/eax: (addr cell) <- lookup *args-ah
1701   var args/esi: (addr cell) <- copy _args
1702   {
1703     var args-type/ecx: (addr int) <- get args, type
1704     compare *args-type, 0/pair
1705     break-if-=
1706     error trace, "args to 'pixel' are not a list"
1707     return
1708   }
1709   var empty-args?/eax: boolean <- nil? args
1710   compare empty-args?, 0/false
1711   {
1712     break-if-=
1713     error trace, "'pixel' needs 4 args but got 0"
1714     return
1715   }
1716   # screen = args->left
1717   var first-ah/eax: (addr handle cell) <- get args, left
1718   var first/eax: (addr cell) <- lookup *first-ah
1719   var first-type/ecx: (addr int) <- get first, type
1720   compare *first-type, 5/screen
1721   {
1722     break-if-=
1723     error trace, "first arg for 'pixel' is not a screen"
1724     return
1725   }
1726   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1727   var _screen/eax: (addr screen) <- lookup *screen-ah
1728   var screen/edi: (addr screen) <- copy _screen
1729   # x = args->right->left->value
1730   var rest-ah/eax: (addr handle cell) <- get args, right
1731   var _rest/eax: (addr cell) <- lookup *rest-ah
1732   var rest/esi: (addr cell) <- copy _rest
1733   {
1734     var rest-type/ecx: (addr int) <- get rest, type
1735     compare *rest-type, 0/pair
1736     break-if-=
1737     error trace, "'pixel' encountered non-pair"
1738     return
1739   }
1740   {
1741     var rest-nil?/eax: boolean <- nil? rest
1742     compare rest-nil?, 0/false
1743     break-if-=
1744     error trace, "'pixel' needs 4 args but got 1"
1745     return
1746   }
1747   var second-ah/eax: (addr handle cell) <- get rest, left
1748   var second/eax: (addr cell) <- lookup *second-ah
1749   var second-type/ecx: (addr int) <- get second, type
1750   compare *second-type, 1/number
1751   {
1752     break-if-=
1753     error trace, "second arg for 'pixel' is not an int (x coordinate)"
1754     return
1755   }
1756   var second-value/eax: (addr float) <- get second, number-data
1757   var x/edx: int <- convert *second-value
1758   # y = rest->right->left->value
1759   var rest-ah/eax: (addr handle cell) <- get rest, right
1760   var _rest/eax: (addr cell) <- lookup *rest-ah
1761   rest <- copy _rest
1762   {
1763     var rest-type/ecx: (addr int) <- get rest, type
1764     compare *rest-type, 0/pair
1765     break-if-=
1766     error trace, "'pixel' encountered non-pair"
1767     return
1768   }
1769   {
1770     var rest-nil?/eax: boolean <- nil? rest
1771     compare rest-nil?, 0/false
1772     break-if-=
1773     error trace, "'pixel' needs 4 args but got 2"
1774     return
1775   }
1776   var third-ah/eax: (addr handle cell) <- get rest, left
1777   var third/eax: (addr cell) <- lookup *third-ah
1778   var third-type/ecx: (addr int) <- get third, type
1779   compare *third-type, 1/number
1780   {
1781     break-if-=
1782     error trace, "third arg for 'pixel' is not an int (y coordinate)"
1783     return
1784   }
1785   var third-value/eax: (addr float) <- get third, number-data
1786   var y/ebx: int <- convert *third-value
1787   # color = rest->right->left->value
1788   var rest-ah/eax: (addr handle cell) <- get rest, right
1789   var _rest/eax: (addr cell) <- lookup *rest-ah
1790   rest <- copy _rest
1791   {
1792     var rest-type/ecx: (addr int) <- get rest, type
1793     compare *rest-type, 0/pair
1794     break-if-=
1795     error trace, "'pixel' encountered non-pair"
1796     return
1797   }
1798   {
1799     var rest-nil?/eax: boolean <- nil? rest
1800     compare rest-nil?, 0/false
1801     break-if-=
1802     error trace, "'pixel' needs 4 args but got 3"
1803     return
1804   }
1805   var fourth-ah/eax: (addr handle cell) <- get rest, left
1806   var fourth/eax: (addr cell) <- lookup *fourth-ah
1807   var fourth-type/ecx: (addr int) <- get fourth, type
1808   compare *fourth-type, 1/number
1809   {
1810     break-if-=
1811     error trace, "fourth arg for 'pixel' is not an int (color; 0..0xff)"
1812     return
1813   }
1814   var fourth-value/eax: (addr float) <- get fourth, number-data
1815   var color/eax: int <- convert *fourth-value
1816   pixel screen, x, y, color
1817   # return nothing
1818 }
1819 
1820 fn apply-wait-for-key _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1821   trace-text trace, "eval", "apply 'key'"
1822   var args-ah/eax: (addr handle cell) <- copy _args-ah
1823   var _args/eax: (addr cell) <- lookup *args-ah
1824   var args/esi: (addr cell) <- copy _args
1825   {
1826     var args-type/ecx: (addr int) <- get args, type
1827     compare *args-type, 0/pair
1828     break-if-=
1829     error trace, "args to 'key' are not a list"
1830     return
1831   }
1832   var empty-args?/eax: boolean <- nil? args
1833   compare empty-args?, 0/false
1834   {
1835     break-if-=
1836     error trace, "'key' needs 1 arg but got 0"
1837     return
1838   }
1839   # keyboard = args->left
1840   var first-ah/eax: (addr handle cell) <- get args, left
1841   var first/eax: (addr cell) <- lookup *first-ah
1842   var first-type/ecx: (addr int) <- get first, type
1843   compare *first-type, 6/keyboard
1844   {
1845     break-if-=
1846     error trace, "first arg for 'key' is not a keyboard"
1847     return
1848   }
1849   var keyboard-ah/eax: (addr handle gap-buffer) <- get first, keyboard-data
1850   var _keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
1851   var keyboard/ecx: (addr gap-buffer) <- copy _keyboard
1852   var result/eax: int <- wait-for-key keyboard
1853   # return key typed
1854   new-integer out, result
1855 }
1856 
1857 fn wait-for-key keyboard: (addr gap-buffer) -> _/eax: int {
1858   # if keyboard is 0, use real keyboard
1859   {
1860     compare keyboard, 0/real-keyboard
1861     break-if-!=
1862     var key/eax: byte <- read-key 0/real-keyboard
1863     var result/eax: int <- copy key
1864     return result
1865   }
1866   # otherwise read from fake keyboard
1867   var g/eax: grapheme <- read-from-gap-buffer keyboard
1868   var result/eax: int <- copy g
1869   return result
1870 }
1871 
1872 fn apply-stream _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1873   trace-text trace, "eval", "apply stream"
1874   allocate-stream out
1875 }
1876 
1877 fn apply-write _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1878   trace-text trace, "eval", "apply 'write'"
1879   var args-ah/eax: (addr handle cell) <- copy _args-ah
1880   var _args/eax: (addr cell) <- lookup *args-ah
1881   var args/esi: (addr cell) <- copy _args
1882   {
1883     var args-type/ecx: (addr int) <- get args, type
1884     compare *args-type, 0/pair
1885     break-if-=
1886     error trace, "args to 'write' are not a list"
1887     return
1888   }
1889   var empty-args?/eax: boolean <- nil? args
1890   compare empty-args?, 0/false
1891   {
1892     break-if-=
1893     error trace, "'write' needs 2 args but got 0"
1894     return
1895   }
1896   # stream = args->left
1897   var first-ah/edx: (addr handle cell) <- get args, left
1898   var first/eax: (addr cell) <- lookup *first-ah
1899   var first-type/ecx: (addr int) <- get first, type
1900   compare *first-type, 3/stream
1901   {
1902     break-if-=
1903     error trace, "first arg for 'write' is not a stream"
1904     return
1905   }
1906   var stream-data-ah/eax: (addr handle stream byte) <- get first, text-data
1907   var _stream-data/eax: (addr stream byte) <- lookup *stream-data-ah
1908   var stream-data/ebx: (addr stream byte) <- copy _stream-data
1909   # args->right->left
1910   var right-ah/eax: (addr handle cell) <- get args, right
1911   var right/eax: (addr cell) <- lookup *right-ah
1912   {
1913     var right-type/ecx: (addr int) <- get right, type
1914     compare *right-type, 0/pair
1915     break-if-=
1916     error trace, "'write' encountered non-pair"
1917     return
1918   }
1919   {
1920     var nil?/eax: boolean <- nil? right
1921     compare nil?, 0/false
1922     break-if-=
1923     error trace, "'write' needs 2 args but got 1"
1924     return
1925   }
1926   var second-ah/eax: (addr handle cell) <- get right, left
1927   var second/eax: (addr cell) <- lookup *second-ah
1928   var second-type/ecx: (addr int) <- get second, type
1929   compare *second-type, 1/number
1930   {
1931     break-if-=
1932     error trace, "second arg for 'write' is not a number/grapheme"
1933     return
1934   }
1935   var second-value/eax: (addr float) <- get second, number-data
1936   var x-float/xmm0: float <- copy *second-value
1937   var x/eax: int <- convert x-float
1938   var x-grapheme/eax: grapheme <- copy x
1939   write-grapheme stream-data, x-grapheme
1940   # return the stream
1941   copy-object first-ah, out
1942 }
1943 
1944 fn apply-lines _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1945   trace-text trace, "eval", "apply 'lines'"
1946   var args-ah/eax: (addr handle cell) <- copy _args-ah
1947   var _args/eax: (addr cell) <- lookup *args-ah
1948   var args/esi: (addr cell) <- copy _args
1949   {
1950     var args-type/ecx: (addr int) <- get args, type
1951     compare *args-type, 0/pair
1952     break-if-=
1953     error trace, "args to 'lines' are not a list"
1954     return
1955   }
1956   var empty-args?/eax: boolean <- nil? args
1957   compare empty-args?, 0/false
1958   {
1959     break-if-=
1960     error trace, "'lines' needs 1 arg but got 0"
1961     return
1962   }
1963   # screen = args->left
1964   var first-ah/eax: (addr handle cell) <- get args, left
1965   var first/eax: (addr cell) <- lookup *first-ah
1966   var first-type/ecx: (addr int) <- get first, type
1967   compare *first-type, 5/screen
1968   {
1969     break-if-=
1970     error trace, "first arg for 'lines' is not a screen"
1971     return
1972   }
1973   var screen-ah/eax: (addr handle screen) <- get first, screen-data
1974   var _screen/eax: (addr screen) <- lookup *screen-ah
1975   var screen/edx: (addr screen) <- copy _screen
1976   # compute dimensions
1977   var dummy/eax: int <- copy 0
1978   var height/ecx: int <- copy 0
1979   dummy, height <- screen-size screen
1980   var result/xmm0: float <- convert height
1981   new-float out, result
1982 }
1983 
1984 fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1985   abort "aa"
1986 }
1987 
1988 fn apply-columns _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
1989   trace-text trace, "eval", "apply 'columns'"
1990   var args-ah/eax: (addr handle cell) <- copy _args-ah
1991   var _args/eax: (addr cell) <- lookup *args-ah
1992   var args/esi: (addr cell) <- copy _args
1993   {
1994     var args-type/ecx: (addr int) <- get args, type
1995     compare *args-type, 0/pair
1996     break-if-=
1997     error trace, "args to 'columns' are not a list"
1998     return
1999   }
2000   var empty-args?/eax: boolean <- nil? args
2001   compare empty-args?, 0/false
2002   {
2003     break-if-=
2004     error trace, "'columns' needs 1 arg but got 0"
2005     return
2006   }
2007   # screen = args->left
2008   var first-ah/eax: (addr handle cell) <- get args, left
2009   var first/eax: (addr cell) <- lookup *first-ah
2010   var first-type/ecx: (addr int) <- get first, type
2011   compare *first-type, 5/screen
2012   {
2013     break-if-=
2014     error trace, "first arg for 'columns' is not a screen"
2015     return
2016   }
2017   var screen-ah/eax: (addr handle screen) <- get first, screen-data
2018   var _screen/eax: (addr screen) <- lookup *screen-ah
2019   var screen/edx: (addr screen) <- copy _screen
2020   # compute dimensions
2021   var width/eax: int <- copy 0
2022   var dummy/ecx: int <- copy 0
2023   width, dummy <- screen-size screen
2024   var result/xmm0: float <- convert width
2025   new-float out, result
2026 }
2027 
2028 fn apply-width _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
2029   trace-text trace, "eval", "apply 'width'"
2030   var args-ah/eax: (addr handle cell) <- copy _args-ah
2031   var _args/eax: (addr cell) <- lookup *args-ah
2032   var args/esi: (addr cell) <- copy _args
2033   {
2034     var args-type/ecx: (addr int) <- get args, type
2035     compare *args-type, 0/pair
2036     break-if-=
2037     error trace, "args to 'width' are not a list"
2038     return
2039   }
2040   var empty-args?/eax: boolean <- nil? args
2041   compare empty-args?, 0/false
2042   {
2043     break-if-=
2044     error trace, "'width' needs 1 arg but got 0"
2045     return
2046   }
2047   # screen = args->left
2048   var first-ah/eax: (addr handle cell) <- get args, left
2049   var first/eax: (addr cell) <- lookup *first-ah
2050   var first-type/ecx: (addr int) <- get first, type
2051   compare *first-type, 5/screen
2052   {
2053     break-if-=
2054     error trace, "first arg for 'width' is not a screen"
2055     return
2056   }
2057   var screen-ah/eax: (addr handle screen) <- get first, screen-data
2058   var _screen/eax: (addr screen) <- lookup *screen-ah
2059   var screen/edx: (addr screen) <- copy _screen
2060   # compute dimensions
2061   var width/eax: int <- copy 0
2062   var dummy/ecx: int <- copy 0
2063   width, dummy <- screen-size screen
2064   width <- shift-left 3/log2-font-width
2065   var result/xmm0: float <- convert width
2066   new-float out, result
2067 }
2068 
2069 fn apply-height _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) {
2070   trace-text trace, "eval", "apply 'height'"
2071   var args-ah/eax: (addr handle cell) <- copy _args-ah
2072   var _args/eax: (addr cell) <- lookup *args-ah
2073   var args/esi: (addr cell) <- copy _args
2074   {
2075     var args-type/ecx: (addr int) <- get args, type
2076     compare *args-type, 0/pair
2077     break-if-=
2078     error trace, "args to 'height' are not a list"
2079     return
2080   }
2081   var empty-args?/eax: boolean <- nil? args
2082   compare empty-args?, 0/false
2083   {
2084     break-if-=
2085     error trace, "'height' needs 1 arg but got 0"
2086     return
2087   }
2088   # screen = args->left
2089   var first-ah/eax: (addr handle cell) <- get args, left
2090   var first/eax: (addr cell) <- lookup *first-ah
2091   var first-type/ecx: (addr int) <- get first, type
2092   compare *first-type, 5/screen
2093   {
2094     break-if-=
2095     error trace, "first arg for 'height' is not a screen"
2096     return
2097   }
2098   var screen-ah/eax: (addr handle screen) <- get first, screen-data
2099   var _screen/eax: (addr screen) <- lookup *screen-ah
2100   var screen/edx: (addr screen) <- copy _screen
2101   # compute dimensions
2102   var dummy/eax: int <- copy 0
2103   var height/ecx: int <- copy 0
2104   dummy, height <- screen-size screen
2105   height <- shift-left 4/log2-font-height
2106   var result/xmm0: float <- convert height
2107   new-float out, result
2108 }