[Guile-commits] 08/08: Make 'get-bytevector-some' and 'get-bytevector-some!' suspendable.

[Mark H. Weaver]

mhw pushed a commit to branch stable-2.2
in repository guile.

commit 8150823fc87b837a4db3d7690a920dc2484aa1d7
Author: Mark H Weaver <address@hidden>
Date:   Tue Apr 16 23:13:37 2019 -0400

    Make 'get-bytevector-some' and 'get-bytevector-some!' suspendable.
    
    * module/ice-9/suspendable-ports.scm (get-bytevector-some)
    (get-bytevector-some!): New procedures.
    (port-bindings): Add them.
---
 module/ice-9/suspendable-ports.scm | 31 ++++++++++++++++++++++++++++++-
 1 file changed, 30 insertions(+), 1 deletion(-)

diff --git a/module/ice-9/suspendable-ports.scm 
b/module/ice-9/suspendable-ports.scm
index a366c8b..91c5c76 100644
--- a/module/ice-9/suspendable-ports.scm
+++ b/module/ice-9/suspendable-ports.scm
@@ -1,5 +1,5 @@
 ;;; Ports, implemented in Scheme
-;;; Copyright (C) 2016 Free Software Foundation, Inc.
+;;; Copyright (C) 2016, 2019 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU Lesser General Public License as
@@ -292,6 +292,34 @@
        ((< (- count pos) (port-read-buffering port)) (buffer-and-fill pos))
        (else (fill-directly pos))))))
 
+(define (get-bytevector-some port)
+  (call-with-values (lambda () (fill-input port 1 'binary))
+    (lambda (buf cur buffered)
+      (if (zero? buffered)
+          (begin
+            (set-port-buffer-has-eof?! buf #f)
+            the-eof-object)
+          (let ((result (make-bytevector buffered)))
+            (bytevector-copy! (port-buffer-bytevector buf) cur
+                              result 0 buffered)
+            (set-port-buffer-cur! buf (+ cur buffered))
+            result)))))
+
+(define (get-bytevector-some! port bv start count)
+  (if (zero? count)
+      0
+      (call-with-values (lambda () (fill-input port 1 'binary))
+        (lambda (buf cur buffered)
+          (if (zero? buffered)
+              (begin
+                (set-port-buffer-has-eof?! buf #f)
+                the-eof-object)
+              (let ((transfer-size (min count buffered)))
+                (bytevector-copy! (port-buffer-bytevector buf) cur
+                                  transfer-size start buffered)
+                (set-port-buffer-cur! buf (+ cur transfer-size))
+                transfer-size))))))
+
 (define (put-u8 port byte)
   (let* ((buf (port-write-buffer port))
          (bv (port-buffer-bytevector buf))
@@ -703,6 +731,7 @@
      accept connect)
     ((ice-9 binary-ports)
      get-u8 lookahead-u8 get-bytevector-n
+     get-bytevector-some get-bytevector-some!
      put-u8 put-bytevector)
     ((ice-9 textual-ports)
      put-char put-string)