more robust print-cell

It is used to print to the trace, and we shouldn't crash the whole computer
just because the trace ran out of space.

4 files changed, 254 insertions, 20 deletions

diff --git a/108write.subx b/108write.subx
index a6e6d98c..9dc9742b 100644
--- a/108write.subx
+++ b/108write.subx
@@ -135,6 +135,79 @@ _test-stream:  # (stream byte)
 
 == code
 
+try-write:  # f: (addr stream byte), s: (addr array byte) -> overflow?/eax: boolean
+    # . prologue
+    55/push-ebp
+    89/copy                         3/mod/direct    5/rm32/ebp    .           .             .           4/r32/esp   .               .                 # copy esp to ebp
+    # if (s == 0) return
+    81          7/subop/compare     1/mod/*+disp8   5/rm32/ebp    .           .             .           .           0xc/disp8       0/imm32           # compare *(ebp+12)
+    74/jump-if-=  $write:end/disp8
+    # . save registers
+    51/push-ecx
+    # if (f->size - f->write < s->size) return
+    # . eax = f->size - f->write - s->size
+    8b/copy                         1/mod/*+disp8   5/rm32/ebp    .           .                         1/r32/ecx   8/disp8         .                 # copy *(ebp+8) to ecx
+    8b/copy                         1/mod/*+disp8   1/rm32/ecx    .           .             .           0/r32/eax   8/disp8         .                 # copy *(ecx+8) to eax
+    2b/subtract                     0/mod/indirect  1/rm32/ecx    .           .             .           0/r32/eax   .               .                 # subtract *ecx from eax
+    8b/copy                         1/mod/*+disp8   5/rm32/ebp    .           .                         1/r32/ecx   0xc/disp8       .                 # copy *(ebp+12) to ecx
+    2b/subtract                     0/mod/indirect  1/rm32/ecx    .           .             .           0/r32/eax   .               .                 # subtract *ecx from eax
+    # . if (eax < 0) return
+    3d/compare-eax-and  0/imm32
+    7c/jump-if-<  $try-write:end/disp8
+    # write(f, s)
+    # . . push args
+    ff          6/subop/push        1/mod/*+disp8   5/rm32/ebp    .           .             .           .           0xc/disp8       .                 # push *(ebp+12)
+    ff          6/subop/push        1/mod/*+disp8   5/rm32/ebp    .           .             .           .           8/disp8         .                 # push *(ebp+8)
+    # . . call
+    e8/call  write/disp32
+    # . . discard args
+    81          0/subop/add         3/mod/direct    4/rm32/esp    .           .             .           .           .               8/imm32           # add to esp
+    # . restore registers
+    59/pop-to-ecx
+    # return 0
+    b8/copy-to-eax  0/imm32
+$try-write:end:
+    # . epilogue
+    89/copy                         3/mod/direct    4/rm32/esp    .           .             .           5/r32/ebp   .               .                 # copy ebp to esp
+    5d/pop-to-ebp
+    c3/return
+
+# probably a bad idea
+space-remaining-in-stream:  # f: (addr stream byte) -> n/eax: int
+    # . prologue
+    55/push-ebp
+    89/copy                         3/mod/direct    5/rm32/ebp    .           .             .           4/r32/esp   .               .                 # copy esp to ebp
+    # . save registers
+    51/push-ecx
+    # return f->size - f->write
+    8b/copy                         1/mod/*+disp8   5/rm32/ebp    .           .                         1/r32/ecx   8/disp8         .                 # copy *(ebp+8) to ecx
+    8b/copy                         1/mod/*+disp8   1/rm32/ecx    .           .             .           0/r32/eax   8/disp8         .                 # copy *(ecx+8) to eax
+    2b/subtract                     0/mod/indirect  1/rm32/ecx    .           .             .           0/r32/eax   .               .                 # subtract *ecx from eax
+    # . restore registers
+    59/pop-to-ecx
+$space-remaining-in-stream:end:
+    # . epilogue
+    89/copy                         3/mod/direct    4/rm32/esp    .           .             .           5/r32/ebp   .               .                 # copy ebp to esp
+    5d/pop-to-ebp
+    c3/return
+
+stream-size:  # f: (addr stream byte) -> n/eax: int
+    # . prologue
+    55/push-ebp
+    89/copy                         3/mod/direct    5/rm32/ebp    .           .             .           4/r32/esp   .               .                 # copy esp to ebp
+    # . save registers
+    51/push-ecx
+    # return f->write
+    8b/copy                         1/mod/*+disp8   5/rm32/ebp    .           .                         1/r32/ecx   8/disp8         .                 # copy *(ebp+8) to ecx
+    8b/copy                         0/mod/indirect  1/rm32/ecx    .           .             .           0/r32/eax   .               .                 # copy *ecx to eax
+    # . restore registers
+    59/pop-to-ecx
+$space-remaining-in-stream:end:
+    # . epilogue
+    89/copy                         3/mod/direct    4/rm32/esp    .           .             .           5/r32/ebp   .               .                 # copy ebp to esp
+    5d/pop-to-ebp
+    c3/return
+
 # 3-argument variant of _append
 _append-3:  # out: (addr byte), outend: (addr byte), s: (addr array byte) -> num_bytes_appended/eax
     # . prologue
@@ -142,6 +215,15 @@ _append-3:  # out: (addr byte), outend: (addr byte), s: (addr array byte) -> num
     89/copy                         3/mod/direct    5/rm32/ebp    .           .             .           4/r32/esp   .               .                 # copy esp to ebp
     # . save registers
     51/push-ecx
+    # if (outend - out < s->size) abort
+    # . eax = f->size - f->write - s->size
+    8b/copy                         1/mod/*+disp8   5/rm32/ebp    .           .                         0/r32/eax   0xc/disp8       .                 # copy *(ebp+12) to eax
+    2b/subtract                     1/mod/*+disp8   5/rm32/ebp    .           .             .           0/r32/eax   8/disp8         .                 # subtract *(ebp+8) from eax
+    8b/copy                         1/mod/*+disp8   5/rm32/ebp    .           .                         1/r32/ecx   0x10/disp8      .                 # copy *(ebp+16) to ecx
+    2b/subtract                     0/mod/indirect  1/rm32/ecx    .           .             .           0/r32/eax   .               .                 # subtract *ecx from eax
+    # . if (eax < 0) abort
+    3d/compare-eax-and  0/imm32
+    7c/jump-if-<  $_append-3:abort/disp8
     # eax = _append-4(out, outend, &s->data[0], &s->data[s->size])
     # . . push &s->data[s->size]
     8b/copy                         1/mod/*+disp8   5/rm32/ebp    .           .                         0/r32/eax   0x10/disp8      .                 # copy *(ebp+16) to eax
@@ -167,6 +249,10 @@ $_append-3:end:
     5d/pop-to-ebp
     c3/return
 
+$_append-3:abort:
+    (abort "_append-3 about to overflow")  # 3=cyan
+    # never gets here
+
 # 4-argument variant of _append
 _append-4:  # out: (addr byte), outend: (addr byte), in: (addr byte), inend: (addr byte) -> num_bytes_appended/eax: int
     # . prologue
diff --git a/400.mu b/400.mu
index 94e517f8..3b81d44a 100644
--- a/400.mu
+++ b/400.mu
@@ -43,6 +43,10 @@ sig check-stream-equal f: (addr stream byte), s: (addr array byte), msg: (addr a
 sig next-stream-line-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean
 sig check-next-stream-line-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte)
 sig write f: (addr stream byte), s: (addr array byte)
+sig try-write f: (addr stream byte), s: (addr array byte) -> _/eax: boolean
+# probably a bad idea; I definitely want to discourage its use for streams of non-bytes
+sig stream-size f: (addr stream byte) -> _/eax: int
+sig space-remaining-in-stream f: (addr stream byte) -> _/eax: int
 sig write-stream f: (addr stream byte), s: (addr stream byte)
 sig read-byte s: (addr stream byte) -> _/eax: byte
 sig append-byte f: (addr stream byte), n: int  # really just a byte, but I want to pass in literal numbers
diff --git a/shell/print.mu b/shell/print.mu
index 2fab999f..ef599dc7 100644
--- a/shell/print.mu
+++ b/shell/print.mu
@@ -1,3 +1,9 @@
+# Scenario:
+#   print-cell can be used for printing into a trace
+#   traces can run out of space
+#   therefore, we need to gracefully handle insufficient space in 'out'
+#     if we're printing something 3 bytes or less, just make sure it doesn't crash
+#     if we're printing something longer than 3 bytes, try to fall back to ellipses (which are 3 bytes)
 fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr trace) {
   check-stack
   trace-text trace, "print", "print"
@@ -7,7 +13,13 @@ fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr tra
   {
     compare in-addr, 0
     break-if-!=
-    write out, "NULL"
+    var overflow?/eax: boolean <- try-write out, "NULL"
+    compare overflow?, 0/false
+    {
+      break-if-=
+      overflow? <- try-write out, "..."
+      error trace, "print-cell: no space for 'NULL'"
+    }
     trace-higher trace
     return
   }
@@ -15,7 +27,12 @@ fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr tra
     var nil?/eax: boolean <- nil? in-addr
     compare nil?, 0/false
     break-if-=
-    write out, "()"
+    var overflow?/eax: boolean <- try-write out, "()"
+    compare overflow?, 0/false
+    {
+      break-if-=
+      error trace, "print-cell: no space for '()'"
+    }
     trace-higher trace
     return
   }
@@ -51,13 +68,27 @@ fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr tra
   compare *in-type, 4/primitive
   {
     break-if-!=
-    write out, "[primitive]"
+    var overflow?/eax: boolean <- try-write out, "[primitive]"
+    compare overflow?, 0/false
+    {
+      break-if-=
+      overflow? <- try-write out, "..."
+      error trace, "print-cell: no space for primitive"
+    }
     trace-higher trace
     return
   }
   compare *in-type, 5/screen
   {
     break-if-!=
+    {
+      var available-space/eax: int <- space-remaining-in-stream out
+      compare available-space, 0x10
+      break-if->=
+      var dummy/eax: boolean <- try-write out, "..."
+      error trace, "print-cell: no space for screen"
+      return
+    }
     write out, "[screen "
     var screen-ah/eax: (addr handle screen) <- get in-addr, screen-data
     var screen/eax: (addr screen) <- lookup *screen-ah
@@ -70,6 +101,14 @@ fn print-cell _in: (addr handle cell), out: (addr stream byte), trace: (addr tra
   compare *in-type, 6/keyboard
   {
     break-if-!=
+    {
+      var available-space/eax: int <- space-remaining-in-stream out
+      compare available-space, 0x10
+      break-if->=
+      var dummy/eax: boolean <- try-write out, "..."
+      error trace, "print-cell: no space for keyboard"
+      return
+    }
     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
@@ -111,6 +150,16 @@ fn print-symbol _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
   var _data/eax: (addr stream byte) <- lookup *data-ah
   var data/esi: (addr stream byte) <- copy _data
   rewind-stream data
+  var _required-space/eax: int <- stream-size data
+  var required-space/ecx: int <- copy _required-space
+  var available-space/eax: int <- space-remaining-in-stream out
+  compare required-space, available-space
+  {
+    break-if-<=
+    var dummy/eax: boolean <- try-write out, "..."
+    error trace, "print-symbol: no space"
+    return
+  }
   write-stream out, data
   # trace
   var should-trace?/eax: boolean <- should-trace? trace
@@ -131,6 +180,17 @@ fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
   var _data/eax: (addr stream byte) <- lookup *data-ah
   var data/esi: (addr stream byte) <- copy _data
   rewind-stream data
+  var _required-space/eax: int <- stream-size data
+  var required-space/ecx: int <- copy _required-space
+  required-space <- add 2  # for []
+  var available-space/eax: int <- space-remaining-in-stream out
+  compare required-space, available-space
+  {
+    break-if-<=
+    var dummy/eax: boolean <- try-write out, "..."
+    error trace, "print-stream: no space"
+    return
+  }
   write out, "["
   write-stream out, data
   write out, "]"
@@ -147,6 +207,14 @@ fn print-stream _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
 }
 
 fn print-number _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
+  var available-space/eax: int <- space-remaining-in-stream out
+  compare available-space, 0x10
+  {
+    break-if->=
+    var dummy/eax: boolean <- try-write out, "..."
+    error trace, "print-number: no space"
+    return
+  }
   var in/esi: (addr cell) <- copy _in
   var val/eax: (addr float) <- get in, number-data
   write-float-decimal-approximate out, *val, 3/precision
@@ -174,7 +242,7 @@ fn print-pair _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
   compare is-quote?, 0/false
   {
     break-if-=
-    write out, "'"
+    var dummy/eax: boolean <- try-write out, "'"
     var right-ah/eax: (addr handle cell) <- get in, right
     print-cell right-ah, out, trace
     return
@@ -183,7 +251,7 @@ fn print-pair _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
   compare is-backquote?, 0/false
   {
     break-if-=
-    write out, "`"
+    var dummy/eax: boolean <- try-write out, "`"
     var right-ah/eax: (addr handle cell) <- get in, right
     print-cell right-ah, out, trace
     return
@@ -192,7 +260,7 @@ fn print-pair _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
   compare is-unquote?, 0/false
   {
     break-if-=
-    write out, ","
+    var dummy/eax: boolean <- try-write out, ","
     var right-ah/eax: (addr handle cell) <- get in, right
     print-cell right-ah, out, trace
     return
@@ -201,29 +269,36 @@ fn print-pair _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
   compare is-unquote-splice?, 0/false
   {
     break-if-=
-    write out, ",@"
+    var dummy/eax: boolean <- try-write out, ",@"
     var right-ah/eax: (addr handle cell) <- get in, right
     print-cell right-ah, out, trace
     return
   }
   #
   var curr/esi: (addr cell) <- copy _in
-  write out, "("
+  {
+    var overflow?/eax: boolean <- try-write out, "("
+    compare overflow?, 0/false
+    break-if-=
+    error trace, "print-pair: no space for '('"
+    return
+  }
   $print-pair:loop: {
     var left/ecx: (addr handle cell) <- get curr, left
     print-cell left, out, trace
+    # errors? skip
+    {
+      var error?/eax: boolean <- has-errors? trace
+      compare error?, 0/false
+      break-if-=
+      return
+    }
     var right/ecx: (addr handle cell) <- get curr, right
     var right-addr/eax: (addr cell) <- lookup *right
     {
       compare right-addr, 0
       break-if-!=
-      # This shouldn't ever happen in a regular REPL cycle.
-      # However, we also use print-cell when emitting the trace. And that can
-      # happen after there's been an error in the trace.
-      write out, "...NULL!"
-      error trace, "right is NULL"
-      trace-higher trace
-      return
+      abort "NULL in print!"
     }
     {
       var right-nil?/eax: boolean <- nil? right-addr
@@ -234,19 +309,37 @@ fn print-pair _in: (addr cell), out: (addr stream byte), trace: (addr trace) {
         break $print-pair:loop
       }
     }
-    write out, " "
+    {
+      var overflow?/eax: boolean <- try-write out, " "
+      compare overflow?, 0/false
+      break-if-=
+      error trace, "print-pair: no space"
+      return
+    }
     var right-type-addr/edx: (addr int) <- get right-addr, type
     {
       compare *right-type-addr, 0/pair
       break-if-=
-      write out, ". "
+      {
+        var overflow?/eax: boolean <- try-write out, ". "
+        compare overflow?, 0/false
+        break-if-=
+        error trace, "print-pair: no space"
+        return
+      }
       print-cell right, out, trace
       break $print-pair:loop
     }
     curr <- copy right-addr
     loop
   }
-  write out, ")"
+  {
+    var overflow?/eax: boolean <- try-write out, ")"
+    compare overflow?, 0/false
+    break-if-=
+    error trace, "print-pair: no space for ')'"
+    return
+  }
 }
 
 # Most lisps intern nil, but we don't really have globals yet, so we'll be
@@ -447,3 +540,52 @@ fn test-print-dotted-list {
   print-cell list, out, trace
   check-stream-equal out, "(abc . 64)", "F - test-print-dotted-list"
 }
+
+fn test-print-cell-interrupted {
+  var sym-storage: (handle cell)
+  var sym/esi: (addr handle cell) <- address sym-storage
+  new-symbol sym, "abcd"  # requires 4 bytes
+  var out-storage: (stream byte 3)  # space for just 3 bytes
+  var out/edi: (addr stream byte) <- address out-storage
+  var trace-storage: trace
+  var trace/edx: (addr trace) <- address trace-storage
+  initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+  print-cell sym, out, trace
+  # insufficient space to print out the symbol; print out ellipses if we can
+  check-stream-equal out, "...", "F - test-print-cell-interrupted"
+}
+
+fn test-print-cell-impossible {
+  var sym-storage: (handle cell)
+  var sym/esi: (addr handle cell) <- address sym-storage
+  new-symbol sym, "abcd"  # requires 4 bytes
+  var out-storage: (stream byte 2)
+  var out/edi: (addr stream byte) <- address out-storage
+  var trace-storage: trace
+  var trace/edx: (addr trace) <- address trace-storage
+  initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+  print-cell sym, out, trace
+  # insufficient space even for ellipses; print nothing
+  check-stream-equal out, "", "F - test-print-cell-impossible"
+}
+
+fn test-print-cell-interrupted-list {
+  # list = (abcd) requires 6 bytes
+  var left-storage: (handle cell)
+  var left/ecx: (addr handle cell) <- address left-storage
+  new-symbol left, "abcd"
+  var nil-storage: (handle cell)
+  var nil/edx: (addr handle cell) <- address nil-storage
+  allocate-pair nil
+  var list-storage: (handle cell)
+  var list/esi: (addr handle cell) <- address list-storage
+  new-pair list, *left, *nil
+  #
+  var out-storage: (stream byte 4)  # space for just 4 bytes
+  var out/edi: (addr stream byte) <- address out-storage
+  var trace-storage: trace
+  var trace/edx: (addr trace) <- address trace-storage
+  initialize-trace trace, 1/only-errors, 0x10/capacity, 0/visible
+  print-cell list, out, trace
+  check-stream-equal out, "(...", "F - test-print-cell-interrupted-list"
+}
diff --git a/vocabulary.md b/vocabulary.md
index 1408c1b4..a130b26b 100644
--- a/vocabulary.md
+++ b/vocabulary.md
@@ -35,8 +35,8 @@ how they work under the hood.
 
   Invariant: 0 <= `read` <= `write` <= `size`
 
-  Writes to a stream abort if it's full. Reads to a stream abort if it's
-  empty.
+  By default, writes to a stream abort if it's full. Reads to a stream abort
+  if it's empty.
 
 - Graphemes: 32-bit fragments of utf-8 that encode a single Unicode code-point.
 - Code-points: 32-bit integers representing a Unicode character.
@@ -106,6 +106,8 @@ The most useful functions from 400.mu and later .mu files. Look for definitions
 
 - `write`: writes a string into a stream of bytes. Doesn't support streams of
   other types.
+- `try-write`: writes a string into a stream of bytes if possible. Doesn't
+  support streams of other types.
 - `write-stream`: concatenates one stream into another.
 - `write-slice`: writes a slice into a stream of bytes.
 - `append-byte`: writes a single byte into a stream of bytes.