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