summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2016-05-22 23:02:41 +0200
committerAndy Wingo <wingo@pobox.com>2016-05-22 23:03:16 +0200
commitc95a19376b1f2fd26c60fb56c1c9892eef1acfc4 (patch)
tree492004194abde7854bdd8ac428460d0e7c43d980 /module
parent4e288ec2ff9c5387951dcb7f78f3193261228878 (diff)
downloadguile-c95a19376b1f2fd26c60fb56c1c9892eef1acfc4.tar.gz
get-bytevector-n in Scheme.
* module/ice-9/sports.scm (fill-input): Add io-mode optional arg. (get-bytevector-n): New implementation. (port-bindings): Add get-bytevector-n. * test-suite/tests/sports.test: Add r6rs-ports tests.
Diffstat (limited to 'module')
-rw-r--r--module/ice-9/sports.scm53
1 files changed, 50 insertions, 3 deletions
diff --git a/module/ice-9/sports.scm b/module/ice-9/sports.scm
index ce782d856..807eada0b 100644
--- a/module/ice-9/sports.scm
+++ b/module/ice-9/sports.scm
@@ -56,6 +56,7 @@
read-char)
#:export (lookahead-u8
get-u8
+ get-bytevector-n
%read-line
read-line
read-delimited
@@ -148,8 +149,8 @@
(maybe-consume-bom utf32be-bom)
(specialize-port-encoding! port 'UTF-32BE)))))))
-(define* (fill-input port #:optional (minimum-buffering 1))
- (clear-stream-start-for-bom-read port 'text)
+(define* (fill-input port #:optional (minimum-buffering 1) (io-mode 'text))
+ (clear-stream-start-for-bom-read port io-mode)
(let* ((buf (port-read-buffer port))
(cur (port-buffer-cur buf))
(buffered (- (port-buffer-end buf) cur)))
@@ -226,6 +227,52 @@
(fast-path buf bv cur buffered)))
(peek-bytes port 1 fast-path slow-path))
+(define* (get-bytevector-n port count)
+ (let ((ret (make-bytevector count)))
+ (define (port-buffer-take! pos buf cur to-copy)
+ (bytevector-copy! (port-buffer-bytevector buf) cur
+ ret pos to-copy)
+ (set-port-buffer-cur! buf (+ cur to-copy))
+ (+ pos to-copy))
+ (define (take-already-buffered)
+ (let* ((buf (port-read-buffer port))
+ (cur (port-buffer-cur buf))
+ (buffered (- (port-buffer-end buf) cur)))
+ (port-buffer-take! 0 buf cur (min count buffered))))
+ (define (trim-and-return len)
+ (if (zero? len)
+ the-eof-object
+ (let ((partial (make-bytevector len)))
+ (bytevector-copy! ret 0 partial 0 len)
+ partial)))
+ (define (buffer-and-fill pos)
+ (call-with-values (lambda () (fill-input port 1 'binary))
+ (lambda (buf buffered)
+ (if (zero? buffered)
+ (begin
+ (set-port-buffer-has-eof?! buf #f)
+ (trim-and-return pos))
+ (let ((pos (port-buffer-take! pos buf (port-buffer-cur buf)
+ (min (- count pos) buffered))))
+ (if (= pos count)
+ ret
+ (buffer-and-fill pos)))))))
+ (define (fill-directly pos)
+ (when (port-random-access? port)
+ (flush-output port))
+ (port-clear-stream-start-for-bom-read port)
+ (let lp ((pos pos))
+ (let ((read (read-bytes port ret pos (- count pos))))
+ (cond
+ ((= read (- count pos)) ret)
+ ((zero? read) (trim-and-return pos))
+ (else (lp (+ pos read)))))))
+ (let ((pos (take-already-buffered)))
+ (cond
+ ((= pos count) (if (zero? pos) the-eof-object ret))
+ ((< (- count pos) (port-read-buffering port)) (buffer-and-fill pos))
+ (else (fill-directly pos))))))
+
(define (decoding-error subr port)
;; GNU definition; fixme?
(define EILSEQ 84)
@@ -527,7 +574,7 @@
(define saved-port-bindings #f)
(define port-bindings
'(((guile) read-char peek-char)
- ((ice-9 binary-ports) get-u8 lookahead-u8)
+ ((ice-9 binary-ports) get-u8 lookahead-u8 get-bytevector-n)
((ice-9 rdelim) %read-line read-line read-delimited)))
(define (install-sports!)
(unless saved-port-bindings