diff --git a/module/ice-9/suspendable-ports.scm b/module/ice-9/suspendable-ports.scm index a366c8b9c..91c5c760f 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)