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