/usr/share/common-lisp/source/nibbles/streams.lisp is in cl-nibbles 20170403-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 | ;;;; streams.lisp -- reading/writing signed/unsigned bytes to streams
(cl:in-package :nibbles)
(defun read-n-bytes-into (stream n-bytes v)
(dotimes (i n-bytes v)
;; READ-SEQUENCE would likely be more efficient here, but it does
;; not have the semantics we want--in particular, the blocking
;; semantics of READ-SEQUENCE are potentially bad. It's not clear
;; that READ-BYTE is any better here, though...
(setf (aref v i) (read-byte stream))))
(declaim (inline read-byte* write-byte*))
(defun read-byte* (stream n-bytes reffer)
(let ((v (make-array n-bytes :element-type '(unsigned-byte 8))))
(declare (dynamic-extent v))
(read-n-bytes-into stream n-bytes v)
(funcall reffer v 0)))
(defun write-byte* (integer stream n-bytes setter)
(let ((v (make-array n-bytes :element-type '(unsigned-byte 8))))
(declare (dynamic-extent v))
(funcall setter v 0 integer)
(write-sequence v stream)
integer))
(declaim (inline read-into-vector*))
(defun read-into-vector* (stream vector start end n-bytes reffer)
(declare (type function reffer))
(let ((v (make-array n-bytes :element-type '(unsigned-byte 8))))
(declare (dynamic-extent v))
(loop for i from start below end
do (read-n-bytes-into stream n-bytes v)
(setf (aref vector i) (funcall reffer v 0))
finally (return vector))))
(defun read-into-list* (stream list start end n-bytes reffer)
(declare (type function reffer))
(do ((end (or end (length list)))
(v (make-array n-bytes :element-type '(unsigned-byte 8)))
(rem (nthcdr start list) (rest rem))
(i start (1+ i)))
((or (endp rem) (>= i end)) list)
(declare (dynamic-extent v))
(read-n-bytes-into stream n-bytes v)
(setf (first rem) (funcall reffer v 0))))
(declaim (inline read-fresh-sequence))
(defun read-fresh-sequence (result-type stream count
element-type n-bytes reffer)
(ecase result-type
(list
(let ((list (make-list count)))
(read-into-list* stream list 0 count n-bytes reffer)))
(vector
(let ((vector (make-array count :element-type element-type)))
(read-into-vector* stream vector 0 count n-bytes reffer)))))
(defun write-sequence-with-writer (seq stream start end writer)
(declare (type function writer))
(etypecase seq
(list
(mapc (lambda (e) (funcall writer e stream))
(subseq seq start end))
seq)
(vector
(loop with end = (or end (length seq))
for i from start below end
do (funcall writer (aref seq i) stream)
finally (return seq)))))
(defun read-into-sequence (seq stream start end n-bytes reffer)
(etypecase seq
(list
(read-into-list* stream seq start end n-bytes reffer))
(vector
(let ((end (or end (length seq))))
(read-into-vector* stream seq start end n-bytes reffer)))))
#.(loop for i from 0 upto #b10111
for bitsize = (ecase (ldb (byte 2 3) i)
(0 16)
(1 32)
(2 64))
for readp = (logbitp 2 i)
for signedp = (logbitp 1 i)
for big-endian-p = (logbitp 0 i)
for name = (stream-ref-fun-name bitsize readp signedp big-endian-p)
for n-bytes = (truncate bitsize 8)
for byte-fun = (if readp
(byte-ref-fun-name bitsize signedp big-endian-p)
(byte-set-fun-name bitsize signedp big-endian-p))
for byte-arglist = (if readp '(stream) '(integer stream))
for subfun = (if readp 'read-byte* 'write-byte*)
for element-type = `(,(if signedp 'signed-byte 'unsigned-byte) ,bitsize)
collect `(progn
,@(when readp
`((declaim (ftype (function (t) (values ,element-type &optional)) ,name))))
(defun ,name ,byte-arglist
(,subfun ,@byte-arglist ,n-bytes #',byte-fun))) into forms
if readp
collect `(defun ,(stream-seq-fun-name bitsize t signedp big-endian-p)
(result-type stream count)
,(format-docstring "Return a sequence of type RESULT-TYPE, containing COUNT elements read from STREAM. Each element is a ~D-bit ~:[un~;~]signed integer read in ~:[little~;big~]-endian order. RESULT-TYPE must be either CL:VECTOR or CL:LIST. STREAM must have an element type of (UNSIGNED-BYTE 8)."
bitsize signedp big-endian-p)
(read-fresh-sequence result-type stream count
',element-type ,n-bytes #',byte-fun)) into forms
else
collect `(defun ,(stream-seq-fun-name bitsize nil signedp big-endian-p)
(seq stream &key (start 0) end)
,(format-docstring "Write elements from SEQ between START and END as ~D-bit ~:[un~;~]signed integers in ~:[little~;big~]-endian order to STREAM. SEQ may be either a vector or a list. STREAM must have an element type of (UNSIGNED-BYTE 8)."
bitsize signedp big-endian-p)
(write-sequence-with-writer seq stream start end #',name)) into forms
if readp
collect `(defun ,(stream-into-seq-fun-name bitsize signedp big-endian-p)
(seq stream &key (start 0) end)
,(format-docstring "Destructively modify SEQ by replacing the elements of SEQ between START and END with elements read from STREAM. Each element is a ~D-bit ~:[un~;~]signed integer read in ~:[little~;big~]-endian order. SEQ may be either a vector or a list. STREAM must have an element type of (UNSIGNED-BYTE 8)."
bitsize signedp big-endian-p)
(read-into-sequence seq stream start end ,n-bytes #',byte-fun)) into forms
finally (return `(progn ,@forms)))
#.(loop for i from 0 upto #b111
for float-type = (if (logbitp 2 i) 'double 'single)
for readp = (logbitp 1 i)
for big-endian-p = (logbitp 0 i)
for name = (stream-float-ref-fun-name float-type readp big-endian-p)
for n-bytes = (ecase float-type (double 8) (single 4))
for single-fun = (if readp
(float-ref-fun-name float-type big-endian-p)
(float-set-fun-name float-type big-endian-p))
for arglist = (if readp '(stream) '(float stream))
for subfun = (if readp 'read-byte* 'write-byte*)
for element-type = (ecase float-type (double 'double-float) (single 'single-float))
collect `(defun ,name ,arglist
(,subfun ,@arglist ,n-bytes #',single-fun)) into forms
if readp
collect `(defun ,(stream-float-seq-fun-name float-type t big-endian-p)
(result-type stream count)
,(format-docstring "Return a sequence of type RESULT-TYPE, containing COUNT elements read from STREAM. Each element is a ~A read in ~:[little~;big~]-endian byte order. RESULT-TYPE must be either CL:VECTOR or CL:LIST. STREAM must have an element type of (UNSIGNED-BYTE 8)."
element-type big-endian-p)
(read-fresh-sequence result-type stream count
',element-type ,n-bytes #',single-fun)) into forms
else
collect `(defun ,(stream-float-seq-fun-name float-type nil big-endian-p)
(seq stream &key (start 0) end)
,(format-docstring "Write elements from SEQ between START and END as ~As in ~:[little~;big~]-endian byte order to STREAM. SEQ may be either a vector or a list. STREAM must have an element type of (UNSIGNED-BYTE 8)."
element-type big-endian-p)
(write-sequence-with-writer seq stream start end #',name)) into forms
if readp
collect `(defun ,(stream-float-into-seq-fun-name float-type big-endian-p)
(seq stream &key (start 0) end)
,(format-docstring "Destructively modify SEQ by replacing the elements of SEQ between START and END with elements read from STREAM. Each element is a ~A read in ~:[little~;big~]-endian byte order. SEQ may be either a vector or a list. STREAM must have na element type of (UNSIGNED-BYTE 8)."
element-type big-endian-p)
(read-into-sequence seq stream start end ,n-bytes #',single-fun)) into forms
finally (return `(progn ,@forms)))
|