diff options
author | Andy Wingo <wingo@pobox.com> | 2016-05-01 21:55:09 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2016-05-01 21:57:32 +0200 |
commit | 4ba59e94f988602cc07ab79b1e617194dd4d03b0 (patch) | |
tree | 05eab87c9bfc716ecc1e10672ef5699b4ec55790 | |
parent | 1309ab8093c7aaf4b6e37fc7e38b7a071fd70dd1 (diff) | |
download | guile-4ba59e94f988602cc07ab79b1e617194dd4d03b0.tar.gz |
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.
-rw-r--r-- | module/ice-9/ports.scm | 52 |
1 files changed, 33 insertions, 19 deletions
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm index 8051549eb..2bc12c5c3 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)) |