shell: ctrl-r runs on real screen without a trace

We run out of memory fairly early in the course of drawing a chessboard
on the whole screen.

9 files changed, 106 insertions, 26 deletions

diff --git a/boot.subx b/boot.subx
index b2ac17b6..0ae95d8b 100644
--- a/boot.subx
+++ b/boot.subx
@@ -107,6 +107,20 @@
   cd/syscall 0x13/imm8/bios-disk-services
   0f 82/jump-if-carry disk_error/disp16
 
+  # load two more tracks of disk into addresses [0x37000, 0x46c00)
+  b4/copy-to-ah 2/imm8/read-drive
+  # dl comes conveniently initialized at boot time with the index of the device being booted
+  b5/copy-to-ch 0/imm8/cylinder
+  b6/copy-to-dh 4/imm8/head
+  b1/copy-to-cl 1/imm8/sector  # 1-based
+  b0/copy-to-al 0x7e/imm8/num-sectors  # 2*63 = 126
+  # address to write sectors to = es:bx = 0x37000, contiguous with boot segment
+  bb/copy-to-bx 0x3700/imm16
+  8e/->seg 3/mod/direct 3/rm32/bx 0/r32/es
+  bb/copy-to-bx 0/imm16
+  cd/syscall 0x13/imm8/bios-disk-services
+  0f 82/jump-if-carry disk_error/disp16
+
   # reset es
   bb/copy-to-bx 0/imm16
   8e/->seg 3/mod/direct 3/rm32/bx 0/r32/es
diff --git a/shell/cell.mu b/shell/cell.mu
index eb95f2ee..8804c686 100644
--- a/shell/cell.mu
+++ b/shell/cell.mu
@@ -84,8 +84,7 @@ fn new-float out: (addr handle cell), n: float {
   initialize-float out, n
 }
 
-fn allocate-pair _out: (addr handle cell) {
-  var out/eax: (addr handle cell) <- copy _out
+fn allocate-pair out: (addr handle cell) {
   allocate out
   # new cells have type pair by default
 }
@@ -133,8 +132,6 @@ fn allocate-screen _out: (addr handle cell) {
   var out/eax: (addr handle cell) <- copy _out
   allocate out
   var out-addr/eax: (addr cell) <- lookup *out
-  var dest-ah/ecx: (addr handle screen) <- get out-addr, screen-data
-  allocate dest-ah
   var type/ecx: (addr int) <- get out-addr, type
   copy-to *type, 5/screen
 }
@@ -144,6 +141,7 @@ fn new-fake-screen _out: (addr handle cell), width: int, height: int {
   allocate-screen out
   var out-addr/eax: (addr cell) <- lookup *out
   var dest-ah/eax: (addr handle screen) <- get out-addr, screen-data
+  allocate dest-ah
   var dest-addr/eax: (addr screen) <- lookup *dest-ah
   initialize-screen dest-addr, width, height
 }
@@ -165,8 +163,6 @@ fn allocate-keyboard _out: (addr handle cell) {
   var out/eax: (addr handle cell) <- copy _out
   allocate out
   var out-addr/eax: (addr cell) <- lookup *out
-  var dest-ah/ecx: (addr handle gap-buffer) <- get out-addr, keyboard-data
-  allocate dest-ah
   var type/ecx: (addr int) <- get out-addr, type
   copy-to *type, 6/keyboard
 }
@@ -176,6 +172,7 @@ fn new-fake-keyboard _out: (addr handle cell), capacity: int {
   allocate-keyboard out
   var out-addr/eax: (addr cell) <- lookup *out
   var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data
+  allocate dest-ah
   var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah
   initialize-gap-buffer dest-addr, capacity
 }
diff --git a/shell/evaluate.mu b/shell/evaluate.mu
index 580a9ac3..fa8610c7 100644
--- a/shell/evaluate.mu
+++ b/shell/evaluate.mu
@@ -66,6 +66,22 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
     trace-higher trace
     return
   }
+  compare *in-type, 5/screen
+  {
+    break-if-!=
+    trace-text trace, "eval", "screen"
+    copy-object _in, out
+    trace-higher trace
+    return
+  }
+  compare *in-type, 6/keyboard
+  {
+    break-if-!=
+    trace-text trace, "eval", "keyboard"
+    copy-object _in, out
+    trace-higher trace
+    return
+  }
   # in-addr is a syntax tree
   $evaluate:anonymous-function: {
     # trees starting with "fn" are anonymous functions
@@ -225,8 +241,6 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
   var evaluated-list/eax: (addr cell) <- lookup *evaluated-list-ah
   var function-ah/ecx: (addr handle cell) <- get evaluated-list, left
   var args-ah/edx: (addr handle cell) <- get evaluated-list, right
-#?   set-cursor-position 0/screen, 0, 0
-#?   draw-text-wrapping-right-then-down-from-cursor-over-full-screen 0/screen, "a", 7/fg, 0/bg
   apply function-ah, args-ah, out, globals, trace, screen-cell, keyboard-cell
   trace-higher trace
   # trace "=> " out {{{
diff --git a/shell/main.mu b/shell/main.mu
index 6aecadbd..717ab1d0 100644
--- a/shell/main.mu
+++ b/shell/main.mu
@@ -9,13 +9,59 @@ fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk)
   var sandbox/esi: (addr sandbox) <- address sandbox-storage
   initialize-sandbox sandbox, 1/with-screen
   load-state data-disk, sandbox, globals
-  {
+  $main:loop: {
     render-globals screen, globals, 0/x, 0/y, 0x40/xmax, 0x2f/screen-height-without-menu
     render-sandbox screen, sandbox, 0x40/x, 0/y, 0x80/screen-width, 0x2f/screen-height-without-menu, globals
     {
       var key/eax: byte <- read-key keyboard
       compare key, 0
       loop-if-=
+      # ctrl-r
+      {
+        compare key, 0x12/ctrl-r
+        break-if-!=
+        var tmp/eax: (addr handle cell) <- copy 0
+        var nil: (handle cell)
+        tmp <- address nil
+        allocate-pair tmp
+        # (main 0/real-screen 0/real-keyboard)
+        # We're using the fact that 'screen' and 'keyboard' in this function are always 0.
+        var real-keyboard: (handle cell)
+        tmp <- address real-keyboard
+        allocate-keyboard tmp
+        # args = cons(real-keyboard, nil)
+        var args: (handle cell)
+        tmp <- address args
+        new-pair tmp, real-keyboard, nil
+        #
+        var real-screen: (handle cell)
+        tmp <- address real-screen
+        allocate-screen tmp
+        #  args = cons(real-screen, args)
+        tmp <- address args
+        new-pair tmp, real-screen, *tmp
+        #
+        var main: (handle cell)
+        tmp <- address main
+        new-symbol tmp, "main"
+        # args = cons(main, args)
+        tmp <- address args
+        new-pair tmp, main, *tmp
+        # clear real screen
+        clear-screen screen
+        set-cursor-position screen, 0, 0
+        # run
+        var out: (handle cell)
+        var out-ah/ecx: (addr handle cell) <- address out
+        evaluate tmp, out-ah, nil, globals, 0/trace, 0/no-fake-screen, 0/no-fake-keyboard
+        {
+          var tmp/eax: byte <- read-key keyboard
+          compare tmp, 0
+          loop-if-=
+        }
+        #
+        loop $main:loop
+      }
       # no way to quit right now; just reboot
       edit-sandbox sandbox, key, globals, screen, keyboard, data-disk
     }
diff --git a/shell/print.mu b/shell/print.mu
index 0bec0cd1..c89e301f 100644
--- a/shell/print.mu
+++ b/shell/print.mu
@@ -54,14 +54,26 @@ fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr tra
     trace-higher trace
     return
   }
-  compare *in-type, 5/primitive
+  compare *in-type, 5/screen
   {
     break-if-!=
     write out, "[screen "
     var screen-ah/eax: (addr handle screen) <- get in-addr, screen-data
     var screen/eax: (addr screen) <- lookup *screen-ah
     var screen-addr/eax: int <- copy screen
-    write-int32-decimal out, screen-addr
+    write-int32-hex out, screen-addr
+    write out, "]"
+    trace-higher trace
+    return
+  }
+  compare *in-type, 6/keyboard
+  {
+    break-if-!=
+    write out, "[keyboard "
+    var keyboard-ah/eax: (addr handle gap-buffer) <- get in-addr, keyboard-data
+    var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
+    var keyboard-addr/eax: int <- copy keyboard
+    write-int32-hex out, keyboard-addr
     write out, "]"
     trace-higher trace
     return
diff --git a/shell/sandbox.mu b/shell/sandbox.mu
index 65ea1557..5ad779ec 100644
--- a/shell/sandbox.mu
+++ b/shell/sandbox.mu
@@ -464,6 +464,8 @@ fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) {
   height <- increment
   clear-rect screen, 0/x, y, width, height, 0/bg=black
   set-cursor-position screen, 0/x, y
+  draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 7/bg=grey
+  draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0/bg
   draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 7/bg=grey
   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0/bg
   $render-sandbox-menu:render-tab: {
@@ -473,11 +475,11 @@ fn render-sandbox-menu screen: (addr screen), _self: (addr sandbox) {
     {
       break-if-=
       draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 9/bg=blue
-      draw-text-rightward-from-cursor screen, " move to trace  ", width, 7/fg, 0/bg
+      draw-text-rightward-from-cursor screen, " to trace  ", width, 7/fg, 0/bg
       break $render-sandbox-menu:render-tab
     }
     draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 0x18/bg=keyboard
-    draw-text-rightward-from-cursor screen, " move to keyboard  ", width, 7/fg, 0/bg
+    draw-text-rightward-from-cursor screen, " to keyboard  ", width, 7/fg, 0/bg
   }
   draw-text-rightward-from-cursor screen, " ctrl-a ", width, 0/fg, 7/bg=grey
   draw-text-rightward-from-cursor screen, " <<  ", width, 7/fg, 0/bg
@@ -499,24 +501,17 @@ fn render-keyboard-menu screen: (addr screen) {
   height <- increment
   clear-rect screen, 0/x, y, width, height, 0/bg=black
   set-cursor-position screen, 0/x, y
+  draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 7/bg=grey
+  draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0/bg
   draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 7/bg=grey
   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0/bg
   draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 3/bg=cyan
-  draw-text-rightward-from-cursor screen, " move to sandbox  ", width, 7/fg, 0/bg
+  draw-text-rightward-from-cursor screen, " to sandbox  ", width, 7/fg, 0/bg
 }
 
 fn edit-sandbox _self: (addr sandbox), key: byte, globals: (addr global-table), real-screen: (addr screen), real-keyboard: (addr keyboard), data-disk: (addr disk) {
   var self/esi: (addr sandbox) <- copy _self
   var g/edx: grapheme <- copy key
-  # ctrl-r
-  {
-    compare g, 0x12/ctrl-r
-    break-if-!=
-    # run function outside sandbox
-    # required: fn (addr screen), (addr keyboard)
-    # Mu will pass in the real screen and keyboard.
-    return
-  }
   # ctrl-s
   {
     compare g, 0x13/ctrl-s
diff --git a/shell/trace.mu b/shell/trace.mu
index 267b3ebe..7be03451 100644
--- a/shell/trace.mu
+++ b/shell/trace.mu
@@ -678,10 +678,12 @@ fn render-trace-menu screen: (addr screen) {
   var y/ecx: int <- copy height
   y <- decrement
   set-cursor-position screen, 0/x, y
+  draw-text-rightward-from-cursor screen, " ctrl-r ", width, 0/fg, 7/bg=grey
+  draw-text-rightward-from-cursor screen, " run main  ", width, 7/fg, 0/bg
   draw-text-rightward-from-cursor screen, " ctrl-s ", width, 0/fg, 7/bg=grey
   draw-text-rightward-from-cursor screen, " run sandbox  ", width, 7/fg, 0/bg
   draw-text-rightward-from-cursor screen, " tab ", width, 0/fg, 0x18/bg=keyboard
-  draw-text-rightward-from-cursor screen, " move to keyboard  ", width, 7/fg, 0/bg
+  draw-text-rightward-from-cursor screen, " to keyboard  ", width, 7/fg, 0/bg
   draw-text-rightward-from-cursor screen, " j ", width, 0/fg, 7/bg=grey
   draw-text-rightward-from-cursor screen, " down  ", width, 7/fg, 0/bg
   draw-text-rightward-from-cursor screen, " k ", width, 0/fg, 7/bg=grey
diff --git a/translate_subx b/translate_subx
index 4b730088..f4c461f6 100755
--- a/translate_subx
+++ b/translate_subx
@@ -34,7 +34,7 @@ cat a.survey    |linux/hex               > a.bin
 dd if=/dev/zero of=code.img count=20160  # 512-byte sectors, so 10MB
 dd if=a.bin of=code.img conv=notrunc
 
-if [ `stat --printf="%s" a.bin` -ge 193536 ]  # 6 tracks * 63 sectors per track * 512 bytes per sector (keep this sync'd with boot.subx)
+if [ `stat --printf="%s" a.bin` -ge 258048 ]  # 8 tracks * 63 sectors per track * 512 bytes per sector (keep this sync'd with boot.subx)
 then
   echo "a.bin won't all be loaded on boot"
   exit 1
diff --git a/translate_subx_emulated b/translate_subx_emulated
index 7d35a988..85b56436 100755
--- a/translate_subx_emulated
+++ b/translate_subx_emulated
@@ -29,7 +29,7 @@ cat a.survey      |linux/bootstrap/bootstrap run linux/hex                > a.bi
 dd if=/dev/zero of=code.img count=20160  # 512-byte sectors, so 10MB
 dd if=a.bin of=code.img conv=notrunc
 
-if [ `stat --printf="%s" a.bin` -ge 193536 ]  # 6 tracks * 63 sectors per track * 512 bytes per sector (keep this sync'd with boot.subx)
+if [ `stat --printf="%s" a.bin` -ge 258048 ]  # 8 tracks * 63 sectors per track * 512 bytes per sector (keep this sync'd with boot.subx)
 then
   echo "a.bin won't all be loaded on boot"
   exit 1