byte i/o
This commit is contained in:
Rolf-Thomas Happe
parent
7cfd2e6c72
commit
0c0602e0ca
|
|
@ -0,0 +1,28 @@
|
||||||
|
; Copyright (c) 2003 RT Happe <rthappe at web de>
|
||||||
|
; See the file COPYING distributed with the Scheme Untergrund Library
|
||||||
|
|
||||||
|
(define-interface bytio-face
|
||||||
|
(export read-byte
|
||||||
|
peek-byte
|
||||||
|
write-byte
|
||||||
|
|
||||||
|
read-bytes!/partial
|
||||||
|
read-bytes/partial
|
||||||
|
read-bytes!
|
||||||
|
read-bytes
|
||||||
|
write-bytes/partial
|
||||||
|
write-bytes
|
||||||
|
))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
@ -0,0 +1,16 @@
|
||||||
|
; Copyright (c) 2003 RT Happe <rthappe at web de>
|
||||||
|
; See the file COPYING distributed with the Scheme Untergrund Library
|
||||||
|
|
||||||
|
;; byte (rather than character) i/o
|
||||||
|
(define-structure bytio bytio-face
|
||||||
|
(open krims ; assert
|
||||||
|
scheme
|
||||||
|
byte-vectors
|
||||||
|
ascii ; char<->ascii
|
||||||
|
i/o ; read-block
|
||||||
|
ports ; port-buffer
|
||||||
|
primitives ; copy-bytes!
|
||||||
|
let-opt ; let-optionals
|
||||||
|
)
|
||||||
|
(files rw-bytes))
|
||||||
|
|
||||||
|
|
@ -0,0 +1,134 @@
|
||||||
|
;;; read and write bytes (instead of characters)
|
||||||
|
;;; READ/PEEK/WRITE-BYTE are simple wrappers around the corresponding
|
||||||
|
;;; character procedures, therefore not optimally efficient.
|
||||||
|
;;; READ-BYTES!/PARTIAL
|
||||||
|
|
||||||
|
;; [input-port | fdes] -> eof | integer in [0:256)
|
||||||
|
(define (read-byte . maybe-in)
|
||||||
|
(let ((x (apply read-char maybe-in)))
|
||||||
|
(if (eof-object? x) x
|
||||||
|
(char->ascii x))))
|
||||||
|
|
||||||
|
;; [input-port | fdes] -> eof | integer in [0:256)
|
||||||
|
(define (peek-byte . maybe-inport)
|
||||||
|
(let ((x (apply peek-char maybe-inport)))
|
||||||
|
(if (eof-object? x) x
|
||||||
|
(char->ascii x))))
|
||||||
|
|
||||||
|
;; integer -> any
|
||||||
|
;; assume B in [0:256)
|
||||||
|
;; write byte with numerical value B to you know what
|
||||||
|
(define (write-byte b . maybe-out)
|
||||||
|
(apply write-char (ascii->char b) maybe-out))
|
||||||
|
|
||||||
|
|
||||||
|
;; requires i/o for read-block, debug-utils for assert
|
||||||
|
;; Assume MIN <= UBERMAX and BUF length < START + UEBERMAX.
|
||||||
|
;; Read at least MIN bytes from INPORT into BUF starting at index START,
|
||||||
|
;; possibly more if possible w/o blocking, but in toto less than UEBERMAX.
|
||||||
|
;; Return the number of bytes (<= UEBERMAX) read into BUF, but eof if
|
||||||
|
;; min>0 and reading started at end of file.
|
||||||
|
;; [ Problem with the underlying READ-BLOCK: if we want to read (at most)
|
||||||
|
;; n>0 bytes w/o blocking, we have to communicate the upper bound n by
|
||||||
|
;; the buffer size. READ-BOLLOCK prefers to read maybe less than
|
||||||
|
;; available but to avoid allocating a temp buffer ]
|
||||||
|
(define (read-bollock buf start min uebermax inport)
|
||||||
|
(assert (<= 0 min uebermax))
|
||||||
|
(assert (<= (+ start uebermax)
|
||||||
|
(sequence-length buf)))
|
||||||
|
(let* ((len (sequence-length buf))
|
||||||
|
(mean (if (= min 0) 0
|
||||||
|
(read-block buf start min inport)))
|
||||||
|
(xtra (cond ((eof-object? mean) mean)
|
||||||
|
((< (+ start uebermax) len) 0)
|
||||||
|
(else
|
||||||
|
;; the remaining buffer size communicates
|
||||||
|
;; the max number of bytes to be read
|
||||||
|
;; (if UEBERMAX = MIN we are asking for 0 bytes)
|
||||||
|
(read-block buf (+ start mean) 'immediate inport)))))
|
||||||
|
|
||||||
|
(if (eof-object? xtra) mean
|
||||||
|
(+ mean xtra))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
;; like READ-STRING!/PARTIAL with byte-vectors instead of strings
|
||||||
|
;; [ accepts strings as well ]
|
||||||
|
(define (read-bytes!/partial bytes . args)
|
||||||
|
(let-optionals args ((fd/port (current-input-port))
|
||||||
|
(start 0)
|
||||||
|
(end (sequence-length bytes)))
|
||||||
|
(assert (<= 0 start end (sequence-length bytes)))
|
||||||
|
(if (integer? fd/port)
|
||||||
|
(let ((port (fdes->inport fd/port)))
|
||||||
|
(set-port-buffering port bufpol/block (- end start))
|
||||||
|
(read-bytes!/partial bytes port start end))
|
||||||
|
(let ((blocking-i/o? (= 0 (bitwise-and open/non-blocking
|
||||||
|
(fdes-status 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)
|
||||||
|
(assert (<= 0 len))
|
||||||
|
(let* ((fd/port (:optional maybe-fd/port (current-input-port)))
|
||||||
|
(buf (make-byte-vector len 0))
|
||||||
|
(nread (read-bytes!/partial buf fd/port 0 len)))
|
||||||
|
(cond ((not nread) #f)
|
||||||
|
((= nread len) buf)
|
||||||
|
(else (subsequence buf 0 nread)))))
|
||||||
|
|
||||||
|
|
||||||
|
;; The implementation of READ-STRING! should work with byte-vectors but for
|
||||||
|
;; BOGUS-SUBSTRING-SPEC? -- which calls STRING-LENGTH
|
||||||
|
;; READ-BYTES! accepts strings, too.
|
||||||
|
(define (read-bytes! bytes . args)
|
||||||
|
(let-optionals args ((fd/port (current-input-port))
|
||||||
|
(start 0)
|
||||||
|
(end (sequence-length bytes)))
|
||||||
|
(assert (<= 0 start end (sequence-length bytes)))
|
||||||
|
(if (integer? fd/port)
|
||||||
|
(let ((port (fdes->inport fd/port)))
|
||||||
|
(set-port-buffering port bufpol/block (- end start))
|
||||||
|
(read-block bytes start (- end start) port))
|
||||||
|
(let ((nbytes/eof (read-block bytes start (- end start) fd/port)))
|
||||||
|
(if (eof-object? nbytes/eof) #f
|
||||||
|
nbytes/eof)))))
|
||||||
|
|
||||||
|
|
||||||
|
(define (read-bytes len . maybe-fd/port)
|
||||||
|
(assert (<= 0 len))
|
||||||
|
(let* ((fd/port (:optional maybe-fd/port (current-input-port)))
|
||||||
|
(buf (make-byte-vector len 0))
|
||||||
|
(nread (read-bytes! buf fd/port 0 len)))
|
||||||
|
(cond ((not nread) #f)
|
||||||
|
((= nread len) buf)
|
||||||
|
(else (subsequence buf 0 nread)))))
|
||||||
|
|
||||||
|
|
||||||
|
(define (write-bytes/partial bytes . args)
|
||||||
|
(let-optionals args ((fd/port (current-output-port))
|
||||||
|
(start 0)
|
||||||
|
(end (sequence-length bytes)))
|
||||||
|
(assert (<= 0 start end (sequence-length bytes)))
|
||||||
|
(error
|
||||||
|
"write-bytes/partial : behaves no better than write-string/partial.
|
||||||
|
The latter is dereleased, cf. the RELEASE notes."
|
||||||
|
)))
|
||||||
|
|
||||||
|
;; the implementation of WRITE-STRING should write byte-vectors but for
|
||||||
|
;; the implicit STRING-LENGTH call ... WRITE-BYTES should write strings,
|
||||||
|
;; too.
|
||||||
|
(define (write-bytes bytes . args)
|
||||||
|
(let-optionals args ((fd/port (current-output-port))
|
||||||
|
(start 0)
|
||||||
|
(end (sequence-length bytes)))
|
||||||
|
(assert (<= 0 start end (sequence-length bytes)))
|
||||||
|
(let ((port (if (integer? fd/port)
|
||||||
|
(let ((port (fdes->outport fd/port)))
|
||||||
|
(set-port-buffering port bufpol/block (- end start))
|
||||||
|
port)
|
||||||
|
fd/port)))
|
||||||
|
(write-block bytes start (- end start) port))))
|
||||||
Loading…
Reference in New Issue