mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Changes to Scheme fill-input corresponding to C

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2016-05-01 21:55:09 +02:00
parent 1309ab8093
commit 4ba59e94f9
1 changed files with 33 additions and 19 deletions
Download patch file Download diff file Expand all files Collapse all files

52
module/ice-9/ports.scm
View file

@ -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))