summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-05-01 21:55:09 +0200
committerAndy Wingo <wingo@pobox.com>2016-05-01 21:57:32 +0200
commit4ba59e94f988602cc07ab79b1e617194dd4d03b0 (patch)
tree05eab87c9bfc716ecc1e10672ef5699b4ec55790
parent1309ab8093c7aaf4b6e37fc7e38b7a071fd70dd1 (diff)
downloadguile-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.scm52
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))