fixed (read-bytes/partial! _ _ n n)
added (assert ... <calling procedure>) .
This commit is contained in:
parent
62ab061350
commit
cc2b4fe985
|
@ -33,9 +33,10 @@
|
||||||
;; the buffer size. READ-BOLLOCK prefers to read maybe less than
|
;; the buffer size. READ-BOLLOCK prefers to read maybe less than
|
||||||
;; available but to avoid allocating a temp buffer ]
|
;; available but to avoid allocating a temp buffer ]
|
||||||
(define (read-bollock buf start min uebermax inport)
|
(define (read-bollock buf start min uebermax inport)
|
||||||
(assert (<= 0 min uebermax))
|
(assert (<= 0 min uebermax) read-bollock)
|
||||||
(assert (<= (+ start uebermax)
|
(assert (<= (+ start uebermax)
|
||||||
(sequence-length buf)))
|
(sequence-length buf))
|
||||||
|
read-bollock)
|
||||||
(let* ((len (sequence-length buf))
|
(let* ((len (sequence-length buf))
|
||||||
(mean (if (= min 0) 0
|
(mean (if (= min 0) 0
|
||||||
(read-block buf start min inport)))
|
(read-block buf start min inport)))
|
||||||
|
@ -58,21 +59,25 @@
|
||||||
(let-optionals args ((fd/port (current-input-port))
|
(let-optionals args ((fd/port (current-input-port))
|
||||||
(start 0)
|
(start 0)
|
||||||
(end (sequence-length bytes)))
|
(end (sequence-length bytes)))
|
||||||
(assert (<= 0 start end (sequence-length bytes)))
|
(assert (<= 0 start end (sequence-length bytes))
|
||||||
(if (integer? fd/port)
|
read-bytes!/partial)
|
||||||
(let ((port (fdes->inport fd/port)))
|
(cond ((= end start) 0)
|
||||||
(set-port-buffering port bufpol/block (- end start))
|
((integer? fd/port)
|
||||||
(read-bytes!/partial bytes port start end))
|
(let ((port (fdes->inport fd/port)))
|
||||||
(let ((blocking-i/o? (= 0 (bitwise-and open/non-blocking
|
(set-port-buffering port bufpol/block (- end start))
|
||||||
(fdes-status fd/port)))))
|
(read-bytes!/partial bytes port start end)))
|
||||||
(read-bollock bytes start
|
(else
|
||||||
(if blocking-i/o? 1 0) ; cond. forward progress
|
(let ((blocking-i/o? (= 0 (bitwise-and open/non-blocking
|
||||||
(- end start)
|
(fdes-status fd/port)))))
|
||||||
fd/port)))))
|
(read-bollock bytes start
|
||||||
|
(if blocking-i/o? 1 0) ; cond. forward progress
|
||||||
|
(- end start)
|
||||||
|
fd/port))))))
|
||||||
|
|
||||||
|
|
||||||
(define (read-bytes/partial len . maybe-fd/port)
|
(define (read-bytes/partial len . maybe-fd/port)
|
||||||
(assert (<= 0 len))
|
(assert (<= 0 len)
|
||||||
|
read-bytes/partial)
|
||||||
(let* ((fd/port (:optional maybe-fd/port (current-input-port)))
|
(let* ((fd/port (:optional maybe-fd/port (current-input-port)))
|
||||||
(buf (make-byte-vector len 0))
|
(buf (make-byte-vector len 0))
|
||||||
(nread (read-bytes!/partial buf fd/port 0 len)))
|
(nread (read-bytes!/partial buf fd/port 0 len)))
|
||||||
|
@ -88,7 +93,8 @@
|
||||||
(let-optionals args ((fd/port (current-input-port))
|
(let-optionals args ((fd/port (current-input-port))
|
||||||
(start 0)
|
(start 0)
|
||||||
(end (sequence-length bytes)))
|
(end (sequence-length bytes)))
|
||||||
(assert (<= 0 start end (sequence-length bytes)))
|
(assert (<= 0 start end (sequence-length bytes))
|
||||||
|
read-bytes!)
|
||||||
(if (integer? fd/port)
|
(if (integer? fd/port)
|
||||||
(let ((port (fdes->inport fd/port)))
|
(let ((port (fdes->inport fd/port)))
|
||||||
(set-port-buffering port bufpol/block (- end start))
|
(set-port-buffering port bufpol/block (- end start))
|
||||||
|
@ -99,7 +105,7 @@
|
||||||
|
|
||||||
|
|
||||||
(define (read-bytes len . maybe-fd/port)
|
(define (read-bytes len . maybe-fd/port)
|
||||||
(assert (<= 0 len))
|
(assert (<= 0 len) read-bytes)
|
||||||
(let* ((fd/port (:optional maybe-fd/port (current-input-port)))
|
(let* ((fd/port (:optional maybe-fd/port (current-input-port)))
|
||||||
(buf (make-byte-vector len 0))
|
(buf (make-byte-vector len 0))
|
||||||
(nread (read-bytes! buf fd/port 0 len)))
|
(nread (read-bytes! buf fd/port 0 len)))
|
||||||
|
@ -112,7 +118,8 @@
|
||||||
(let-optionals args ((fd/port (current-output-port))
|
(let-optionals args ((fd/port (current-output-port))
|
||||||
(start 0)
|
(start 0)
|
||||||
(end (sequence-length bytes)))
|
(end (sequence-length bytes)))
|
||||||
(assert (<= 0 start end (sequence-length bytes)))
|
(assert (<= 0 start end (sequence-length bytes))
|
||||||
|
write-bytes/partial)
|
||||||
(error
|
(error
|
||||||
"write-bytes/partial : behaves no better than write-string/partial.
|
"write-bytes/partial : behaves no better than write-string/partial.
|
||||||
The latter is dereleased, cf. the RELEASE notes."
|
The latter is dereleased, cf. the RELEASE notes."
|
||||||
|
@ -125,7 +132,8 @@ The latter is dereleased, cf. the RELEASE notes."
|
||||||
(let-optionals args ((fd/port (current-output-port))
|
(let-optionals args ((fd/port (current-output-port))
|
||||||
(start 0)
|
(start 0)
|
||||||
(end (sequence-length bytes)))
|
(end (sequence-length bytes)))
|
||||||
(assert (<= 0 start end (sequence-length bytes)))
|
(assert (<= 0 start end (sequence-length bytes))
|
||||||
|
write-bytes)
|
||||||
(let ((port (if (integer? fd/port)
|
(let ((port (if (integer? fd/port)
|
||||||
(let ((port (fdes->outport fd/port)))
|
(let ((port (fdes->outport fd/port)))
|
||||||
(set-port-buffering port bufpol/block (- end start))
|
(set-port-buffering port bufpol/block (- end start))
|
||||||
|
|
Loading…
Reference in New Issue