[Guile-commits] 01/08: Changes to Scheme fill-input corresponding to C

[Andy Wingo]

wingo pushed a commit to branch wip-port-refactor
in repository guile.

commit 4ba59e94f988602cc07ab79b1e617194dd4d03b0
Author: Andy Wingo <address@hidden>
Date:   Sun May 1 21:55:09 2016 +0200

    Changes to Scheme fill-input corresponding to C
    
    * module/ice-9/ports.scm (fill-input): Rewrite to make changes like the
      ones made to the C scm_fill_input: allow callers to specify a minimum
      amount of buffering.
---
 module/ice-9/ports.scm |   52 ++++++++++++++++++++++++++++++------------------
 1 file changed, 33 insertions(+), 19 deletions(-)

diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index 8051549..2bc12c5 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -196,31 +196,45 @@
       (error "bad return from port read function" read))
     read))
 
-(define (fill-input port)
-  (let ((buf (port-read-buffer port)))
+(define* (fill-input port #:optional (minimum-buffering 1))
+  (let* ((buf (port-read-buffer port))
+         (cur (port-buffer-cur buf))
+         (buffered (- (port-buffer-end buf) cur)))
     (cond
-     ((or (< (port-buffer-cur buf) (port-buffer-end buf))
-          (port-buffer-has-eof? buf))
-      buf)
+     ((or (<= minimum-buffering buffered) (port-buffer-has-eof? buf))
+      (values buf buffered))
      (else
       (unless (input-port? port)
         (error "not an input port" port))
       (when (port-random-access? port)
         (flush-output port))
-      (let* ((read-buffering (port-read-buffering port))
-             (buf (if (= (bytevector-length (port-buffer-bytevector buf))
-                         read-buffering)
-                      buf
-                      (let ((buf (make-port-buffer read-buffering)))
-                        (set-port-read-buffer! port buf)
-                        buf)))
-             (bv (port-buffer-bytevector buf))
-             (start (port-buffer-end buf))
-             (count (- (bytevector-length bv) start))
-             (read (read-bytes port bv start count)))
-        (set-port-buffer-end! buf (+ start read))
-        (set-port-buffer-has-eof?! buf (zero? count))
-        buf)))))
+      (let ((bv (port-buffer-bytevector buf)))
+        (cond
+         ((< (bytevector-length bv) minimum-buffering)
+          (let ((buf* (make-port-buffer minimum-buffering)))
+            (bytevector-copy! bv cur (port-buffer-bytevector buf*) 0 buffered)
+            (set-port-buffer-end! buf* buffered)
+            (set-port-read-buffer! port buf*)
+            (fill-input port minimum-buffering)))
+         (else
+          (when (< 0 cur)
+            (bytevector-copy! bv cur bv 0 buffered)
+            (set-port-buffer-cur! buf 0)
+            (set-port-buffer-end! buf buffered))
+          (let ((buffering (max (port-read-buffering port) minimum-buffering)))
+            (let lp ((buffered buffered))
+              (let* ((count (- buffering buffered))
+                     (read (read-bytes port bv buffered count)))
+                (cond
+                 ((zero? read)
+                  (set-port-buffer-has-eof?! buf #t)
+                  (values buf buffered))
+                 (else
+                  (let ((buffered (+ buffered read)))
+                    (set-port-buffer-end! buf buffered)
+                    (if (< buffered minimum-buffering)
+                        (lp buffered)
+                        (values buf buffered)))))))))))))))
 
 (define (peek-byte port)
   (let* ((buf (port-read-buffer port))