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
156
157
158
159
160
161
|
;;;; streams.lisp -- reading/writing signed/unsigned bytes to streams
(cl:in-package :nibbles)
(defun read-n-bytes-into (stream n-bytes v)
(declare (type (integer 2 8) n-bytes))
(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)
(declare (type (integer 2 8) n-bytes))
(let ((v (make-octet-vector n-bytes)))
(declare (dynamic-extent v))
(read-n-bytes-into stream n-bytes v)
(funcall reffer v 0)))
(defun write-byte* (integer stream n-bytes setter)
(declare (type (integer 2 8) n-bytes))
(let ((v (make-octet-vector n-bytes)))
(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 (integer 2 8) n-bytes)
(type function reffer))
(let ((v (make-octet-vector n-bytes)))
(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 (integer 2 8) n-bytes)
(type function reffer))
(do ((end (or end (length list)))
(v (make-octet-vector n-bytes))
(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)
(declare (type (integer 2 8) n-bytes))
(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)))
|
