Improve safety of BIO api

doc/reference/stdio.md

@@ -451,6 +451,7 @@ The BufferedReader interface is defined as follows:
 (interface (BufferedReader Reader)
   (read-u8)
   (peek-u8)
+  (put-back previous-input)
   (skip count)
   (delimit limit)
   (reset! reader))
@@ -622,6 +623,22 @@ The separator is either a single character or a list of characters.
 If `include-sep?` is true, then the separator is include in the stream.
 If the separator is not encountered within `max-chars`, then an error is raised.
 
+#### BufferedReader-put-back
+```scheme
+(BufferedReader-put-back buf previous-input)
+  buf := BufferedReader
+  previous-input := u8 or list of u8
+```
+
+Puts back one or more previously read bytes.
+
+Notes:
+- when putting back multiple bytes, the order is the natural one: oldest first.
+- the method is guaranteed to succeed, regardless of how many bytes you are
+  putting back; the buffer may grow as needed to accomodate the putback.
+- the method allows you to _inject_ bytes into the input stream, which may
+  be useful for parsers.
+
 #### BufferedReader-skip
 ```scheme
 (BufferedReader-skip buf count)
@@ -859,3 +876,16 @@ Creates a delimited reader that can read up to `limit` bytes from `reader`.
 
 Copies from a Reader to a Writer.
 Returns the number of bytes copied.
+
+## A Note on thread-safety
+
+In general you should you the Readers from a single thread. There is
+no mutex protection for the simple reason that if you are reading from
+multiple threads concurrently you are already shooting yourself in the
+foot because your input will be non-deterministic.
+
+Similarly for writers, you should use them from a single thread at a time.
+
+For sockets, which are full duplex, you can read and write with two
+threads concurrently; it is also safe to close the socket from yet
+another thread.

src/std/build-deps

@@ -902,7 +902,8 @@
    std/io/interface
    std/os/fcntl
    std/os/fd
-   std/os/fdio))
+   std/os/fdio
+   std/sugar))
  (std/io/util "io/util" (gerbil/core std/io/interface))
  (std/io/bio/input
   "io/bio/input"

src/std/io/bio/api.ss

@@ -61,6 +61,7 @@
   (let (bio (interface-instance-object wr))
     (cond
      ((output-buffer? bio)
+      (bio-flush-output bio)
       (get-buffer-output-chunks (&output-buffer-writer bio)))
      ((chunked-output-buffer? bio)
       (or (&chunked-output-buffer-output bio)
@@ -82,6 +83,8 @@
   bio-read-u8)
 (defmethod {peek-u8 input-buffer}
   bio-peek-u8)
+(defmethod {put-back input-buffer}
+  bio-put-back)
 (defmethod {skip input-buffer}
   bio-skip-input)
 (defmethod {delimit input-buffer}
@@ -98,6 +101,8 @@
   bio-delimited-read-u8)
 (defmethod {peek-u8 delimited-input-buffer}
   bio-delimited-peek-u8)
+(defmethod {put-back delimited-input-buffer}
+  bio-delimited-put-back)
 (defmethod {skip delimited-input-buffer}
   bio-delimited-skip-input)
 (defmethod {delimit delimited-input-buffer}

src/std/io/bio/bio-test.ss

@@ -246,5 +246,4 @@
           (check (get-buffer-output-u8vector bwr) => output1))
         (let (bwr (open-buffered-writer #f))
           (check (BufferedWriter-write-line bwr input '(#\return #\newline)) => (fx+ (string-length input) 2))
-          (BufferedWriter-flush bwr)
           (check (get-buffer-output-u8vector bwr) => output2))))))

src/std/io/bio/delimited.ss

@@ -55,6 +55,20 @@
           (bio-delimited-peek-u8 in)))
       '#!eof)))
 
+(def (bio-delimited-put-back delim previous-input)
+  (let* ((limit (&delimited-input-buffer-limit delim))
+         (remaining (&delimited-input-buffer-remaining delim))
+         (new-remaining
+          (fx+ (if (pair? previous-input) (length previous-input) 1)
+               remaining))
+         (in (&delimited-input-buffer-in delim)))
+    (if (input-buffer? in)
+      (bio-put-back in previous-input)
+      (bio-delimited-put-back in previous-input))
+    (set! (&delimited-input-buffer-remaining delim)
+      new-remaining)))
+
+
 (def (bio-delimited-skip-input delim count)
   (let (remaining (&delimited-input-buffer-remaining delim))
     (if (fx> count remaining)

src/std/io/bio/inline.ss

@@ -3,49 +3,61 @@
 ;;; Buffered IO inline operations
 (import :std/sugar
         :std/interface
+        ../interface
         ./types
         ./input
         ./output)
 (export #t)
 
+(defrule (is-input-buffer? reader)
+  (input-buffer? (&interface-instance-object reader)))
+(defrule (is-output-buffer? writer)
+  (output-buffer? (&interface-instance-object writer)))
+
 (defrule (&BufferedReader-read-u8-inline reader)
-  (let ()
-    (declare (not interrupts-enabled))
-    (let (bio (&interface-instance-object reader))
-      (let ((rlo (&input-buffer-rlo bio))
-            (rhi (&input-buffer-rhi bio))
-            (buf (&input-buffer-buf bio)))
-        (if (fx< rlo rhi)
-          (let ((u8 (u8vector-ref buf rlo))
-                (rlo+1 (fx+ rlo 1)))
-            (bio-input-advance! bio rlo+1 rhi)
-            u8)
-          ;; empty buffer, fall back to the method
-          (bio-read-u8 bio))))))
+  (if (is-input-buffer? reader)
+    (let ()
+      (declare (not interrupts-enabled))
+      (let (bio (&interface-instance-object reader))
+        (let ((rlo (&input-buffer-rlo bio))
+              (rhi (&input-buffer-rhi bio))
+              (buf (&input-buffer-buf bio)))
+          (if (fx< rlo rhi)
+            (let ((u8 (u8vector-ref buf rlo))
+                  (rlo+1 (fx+ rlo 1)))
+              (bio-input-advance! bio rlo+1 rhi)
+              u8)
+            ;; empty buffer, fall back to the method
+            (bio-read-u8 bio)))))
+    (&BufferedReader-read-u8 reader)))
 
 (defrule (&BufferedReader-peek-u8-inline reader)
-  (let ()
-    (declare (not interrupts-enabled))
-    (let (bio (&interface-instance-object reader))
-      (let ((rlo (&input-buffer-rlo bio))
-            (rhi (&input-buffer-rhi bio))
-            (buf (&input-buffer-buf bio)))
-        (if (fx< rlo rhi)
-          (u8vector-ref buf rlo)
-          ;; empty buffer, fall back to the method
-          (bio-peek-u8 bio))))))
+  (if (is-input-buffer? reader)
+    (let ()
+      (declare (not interrupts-enabled))
+      (let (bio (&interface-instance-object reader))
+        (let ((rlo (&input-buffer-rlo bio))
+              (rhi (&input-buffer-rhi bio))
+              (buf (&input-buffer-buf bio)))
+          (if (fx< rlo rhi)
+            (u8vector-ref buf rlo)
+            ;; empty buffer, fall back to the method
+            (bio-peek-u8 bio)))))
+    (&BufferedReader-peek-u8 reader)))
 
 (defrule (&BufferedWriter-write-u8-inline writer u8)
-  (let ()
-    (declare (not interrupts-enabled))
-    (let (bio (&interface-instance-object writer))
-      (let* ((whi (&output-buffer-whi bio))
-             (buf (&output-buffer-buf bio))
-             (buflen (u8vector-length buf)))
-        (if (fx< whi buflen)
-          (let (whi+1 (fx+ whi 1))
-            (u8vector-set! buf whi u8)
-            (bio-output-advance! bio whi+1)
-            1)
-          ;; full buffer, fallback to the method
-          (bio-write-u8 bio u8))))))
+  (if (is-output-buffer? writer)
+    (let ()
+      (declare (not interrupts-enabled))
+      (let (bio (&interface-instance-object writer))
+        (let* ((whi (&output-buffer-whi bio))
+               (buf (&output-buffer-buf bio))
+               (buflen (u8vector-length buf)))
+          (if (fx< whi buflen)
+            (let (whi+1 (fx+ whi 1))
+              (u8vector-set! buf whi u8)
+              (bio-output-advance! bio whi+1)
+              1)
+            ;; full buffer, fallback to the method
+            (bio-write-u8 bio u8)))))
+    (&BufferedWriter-write-u8 writer u8)))

src/std/io/bio/input.ss

@@ -105,6 +105,130 @@
           (u8vector-ref buf 0)
           '#!eof)))))
 
+(def (bio-put-back bio previous-input)
+  (if (pair? previous-input)
+    (bio-put-back-many bio previous-input)
+    (bio-put-back-one bio previous-input)))
+
+(def (bio-put-back-one bio u8)
+  (let ((rlo (&input-buffer-rlo bio))
+        (rhi (&input-buffer-rhi bio))
+        (buf (&input-buffer-buf bio)))
+    (cond
+     ((fx> rlo 0)
+      ;; enough space
+      (let (new-rlo (fx- rlo 1))
+        (u8vector-set! buf new-rlo u8)
+        (set! (&input-buffer-rlo bio) new-rlo)
+        (void)))
+     ;; rlo=0
+     ((fx> rhi 0)
+      ;; we need to move the buffer contents to the right
+      (let ((rhi+1 (fx+ rhi 1))
+            (buflen (u8vector-length buf)))
+        (if (fx> rhi+1 buflen)
+          ;; uh oh, we need to grow the buffer; do it by a page
+          (let (new-buf (make-u8vector (fx+ buflen 4096)))
+            (subu8vector-move! buf 0 rhi new-buf 1)
+            (u8vector-set! new-buf 0 u8)
+            (set! (&input-buffer-buf bio) new-buf)
+            (set! (&input-buffer-rhi bio) rhi+1)
+            (void))
+          (begin
+            (subu8vector-move! buf 0 rhi buf 1)
+            (u8vector-set! buf 0 u8)
+            (set! (&input-buffer-rhi bio) rhi+1)
+            (void)))))
+     (else
+      ;; empty buffer
+      (u8vector-set! buf 0 u8)
+      (set! (&input-buffer-rhi bio) 0)
+      (set! (&input-buffer-rhi bio) 1)
+      (void)))))
+
+(def (bio-put-back-many bio previous-input)
+  (def (put-back! buf rlo previous-input)
+    (let lp ((rest previous-input) (i rlo))
+      (match rest
+        ([u8 . rest]
+         (u8vector-set! buf i u8)
+         (lp rest (fx+ i 1)))
+        (else (void)))))
+
+  (let ((rlo (&input-buffer-rlo bio))
+        (rhi (&input-buffer-rhi bio))
+        (buf (&input-buffer-buf bio))
+        (prevlen (length previous-input)))
+    (cond
+     ((fx>= rlo prevlen)
+      (let (new-rlo (fx- rlo prevlen))
+        (put-back! buf new-rlo previous-input)
+        (set! (&input-buffer-rlo bio) new-rlo)
+        (void)))
+     ((fx> rlo 0)
+      ;; we need to move the buffer contents to the right
+      (let* ((shift (fx- prevlen rlo))
+             (rhi+shift (fx+ rhi shift))
+             (buflen (u8vector-length buf)))
+        (if (fx> rhi+shift buflen)
+          ;; uh oh we need to grow the buffer; do it by a page
+          (let (new-buflen (fx+ buflen 4096))
+            (while (fx< new-buflen rhi+shift)
+              ;; ok not enough, add more pages (very unlikely, but still)
+              (set! new-buflen (fx+ new-buflen 4096)))
+            (let (new-buf (make-u8vector new-buflen))
+              (subu8vector-move! buf rlo rhi new-buf prevlen)
+              (put-back! new-buf 0 previous-input)
+              (set! (&input-buffer-buf bio) new-buf)
+              (set! (&input-buffer-rhi bio) rhi+shift)
+              (void)))
+          (begin
+            (subu8vector-move! buf rlo rhi buf prevlen)
+            (put-back! buf 0 previous-input)
+            (set! (&input-buffer-rlo bio) 0)
+            (set! (&input-buffer-rhi bio) rhi+shift)
+            (void)))))
+     ;; rlo=0
+     ((fx> rhi 0)
+      ;; we need to move the buffer contents to the right
+      (let ((rhi+shift (fx+ rhi prevlen))
+            (buflen (u8vector-length buf)))
+        (if (fx> rhi+shift buflen)
+          ;; uh oh we need to grow the buffer; do it by a page
+          (let (new-buflen (fx+ buflen 4096))
+            (while (fx< new-buflen rhi+shift)
+              ;; ok not enough, add more pages (very unlikely, but still)
+              (set! new-buflen (fx+ new-buflen 4096)))
+            (let (new-buf (make-u8vector new-buflen))
+              (subu8vector-move! buf 0 rhi new-buf prevlen)
+              (put-back! new-buf 0 previous-input)
+              (set! (&input-buffer-buf bio) new-buf)
+              (set! (&input-buffer-rhi bio) rhi+shift)
+              (void)))
+          (begin
+            (subu8vector-move! buf 0 rhi buf prevlen)
+            (put-back! buf 0 previous-input)
+            (set! (&input-buffer-rhi bio) rhi+shift)
+            (void)))))
+     ;; rlo=rhi=0
+     (else
+      (let (buflen (u8vector-length buf))
+        (if (fx> prevlen buflen)
+          ;; uh oh we need to grow the buffer; do it by a page
+          (let (new-buflen (fx+ buflen 4096))
+            (while (fx< new-buflen prevlen)
+              ;; ok not enough, add more pages (very unlikely, but still)
+              (set! new-buflen (fx+ new-buflen 4096)))
+            (let (new-buf (make-u8vector new-buflen))
+              (put-back! new-buf 0 previous-input)
+              (set! (&input-buffer-buf bio) new-buf)
+              (set! (&input-buffer-rhi bio) prevlen)
+              (void)))
+          (begin
+            (put-back! buf 0 previous-input)
+            (set! (&input-buffer-rhi bio) prevlen)
+            (void))))))))
+
 (def (bio-skip-input bio count)
   (when (fx> count 0)
     (let* ((rlo (&input-buffer-rlo bio))