# Mu - shell/sandbox.mu

https://github.com/akkartik/mu/blob/main/shell/sandbox.mu

      1 type sandbox {
      2   data: (handle gap-buffer)
      3   value: (handle stream byte)
      4   screen-var: (handle cell)
      5   keyboard-var: (handle cell)
      6   trace: (handle trace)
      7   cursor-in-data?: boolean
      8   cursor-in-keyboard?: boolean
      9   cursor-in-trace?: boolean
     10 }
     11
     12 fn initialize-sandbox _self: (addr sandbox), fake-screen-and-keyboard?: boolean {
     13   var self/esi: (addr sandbox) <- copy _self
     14   var data-ah/eax: (addr handle gap-buffer) <- get self, data
     15   allocate data-ah
     16   var data/eax: (addr gap-buffer) <- lookup *data-ah
     17   initialize-gap-buffer data, 0x1000/4KB
     18   #
     19   var value-ah/eax: (addr handle stream byte) <- get self, value
     20   populate-stream value-ah, 0x1000/4KB
     21   #
     22   {
     23     compare fake-screen-and-keyboard?, 0/false
     24     break-if-=
     25     var screen-ah/eax: (addr handle cell) <- get self, screen-var
     26     new-fake-screen screen-ah, 8/width, 3/height, 1/enable-pixel-graphics
     27     var keyboard-ah/eax: (addr handle cell) <- get self, keyboard-var
     28     new-fake-keyboard keyboard-ah, 0x10/keyboard-capacity
     29   }
     30   #
     31   var trace-ah/eax: (addr handle trace) <- get self, trace
     32   allocate trace-ah
     33   var trace/eax: (addr trace) <- lookup *trace-ah
     34   initialize-trace trace, 0x8000/lines, 0x80/visible-lines
     35   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
     36   copy-to *cursor-in-data?, 1/true
     37 }
     38
     39 ## some helpers for tests
     40
     41 fn initialize-sandbox-with _self: (addr sandbox), s: (addr array byte) {
     42   var self/esi: (addr sandbox) <- copy _self
     43   var data-ah/eax: (addr handle gap-buffer) <- get self, data
     44   allocate data-ah
     45   var data/eax: (addr gap-buffer) <- lookup *data-ah
     46   initialize-gap-buffer-with data, s
     47   var value-ah/eax: (addr handle stream byte) <- get self, value
     48   populate-stream value-ah, 0x1000/4KB
     49   var trace-ah/eax: (addr handle trace) <- get self, trace
     50   allocate trace-ah
     51   var trace/eax: (addr trace) <- lookup *trace-ah
     52   initialize-trace trace, 0x8000/lines, 0x80/visible-lines
     53   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
     54   copy-to *cursor-in-data?, 1/true
     55 }
     56
     57 fn allocate-sandbox-with _out: (addr handle sandbox), s: (addr array byte) {
     58   var out/eax: (addr handle sandbox) <- copy _out
     59   allocate out
     60   var out-addr/eax: (addr sandbox) <- lookup *out
     61   initialize-sandbox-with out-addr, s
     62 }
     63
     64 fn write-sandbox out: (addr stream byte), _self: (addr sandbox) {
     65   var self/eax: (addr sandbox) <- copy _self
     66   var data-ah/eax: (addr handle gap-buffer) <- get self, data
     67   var data/eax: (addr gap-buffer) <- lookup *data-ah
     68   {
     69     var len/eax: int <- gap-buffer-length data
     70     compare len, 0
     71     break-if-!=
     72     return
     73   }
     74   write out, "  (sandbox . "
     75   append-gap-buffer data, out
     76   write out, ")\n"
     77 }
     78
     79 ##
     80
     81 fn render-sandbox screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int {
     82   clear-rect screen, xmin, ymin, xmax, ymax, 0xc5/bg=blue-bg=black
     83   add-to xmin, 1/padding-left
     84   add-to ymin, 1/padding-top
     85   subtract-from xmax, 1/padding-right
     86   var self/esi: (addr sandbox) <- copy _self
     87   # data
     88   var data-ah/eax: (addr handle gap-buffer) <- get self, data
     89   var _data/eax: (addr gap-buffer) <- lookup *data-ah
     90   var data/edx: (addr gap-buffer) <- copy _data
     91   var x/eax: int <- copy xmin
     92   var y/ecx: int <- copy ymin
     93   y <- maybe-render-empty-screen screen, self, xmin, y
     94   y <- maybe-render-keyboard screen, self, xmin, y
     95   var cursor-in-sandbox?/ebx: (addr boolean) <- get self, cursor-in-data?
     96   x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, *cursor-in-sandbox?, 7/fg, 0xc5/bg=blue-bg
     97   y <- increment
     98   # trace
     99   var trace-ah/eax: (addr handle trace) <- get self, trace
    100   var _trace/eax: (addr trace) <- lookup *trace-ah
    101   var trace/edx: (addr trace) <- copy _trace
    102   var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
    103   y <- render-trace screen, trace, xmin, y, xmax, ymax, *cursor-in-trace?
    104   # value
    105   $render-sandbox:value: {
    106     var value-ah/eax: (addr handle stream byte) <- get self, value
    107     var _value/eax: (addr stream byte) <- lookup *value-ah
    108     var value/esi: (addr stream byte) <- copy _value
    109     rewind-stream value
    110     var done?/eax: boolean <- stream-empty? value
    111     compare done?, 0/false
    112     break-if-!=
    113     var x/eax: int <- copy 0
    114     x, y <- draw-text-wrapping-right-then-down screen, "=> ", xmin, y, xmax, ymax, xmin, y, 7/fg, 0xc5/bg=blue-bg
    115     var x2/edx: int <- copy x
    116     var dummy/eax: int <- draw-stream-rightward screen, value, x2, xmax, y, 7/fg=grey, 0xc5/bg=blue-bg
    117   }
    118   y <- add 2  # padding
    119   y <- maybe-render-screen screen, self, xmin, y
    120   # render menu
    121   var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
    122   compare *cursor-in-data?, 0/false
    123   {
    124     break-if-=
    125     render-sandbox-menu screen, self
    126     return
    127   }
    128   var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
    129   compare *cursor-in-trace?, 0/false
    130   {
    131     break-if-=
    132     render-trace-menu screen
    133     return
    134   }
    135   var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
    136   compare *cursor-in-keyboard?, 0/false
    137   {
    138     break-if-=
    139     render-keyboard-menu screen
    140     return
    141   }
    142 }
    143
    144 fn clear-sandbox-output screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int, xmax: int, ymax: int {
    145   # render just enough of the sandbox to figure out what to erase
    146   var self/esi: (addr sandbox) <- copy _self
    147   var data-ah/eax: (addr handle gap-buffer) <- get self, data
    148   var _data/eax: (addr gap-buffer) <- lookup *data-ah
    149   var data/edx: (addr gap-buffer) <- copy _data
    150   var x/eax: int <- copy xmin
    151   var y/ecx: int <- copy ymin
    152   y <- maybe-render-empty-screen screen, self, xmin, y
    153   y <- maybe-render-keyboard screen, self, xmin, y
    154   var cursor-in-sandbox?/ebx: (addr boolean) <- get self, cursor-in-data?
    155   x, y <- render-gap-buffer-wrapping-right-then-down screen, data, x, y, xmax, ymax, *cursor-in-sandbox?, 3/fg, 0xc5/bg=blue-bg
    156   y <- increment
    157   clear-rect screen, xmin, y, xmax, ymax, 0xc5/bg=blue-bg=black
    158 }
    159
    160 fn maybe-render-empty-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
    161   var self/esi: (addr sandbox) <- copy _self
    162   var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
    163   var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
    164   compare screen-obj-cell, 0
    165   {
    166     break-if-!=
    167     return ymin
    168   }
    169   var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
    170   compare *screen-obj-cell-type, 5/screen
    171   {
    172     break-if-=
    173     return ymin  # silently give up on rendering the screen
    174   }
    175   var y/ecx: int <- copy ymin
    176   var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
    177   var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
    178   var screen-obj/edx: (addr screen) <- copy _screen-obj
    179   var x/eax: int <- draw-text-rightward screen, "screen:   ", xmin, 0x99/xmax, y, 7/fg, 0xc5/bg=blue-bg
    180   y <- render-empty-screen screen, screen-obj, x, y
    181   return y
    182 }
    183
    184 fn maybe-render-screen screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
    185   var self/esi: (addr sandbox) <- copy _self
    186   var screen-obj-cell-ah/eax: (addr handle cell) <- get self, screen-var
    187   var screen-obj-cell/eax: (addr cell) <- lookup *screen-obj-cell-ah
    188   compare screen-obj-cell, 0
    189   {
    190     break-if-!=
    191     return ymin
    192   }
    193   var screen-obj-cell-type/ecx: (addr int) <- get screen-obj-cell, type
    194   compare *screen-obj-cell-type, 5/screen
    195   {
    196     break-if-=
    197     return ymin  # silently give up on rendering the screen
    198   }
    199   var screen-obj-ah/eax: (addr handle screen) <- get screen-obj-cell, screen-data
    200   var _screen-obj/eax: (addr screen) <- lookup *screen-obj-ah
    201   var screen-obj/edx: (addr screen) <- copy _screen-obj
    202   {
    203     var screen-empty?/eax: boolean <- fake-screen-empty? screen-obj
    204     compare screen-empty?, 0/false
    205     break-if-=
    206     return ymin
    207   }
    208   var x/eax: int <- draw-text-rightward screen, "screen:   ", xmin, 0x99/xmax, ymin, 7/fg, 0xc5/bg=blue-bg
    209   var y/ecx: int <- copy ymin
    210   y <- render-screen screen, screen-obj, x, y
    211   return y
    212 }
    213
    214 fn render-empty-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
    215   var target-screen/esi: (addr screen) <- copy _target-screen
    216   var screen-y/edi: int <- copy ymin
    217   # screen
    218   var height/edx: (addr int) <- get target-screen, height
    219   var y/ecx: int <- copy 0
    220   {
    221     compare y, *height
    222     break-if->=
    223     set-cursor-position screen, xmin, screen-y
    224     var width/edx: (addr int) <- get target-screen, width
    225     var x/ebx: int <- copy 0
    226     {
    227       compare x, *width
    228       break-if->=
    229       draw-code-point-at-cursor screen, 0x20/space, 0x18/fg, 0/bg
    230       move-cursor-right screen
    231       x <- increment
    232       loop
    233     }
    234     y <- increment
    235     screen-y <- increment
    236     loop
    237   }
    238   return screen-y
    239 }
    240
    241 fn render-screen screen: (addr screen), _target-screen: (addr screen), xmin: int, ymin: int -> _/ecx: int {
    242   var target-screen/esi: (addr screen) <- copy _target-screen
    243   var screen-y/edi: int <- copy ymin
    244   # text data
    245   {
    246     var height/edx: (addr int) <- get target-screen, height
    247     var y/ecx: int <- copy 0
    248     {
    249       compare y, *height
    250       break-if->=
    251       set-cursor-position screen, xmin, screen-y
    252       var width/edx: (addr int) <- get target-screen, width
    253       var x/ebx: int <- copy 0
    254       {
    255         compare x, *width
    256         break-if->=
    257         print-screen-cell-of-fake-screen screen, target-screen, x, y
    258         move-cursor-right screen
    259         x <- increment
    260         loop
    261       }
    262       y <- increment
    263       screen-y <- increment
    264       loop
    265     }
    266   }
    267   # pixel data
    268   {
    269     # screen top left pixels x y width height
    270     var tmp/eax: int <- copy xmin
    271     tmp <- shift-left 3/log2-font-width
    272     var left: int
    273     copy-to left, tmp
    274     tmp <- copy ymin
    275     tmp <- shift-left 4/log2-font-height
    276     var top: int
    277     copy-to top, tmp
    278     var pixels-ah/eax: (addr handle array byte) <- get target-screen, pixels
    279     var _pixels/eax: (addr array byte) <- lookup *pixels-ah
    280     var pixels/edi: (addr array byte) <- copy _pixels
    281     compare pixels, 0
    282     break-if-=
    283     var y/ebx: int <- copy 0
    284     var height-addr/edx: (addr int) <- get target-screen, height
    285     var height/edx: int <- copy *height-addr
    286     height <- shift-left 4/log2-font-height
    287     {
    288       compare y, height
    289       break-if->=
    290       var width-addr/edx: (addr int) <- get target-screen, width
    291       var width/edx: int <- copy *width-addr
    292       width <- shift-left 3/log2-font-width
    293       var x/eax: int <- copy 0
    294       {
    295         compare x, width
    296         break-if->=
    297         {
    298           var idx/ecx: int <- pixel-index target-screen, x, y
    299           var color-addr/ecx: (addr byte) <- index pixels, idx
    300           var color/ecx: byte <- copy-byte *color-addr
    301           var color2/ecx: int <- copy color
    302           compare color2, 0
    303           break-if-=
    304           var x2/eax: int <- copy x
    305           x2 <- add left
    306           var y2/ebx: int <- copy y
    307           y2 <- add top
    308           pixel screen, x2, y2, color2
    309         }
    310         x <- increment
    311         loop
    312       }
    313       y <- increment
    314       loop
    315     }
    316   }
    317   return screen-y
    318 }
    319
    320 fn has-keyboard? _self: (addr sandbox) -> _/eax: boolean {
    321   var self/esi: (addr sandbox) <- copy _self
    322   var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
    323   var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
    324   compare keyboard-obj-cell, 0
    325   {
    326     break-if-!=
    327     return 0/false
    328   }
    329   var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
    330   compare *keyboard-obj-cell-type, 6/keyboard
    331   {
    332     break-if-=
    333     return 0/false
    334   }
    335   var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
    336   var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
    337   var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
    338   compare keyboard-obj, 0
    339   {
    340     break-if-!=
    341     return 0/false
    342   }
    343   return 1/true
    344 }
    345
    346 fn maybe-render-keyboard screen: (addr screen), _self: (addr sandbox), xmin: int, ymin: int -> _/ecx: int {
    347   var self/esi: (addr sandbox) <- copy _self
    348   var keyboard-obj-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
    349   var keyboard-obj-cell/eax: (addr cell) <- lookup *keyboard-obj-cell-ah
    350   compare keyboard-obj-cell, 0
    351   {
    352     break-if-!=
    353     return ymin
    354   }
    355   var keyboard-obj-cell-type/ecx: (addr int) <- get keyboard-obj-cell, type
    356   compare *keyboard-obj-cell-type, 6/keyboard
    357   {
    358     break-if-=
    359     return ymin  # silently give up on rendering the keyboard
    360   }
    361   var keyboard-obj-ah/eax: (addr handle gap-buffer) <- get keyboard-obj-cell, keyboard-data
    362   var _keyboard-obj/eax: (addr gap-buffer) <- lookup *keyboard-obj-ah
    363   var keyboard-obj/edx: (addr gap-buffer) <- copy _keyboard-obj
    364   var y/ecx: int <- copy ymin
    365   y <- increment  # padding
    366   var x/eax: int <- draw-text-rightward screen, "keyboard: ", xmin, 0x99/xmax, y, 7/fg, 0xc5/bg=blue-bg
    367   var cursor-in-keyboard?/esi: (addr boolean) <- get self, cursor-in-keyboard?
    368   y <- render-keyboard screen, keyboard-obj, x, y, *cursor-in-keyboard?
    369   y <- increment  # padding
    370   return y
    371 }
    372
    373 fn render-keyboard screen: (addr screen), _keyboard: (addr gap-buffer), xmin: int, ymin: int, render-cursor?: boolean -> _/ecx: int {
    374   var keyboard/esi: (addr gap-buffer) <- copy _keyboard
    375   var width/edx: int <- copy 0x10/keyboard-capacity
    376   var y/edi: int <- copy ymin
    377   # keyboard
    378   var x/eax: int <- copy xmin
    379   var xmax/ecx: int <- copy x
    380   xmax <- add 0x10
    381   var ymax/edx: int <- copy ymin
    382   ymax <- add 1
    383   clear-rect screen, x, y, xmax, ymax, 0/bg
    384   x <- render-gap-buffer screen, keyboard, x, y, render-cursor?, 3/fg, 0/bg
    385   y <- increment
    386   return y
    387 }
    388
    389 fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), x: int, y: int {
    390   var target/ecx: (addr screen) <- copy _target
    391   var data-ah/eax: (addr handle array screen-cell) <- get target, data
    392   var data/eax: (addr array screen-cell) <- lookup *data-ah
    393   var index/ecx: int <- screen-cell-index target, x, y
    394   var offset/ecx: (offset screen-cell) <- compute-offset data, index
    395   var src-cell/esi: (addr screen-cell) <- index data, offset
    396   var src-grapheme/eax: (addr grapheme) <- get src-cell, data
    397   var src-color/ecx: (addr int) <- get src-cell, color
    398   var src-background-color/edx: (addr int) <- get src-cell, background-color
    399   draw-grapheme-at-cursor screen, *src-grapheme, *src-color, *src-background-color
    400 }
    401
    402 fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) {
    403   var _width/eax: int <- copy 0
    404   var height/ecx: int <- copy 0
    405   _width, height <- screen-size screen
    406   var width/edx: int <- copy _width
    407   var y/ecx: int <- copy height
    408   y <- decrement
    409   var height/ebx: int <- copy y
    410   height <- increment
    411   clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg=black
    412   set-cursor-position screen, 0/x, y
    413   draw-text-rightward-from-cursor screen, " ctrl+... ", width, 0xf/fg, 0xc5/bg=blue-bg
    414   draw-text-rightward-from-cursor screen, " r ", width, 0/fg, 0x5c/bg=black
    415   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
    416   draw-text-rightward-from-cursor screen, " s ", width, 0/fg, 0x5c/bg=black
    417   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
    418   $render-sandbox-menu:render-ctrl-m: {
    419     var self/eax: (addr sandbox) <- copy _self
    420     var has-trace?/eax: boolean <- has-trace? self
    421     compare has-trace?, 0/false
    422     {
    423       break-if-=
    424       draw-text-rightward-from-cursor screen, " m ", width, 0/fg, 0x38/bg=trace
    425       draw-text-rightward-from-cursor screen, " to trace  ", width, 7/fg, 0xc5/bg=blue-bg
    426       break $render-sandbox-menu:render-ctrl-m
    427     }
    428     draw-text-rightward-from-cursor screen, " m ", width, 0/fg, 3/bg=keyboard
    429     draw-text-rightward-from-cursor screen, " to keyboard  ", width, 7/fg, 0xc5/bg=blue-bg
    430   }
    431   draw-text-rightward-from-cursor screen, " a ", width, 0/fg, 0x5c/bg=black
    432   draw-text-rightward-from-cursor screen, " <<  ", width, 7/fg, 0xc5/bg=blue-bg
    433   draw-text-rightward-from-cursor screen, " b ", width, 0/fg, 0x5c/bg=black
    434   draw-text-rightward-from-cursor screen, " <word  ", width, 7/fg, 0xc5/bg=blue-bg
    435   draw-text-rightward-from-cursor screen, " f ", width, 0/fg, 0x5c/bg=black
    436   draw-text-rightward-from-cursor screen, " word>  ", width, 7/fg, 0xc5/bg=blue-bg
    437   draw-text-rightward-from-cursor screen, " e ", width, 0/fg, 0x5c/bg=black
    438   draw-text-rightward-from-cursor screen, " >>  ", width, 7/fg, 0xc5/bg=blue-bg
    439 }
    440
    441 fn render-keyboard-menu screen: (addr screen) {
    442   var width/eax: int <- copy 0
    443   var height/ecx: int <- copy 0
    444   width, height <- screen-size screen
    445   var y/ecx: int <- copy height
    446   y <- decrement
    447   var height/edx: int <- copy y
    448   height <- increment
    449   clear-rect screen, 0/x, y, width, height, 0xc5/bg=blue-bg=black
    450   set-cursor-position screen, 0/x, y
    451   draw-text-rightward-from-cursor screen, " ctrl+... ", width, 0xf/fg, 0xc5/bg=blue-bg
    452   draw-text-rightward-from-cursor screen, " r ", width, 0/fg, 0x5c/bg=black
    453   draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0xc5/bg=blue-bg
    454   draw-text-rightward-from-cursor screen, " s ", width, 0/fg, 0x5c/bg=black
    455   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
    456   draw-text-rightward-from-cursor screen, " m ", width, 0/fg, 7/bg
    457   draw-text-rightward-from-cursor screen, " to sandbox  ", width, 7/fg, 0xc5/bg=blue-bg
    458 }
    459
    460 fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table), data-disk: (addr disk), real-screen: (addr screen), tweak-real-screen?: boolean {
    461   var self/esi: (addr sandbox) <- copy _self
    462   var g/edx: grapheme <- copy key
    463   # ctrl-s
    464   {
    465     compare g, 0x13/ctrl-s
    466     break-if-!=
    467     # minor gotcha here: any bindings created later in this iteration won't be
    468     # persisted until the next call to ctrl-s.
    469     store-state data-disk, self, globals
    470     # run sandbox
    471     var data-ah/ecx: (addr handle gap-buffer) <- get self, data
    472     var value-ah/eax: (addr handle stream byte) <- get self, value
    473     var _value/eax: (addr stream byte) <- lookup *value-ah
    474     var value/edx: (addr stream byte) <- copy _value
    475     var trace-ah/eax: (addr handle trace) <- get self, trace
    476     var _trace/eax: (addr trace) <- lookup *trace-ah
    477     var trace/ebx: (addr trace) <- copy _trace
    478     clear-trace trace
    479     {
    480       compare tweak-real-screen?, 0/false
    481       break-if-=
    482       clear-sandbox-output real-screen, self, 0x56/sandbox-left-margin, 1/y, 0x80/screen-width, 0x2f/screen-height-without-menu
    483     }
    484     var screen-cell/eax: (addr handle cell) <- get self, screen-var
    485     clear-screen-cell screen-cell
    486     var keyboard-cell/esi: (addr handle cell) <- get self, keyboard-var
    487     rewind-keyboard-cell keyboard-cell  # don't clear keys from before
    488     {
    489       compare tweak-real-screen?, 0/false
    490       break-if-=
    491       set-cursor-position real-screen, 0/x, 0/y  # for any debug prints during evaluation
    492     }
    493     run data-ah, value, globals, trace, screen-cell, keyboard-cell
    494     return
    495   }
    496   # ctrl-m
    497   {
    498     compare g, 0xd/ctrl-m
    499     break-if-!=
    500     # if cursor in data, switch to trace or fall through to keyboard
    501     {
    502       var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
    503       compare *cursor-in-data?, 0/false
    504       break-if-=
    505       var has-trace?/eax: boolean <- has-trace? self
    506       compare has-trace?, 0/false
    507       {
    508         break-if-=
    509         var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
    510         copy-to *cursor-in-data?, 0/false
    511         var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
    512         copy-to *cursor-in-trace?, 1/false
    513         return
    514       }
    515       var has-keyboard?/eax: boolean <- has-keyboard? self
    516       compare has-keyboard?, 0/false
    517       {
    518         break-if-=
    519         var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
    520         copy-to *cursor-in-data?, 0/false
    521         var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
    522         copy-to *cursor-in-keyboard?, 1/false
    523         return
    524       }
    525       return
    526     }
    527     # if cursor in trace, switch to keyboard or fall through to data
    528     {
    529       var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
    530       compare *cursor-in-trace?, 0/false
    531       break-if-=
    532       copy-to *cursor-in-trace?, 0/false
    533       var cursor-target/ecx: (addr boolean) <- get self, cursor-in-keyboard?
    534       var has-keyboard?/eax: boolean <- has-keyboard? self
    535       compare has-keyboard?, 0/false
    536       {
    537         break-if-!=
    538         cursor-target <- get self, cursor-in-data?
    539       }
    540       copy-to *cursor-target, 1/true
    541       return
    542     }
    543     # otherwise if cursor in keyboard, switch to data
    544     {
    545       var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
    546       compare *cursor-in-keyboard?, 0/false
    547       break-if-=
    548       copy-to *cursor-in-keyboard?, 0/false
    549       var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
    550       copy-to *cursor-in-data?, 1/true
    551       return
    552     }
    553     return
    554   }
    555   # if cursor in data, send key to data
    556   {
    557     var cursor-in-data?/eax: (addr boolean) <- get self, cursor-in-data?
    558     compare *cursor-in-data?, 0/false
    559     break-if-=
    560     var data-ah/eax: (addr handle gap-buffer) <- get self, data
    561     var data/eax: (addr gap-buffer) <- lookup *data-ah
    562     edit-gap-buffer data, g
    563     return
    564   }
    565   # if cursor in keyboard, send key to keyboard
    566   {
    567     var cursor-in-keyboard?/eax: (addr boolean) <- get self, cursor-in-keyboard?
    568     compare *cursor-in-keyboard?, 0/false
    569     break-if-=
    570     var keyboard-cell-ah/eax: (addr handle cell) <- get self, keyboard-var
    571     var keyboard-cell/eax: (addr cell) <- lookup *keyboard-cell-ah
    572     compare keyboard-cell, 0
    573     {
    574       break-if-!=
    575       return
    576     }
    577     var keyboard-cell-type/ecx: (addr int) <- get keyboard-cell, type
    578     compare *keyboard-cell-type, 6/keyboard
    579     {
    580       break-if-=
    581       return
    582     }
    583     var keyboard-ah/eax: (addr handle gap-buffer) <- get keyboard-cell, keyboard-data
    584     var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
    585     edit-gap-buffer keyboard, g
    586     return
    587   }
    588   # if cursor in trace, send key to trace
    589   {
    590     var cursor-in-trace?/eax: (addr boolean) <- get self, cursor-in-trace?
    591     compare *cursor-in-trace?, 0/false
    592     break-if-=
    593     var trace-ah/eax: (addr handle trace) <- get self, trace
    594     var trace/eax: (addr trace) <- lookup *trace-ah
    595     edit-trace trace, g
    596     return
    597   }
    598 }
    599
    600 fn run _in-ah: (addr handle gap-buffer), out: (addr stream byte), globals: (addr global-table), trace: (addr trace), screen-cell: (addr handle cell), keyboard-cell: (addr handle cell) {
    601   var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
    602   var in/eax: (addr gap-buffer) <- lookup *in-ah
    603   var read-result-h: (handle cell)
    604   var read-result-ah/esi: (addr handle cell) <- address read-result-h
    605   read-cell in, read-result-ah, trace
    606   var error?/eax: boolean <- has-errors? trace
    607   {
    608     compare error?, 0/false
    609     break-if-=
    610     return
    611   }
    612   var nil-storage: (handle cell)
    613   var nil-ah/eax: (addr handle cell) <- address nil-storage
    614   allocate-pair nil-ah
    615   var eval-result-storage: (handle cell)
    616   var eval-result/edi: (addr handle cell) <- address eval-result-storage
    617   debug-print "^", 4/fg, 0xc5/bg=blue-bg
    618   evaluate read-result-ah, eval-result, *nil-ah, globals, trace, screen-cell, keyboard-cell, 1/call-number
    619   debug-print "$", 4/fg, 0xc5/bg=blue-bg
    620   var error?/eax: boolean <- has-errors? trace
    621   {
    622     compare error?, 0/false
    623     break-if-=
    624     return
    625   }
    626   # if there was no error and the read-result starts with "set" or "def", save
    627   # the gap buffer in the modified global, then create a new one for the next
    628   # command.
    629   maybe-stash-gap-buffer-to-global globals, read-result-ah, _in-ah
    630   clear-stream out
    631   print-cell eval-result, out, trace
    632   mark-lines-dirty trace
    633 }
    634
    635 fn read-evaluate-and-move-to-globals _in-ah: (addr handle gap-buffer), globals: (addr global-table) {
    636   var in-ah/eax: (addr handle gap-buffer) <- copy _in-ah
    637   var in/eax: (addr gap-buffer) <- lookup *in-ah
    638   var read-result-h: (handle cell)
    639   var read-result-ah/esi: (addr handle cell) <- address read-result-h
    640   read-cell in, read-result-ah, 0/no-trace
    641   var nil-storage: (handle cell)
    642   var nil-ah/eax: (addr handle cell) <- address nil-storage
    643   allocate-pair nil-ah
    644   var eval-result-storage: (handle cell)
    645   var eval-result/edi: (addr handle cell) <- address eval-result-storage
    646   debug-print "^", 4/fg, 0xc5/bg=blue-bg
    647   evaluate read-result-ah, eval-result, *nil-ah, globals, 0/no-trace, 0/no-screen-cell, 0/no-keyboard-cell, 1/call-number
    648   debug-print "$", 4/fg, 0xc5/bg=blue-bg
    649   move-gap-buffer-to-global globals, read-result-ah, _in-ah
    650 }
    651
    652 fn test-run-integer {
    653   var sandbox-storage: sandbox
    654   var sandbox/esi: (addr sandbox) <- address sandbox-storage
    655   initialize-sandbox-with sandbox, "1"
    656   # eval
    657   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    658   # setup: screen
    659   var screen-on-stack: screen
    660   var screen/edi: (addr screen) <- address screen-on-stack
    661   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
    662   #
    663   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    664   # skip one line of padding
    665   check-screen-row screen, 1/y, " 1    ", "F - test-run-integer/0"
    666   check-screen-row screen, 2/y, " ...  ", "F - test-run-integer/1"
    667   check-screen-row screen, 3/y, " => 1 ", "F - test-run-integer/2"
    668 }
    669
    670 fn test-run-error-invalid-integer {
    671   var sandbox-storage: sandbox
    672   var sandbox/esi: (addr sandbox) <- address sandbox-storage
    673   initialize-sandbox-with sandbox, "1a"
    674   # eval
    675   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    676   # setup: screen
    677   var screen-on-stack: screen
    678   var screen/edi: (addr screen) <- address screen-on-stack
    679   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
    680   #
    681   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    682   # skip one line of padding
    683   check-screen-row screen, 1/y, " 1a             ", "F - test-run-error-invalid-integer/0"
    684   check-screen-row screen, 2/y, " ...            ", "F - test-run-error-invalid-integer/0"
    685   check-screen-row screen, 3/y, " invalid number ", "F - test-run-error-invalid-integer/2"
    686 }
    687
    688 fn test-run-with-spaces {
    689   var sandbox-storage: sandbox
    690   var sandbox/esi: (addr sandbox) <- address sandbox-storage
    691   initialize-sandbox-with sandbox, " 1 \n"
    692   # eval
    693   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    694   # setup: screen
    695   var screen-on-stack: screen
    696   var screen/edi: (addr screen) <- address screen-on-stack
    697   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
    698   #
    699   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    700   # skip one line of padding
    701   check-screen-row screen, 1/y, "  1   ", "F - test-run-with-spaces/0"
    702   check-screen-row screen, 2/y, "      ", "F - test-run-with-spaces/1"
    703   check-screen-row screen, 3/y, " ...  ", "F - test-run-with-spaces/2"
    704   check-screen-row screen, 4/y, " => 1 ", "F - test-run-with-spaces/3"
    705 }
    706
    707 fn test-run-quote {
    708   var sandbox-storage: sandbox
    709   var sandbox/esi: (addr sandbox) <- address sandbox-storage
    710   initialize-sandbox-with sandbox, "'a"
    711   # eval
    712   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    713   # setup: screen
    714   var screen-on-stack: screen
    715   var screen/edi: (addr screen) <- address screen-on-stack
    716   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
    717   #
    718   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    719   # skip one line of padding
    720   check-screen-row screen, 1/y, " 'a   ", "F - test-run-quote/0"
    721   check-screen-row screen, 2/y, " ...  ", "F - test-run-quote/1"
    722   check-screen-row screen, 3/y, " => a ", "F - test-run-quote/2"
    723 }
    724
    725 fn test-run-dotted-list {
    726   var sandbox-storage: sandbox
    727   var sandbox/esi: (addr sandbox) <- address sandbox-storage
    728   initialize-sandbox-with sandbox, "'(a . b)"
    729   # eval
    730   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    731   # setup: screen
    732   var screen-on-stack: screen
    733   var screen/edi: (addr screen) <- address screen-on-stack
    734   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
    735   #
    736   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    737   # skip one line of padding
    738   check-screen-row screen, 1/y, " '(a . b)   ", "F - test-run-dotted-list/0"
    739   check-screen-row screen, 2/y, " ...        ", "F - test-run-dotted-list/1"
    740   check-screen-row screen, 3/y, " => (a . b) ", "F - test-run-dotted-list/2"
    741 }
    742
    743 fn test-run-dot-and-list {
    744   var sandbox-storage: sandbox
    745   var sandbox/esi: (addr sandbox) <- address sandbox-storage
    746   initialize-sandbox-with sandbox, "'(a . (b))"
    747   # eval
    748   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    749   # setup: screen
    750   var screen-on-stack: screen
    751   var screen/edi: (addr screen) <- address screen-on-stack
    752   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
    753   #
    754   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    755   # skip one line of padding
    756   check-screen-row screen, 1/y, " '(a . (b)) ", "F - test-run-dot-and-list/0"
    757   check-screen-row screen, 2/y, " ...        ", "F - test-run-dot-and-list/1"
    758   check-screen-row screen, 3/y, " => (a b)   ", "F - test-run-dot-and-list/2"
    759 }
    760
    761 fn test-run-final-dot {
    762   var sandbox-storage: sandbox
    763   var sandbox/esi: (addr sandbox) <- address sandbox-storage
    764   initialize-sandbox-with sandbox, "'(a .)"
    765   # eval
    766   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    767   # setup: screen
    768   var screen-on-stack: screen
    769   var screen/edi: (addr screen) <- address screen-on-stack
    770   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
    771   #
    772   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    773   # skip one line of padding
    774   check-screen-row screen, 1/y, " '(a .)               ", "F - test-run-final-dot/0"
    775   check-screen-row screen, 2/y, " ...                  ", "F - test-run-final-dot/1"
    776   check-screen-row screen, 3/y, " '. )' makes no sense ", "F - test-run-final-dot/2"
    777   # further errors may occur
    778 }
    779
    780 fn test-run-double-dot {
    781   var sandbox-storage: sandbox
    782   var sandbox/esi: (addr sandbox) <- address sandbox-storage
    783   initialize-sandbox-with sandbox, "'(a . .)"
    784   # eval
    785   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    786   # setup: screen
    787   var screen-on-stack: screen
    788   var screen/edi: (addr screen) <- address screen-on-stack
    789   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
    790   #
    791   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    792   # skip one line of padding
    793   check-screen-row screen, 1/y, " '(a . .)             ", "F - test-run-double-dot/0"
    794   check-screen-row screen, 2/y, " ...                  ", "F - test-run-double-dot/1"
    795   check-screen-row screen, 3/y, " '. .' makes no sense ", "F - test-run-double-dot/2"
    796   # further errors may occur
    797 }
    798
    799 fn test-run-multiple-expressions-after-dot {
    800   var sandbox-storage: sandbox
    801   var sandbox/esi: (addr sandbox) <- address sandbox-storage
    802   initialize-sandbox-with sandbox, "'(a . b c)"
    803   # eval
    804   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    805   # setup: screen
    806   var screen-on-stack: screen
    807   var screen/edi: (addr screen) <- address screen-on-stack
    808   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
    809   #
    810   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    811   # skip one line of padding
    812   check-screen-row screen, 1/y, " '(a . b c)                                           ", "F - test-run-multiple-expressions-after-dot/0"
    813   check-screen-row screen, 2/y, " ...                                                  ", "F - test-run-multiple-expressions-after-dot/1"
    814   check-screen-row screen, 3/y, " cannot have multiple expressions between '.' and ')' ", "F - test-run-multiple-expressions-after-dot/2"
    815   # further errors may occur
    816 }
    817
    818 fn test-run-stream {
    819   var sandbox-storage: sandbox
    820   var sandbox/esi: (addr sandbox) <- address sandbox-storage
    821   initialize-sandbox-with sandbox, "[a b]"
    822   # eval
    823   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    824   # setup: screen
    825   var screen-on-stack: screen
    826   var screen/edi: (addr screen) <- address screen-on-stack
    827   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
    828   #
    829   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    830   # skip one line of padding
    831   check-screen-row screen, 1/y, " [a b]    ", "F - test-run-stream/0"
    832   check-screen-row screen, 2/y, " ...      ", "F - test-run-stream/1"
    833   check-screen-row screen, 3/y, " => [a b] ", "F - test-run-stream/2"
    834 }
    835
    836 fn test-run-move-cursor-into-trace {
    837   var sandbox-storage: sandbox
    838   var sandbox/esi: (addr sandbox) <- address sandbox-storage
    839   initialize-sandbox-with sandbox, "12"
    840   # eval
    841   edit-sandbox sandbox, 0x13/ctrl-s, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    842   # setup: screen
    843   var screen-on-stack: screen
    844   var screen/edi: (addr screen) <- address screen-on-stack
    845   initialize-screen screen, 0x80/width, 0x10/height, 0/no-pixel-graphics
    846   #
    847   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    848   # skip one line of padding
    849   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-move-cursor-into-trace/pre-0"
    850   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "   |   ", "F - test-run-move-cursor-into-trace/pre-0/cursor"
    851   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/pre-1"
    852   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "       ", "F - test-run-move-cursor-into-trace/pre-1/cursor"
    853   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/pre-2"
    854   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/pre-2/cursor"
    855   # move cursor into trace
    856   edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    857   #
    858   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    859   # skip one line of padding
    860   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-move-cursor-into-trace/trace-0"
    861   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "       ", "F - test-run-move-cursor-into-trace/trace-0/cursor"
    862   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/trace-1"
    863   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, " |||   ", "F - test-run-move-cursor-into-trace/trace-1/cursor"
    864   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/trace-2"
    865   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/trace-2/cursor"
    866   # move cursor into input
    867   edit-sandbox sandbox, 0xd/ctrl-m, 0/no-globals, 0/no-disk, 0/no-screen, 0/no-tweak-screen
    868   #
    869   render-sandbox screen, sandbox, 0/x, 0/y, 0x80/width, 0x10/height
    870   # skip one line of padding
    871   check-screen-row screen,                                  1/y, " 12    ", "F - test-run-move-cursor-into-trace/input-0"
    872   check-background-color-in-screen-row screen, 7/bg=cursor, 1/y, "   |   ", "F - test-run-move-cursor-into-trace/input-0/cursor"
    873   check-screen-row screen,                                  2/y, " ...   ", "F - test-run-move-cursor-into-trace/input-1"
    874   check-background-color-in-screen-row screen, 7/bg=cursor, 2/y, "       ", "F - test-run-move-cursor-into-trace/input-1/cursor"
    875   check-screen-row screen,                                  3/y, " => 12 ", "F - test-run-move-cursor-into-trace/input-2"
    876   check-background-color-in-screen-row screen, 7/bg=cursor, 3/y, "       ", "F - test-run-move-cursor-into-trace/input-2/cursor"
    877 }
    878
    879 fn has-trace? _self: (addr sandbox) -> _/eax: boolean {
    880   var self/esi: (addr sandbox) <- copy _self
    881   var trace-ah/eax: (addr handle trace) <- get self, trace
    882   var _trace/eax: (addr trace) <- lookup *trace-ah
    883   var trace/edx: (addr trace) <- copy _trace
    884   compare trace, 0
    885   {
    886     break-if-!=
    887     return 0/false
    888   }
    889   var first-free/ebx: (addr int) <- get trace, first-free
    890   compare *first-free, 0
    891   {
    892     break-if->
    893     return 0/false
    894   }
    895   return 1/true
    896 }