diff --git a/scsh/bytio/interfaces.scm b/scsh/bytio/interfaces.scm new file mode 100644 index 0000000..c5d8cca --- /dev/null +++ b/scsh/bytio/interfaces.scm @@ -0,0 +1,28 @@ +; Copyright (c) 2003 RT Happe +; 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 + )) + + + + + + + + + + + + + diff --git a/scsh/bytio/packages.scm b/scsh/bytio/packages.scm new file mode 100644 index 0000000..8c28b41 --- /dev/null +++ b/scsh/bytio/packages.scm @@ -0,0 +1,16 @@ +; Copyright (c) 2003 RT Happe +; 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)) + diff --git a/scsh/bytio/rw-bytes.scm b/scsh/bytio/rw-bytes.scm new file mode 100644 index 0000000..2814237 --- /dev/null +++ b/scsh/bytio/rw-bytes.scm @@ -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))))