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