Ready for performance test
[lodematron.git] / lodematron-read.lisp
blob92b76d1cfd29a44c2d4285537188e6046d09719f
3 (in-package :lodematron)
5 ;; -- reading atomic binary values -----------------------------------------
7 (defgeneric read-value (type stream &key array-size alignment endian)
8 (:documentation "Read a value of the given type from the file."))
10 ;; -- read aligned binary data ----------------------------------------------
12 (defgeneric align-for-read (stream alignment))
14 (defconstant +word-align+ 1)
15 (defconstant +dword-align+ 3)
16 (defconstant +qword-align+ 7)
18 ;; why am I advancing this byte by byte?
19 (defmethod align-for-read ((self stream) alignment)
20 "Align a file stream for reading at alignment bytes boundary."
21 (when (not (zerop alignment))
22 (iterate
23 (until (zerop (logand (file-position self) alignment)))
24 (file-position self (1+ (file-position self))))))
26 ;; -- read arrays of binary data ---------------------------------------------
27 ;; -- note the lack of hygine with regards to "endian"
29 (defmacro with-size-and-alignment-read (array-element-type alignment array-size &rest body)
30 "Use the function body to read a value into an array of the given
31 size, begnning the read at the given alignment. Assumes the read will
32 be from a variable bound to a symbol called self, and alingment is
33 performed by calling (align-for-read self bytes)."
34 (once-only (alignment array-size)
35 (with-gensyms (read-once result)
36 `(labels ((,read-once ()
37 ,@body))
38 (when ,alignment
39 (align-for-read self alignment))
40 (if (not (zerop ,array-size))
41 (let ((,result (make-array ,array-size :element-type ',array-element-type)))
42 (loop
43 for index from 0 below ,array-size
45 (setf (aref ,result index) (,read-once)))
46 ,result)
47 (,read-once))))))
50 (defmethod read-value ((type (eql :u8)) (self stream) &key (array-size 0) (alignment 0) (endian :little))
51 (declare (ignore endian))
52 (with-size-and-alignment-read
53 (unsigned-byte 8) alignment array-size
54 (read-byte self)))
57 (defmethod read-value ((type (eql :s8)) (self stream) &key (array-size 0) (alignment 0) (endian :little))
58 (declare (ignore endian))
59 (with-size-and-alignment-read
60 (unsigned-byte 8) alignment array-size
61 (let ((u8 (read-value :u8 self)))
62 (if (> u8 #X7F)
63 (- u8 #X100)
64 u8))))
66 (defmethod read-value ((type (eql :u16)) (self stream) &key (array-size 0) (alignment 0) (endian :little))
67 (with-size-and-alignment-read
68 (unsigned-byte 16) alignment array-size
69 (ccase endian
70 (:little
71 (let ((u16 0))
72 (setf (ldb (byte 8 0) u16) (read-byte self))
73 (setf (ldb (byte 8 8) u16) (read-byte self))
74 u16))
75 (:big
76 (let ((u16 0))
77 (setf (ldb (byte 8 8) u16) (read-byte self))
78 (setf (ldb (byte 8 0) u16) (read-byte self))
79 u16)))))
81 (defmethod read-value ((type (eql :s16)) (self stream) &key (array-size 0) (alignment 0) (endian :little))
82 (with-size-and-alignment-read
83 (unsigned-byte 16) alignment array-size
84 (let ((u16 (read-value :u16 self :endian endian)))
85 (if (> u16 #X7FFF)
86 (- u16 #X10000)
87 u16))))
89 (defmethod read-value ((type (eql :u32)) (self stream) &key (array-size 0) (alignment 0) (endian :little))
90 (with-size-and-alignment-read
91 (unsigned-byte 32) alignment array-size
92 (ccase endian
93 (:little
94 (let ((u32 0))
95 (setf (ldb (byte 8 0) u32) (read-byte self))
96 (setf (ldb (byte 8 8) u32) (read-byte self))
97 (setf (ldb (byte 8 16) u32) (read-byte self))
98 (setf (ldb (byte 8 24) u32) (read-byte self))
99 u32))
100 (:big
101 (let ((u32 0))
102 (setf (ldb (byte 8 24) u32) (read-byte self))
103 (setf (ldb (byte 8 16) u32) (read-byte self))
104 (setf (ldb (byte 8 8 ) u32) (read-byte self))
105 (setf (ldb (byte 8 0) u32) (read-byte self))
106 u32)))))
108 (defmethod read-value ((type (eql :s32)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little))
109 (with-size-and-alignment-read
110 (unsigned-byte 32) alignment array-size
111 (let ((u32 (read-value :u32 self :endian endian)))
112 (if (> u32 #X7FFFFFFF)
113 (- u32 #X100000000)
114 u32))))
116 (defmethod read-value ((type (eql :u64)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little))
117 (with-size-and-alignment-read
118 (unsigned-byte 64) alignment array-size
119 (ccase endian
120 (:little
121 (let ((u64 0))
122 (setf (ldb (byte 8 0) u64) (read-byte self))
123 (setf (ldb (byte 8 8) u64) (read-byte self))
124 (setf (ldb (byte 8 16) u64) (read-byte self))
125 (setf (ldb (byte 8 24) u64) (read-byte self))
126 (setf (ldb (byte 8 32) u64) (read-byte self))
127 (setf (ldb (byte 8 40) u64) (read-byte self))
128 (setf (ldb (byte 8 48) u64) (read-byte self))
129 (setf (ldb (byte 8 56) u64) (read-byte self))
130 u64))
131 (:big
132 (let ((u64 0))
133 (setf (ldb (byte 8 56) u64) (read-byte self))
134 (setf (ldb (byte 8 48) u64) (read-byte self))
135 (setf (ldb (byte 8 40) u64) (read-byte self))
136 (setf (ldb (byte 8 32) u64) (read-byte self))
137 (setf (ldb (byte 8 24) u64) (read-byte self))
138 (setf (ldb (byte 8 16) u64) (read-byte self))
139 (setf (ldb (byte 8 8 ) u64) (read-byte self))
140 (setf (ldb (byte 8 0) u64) (read-byte self))
141 u64)))))
143 (defmethod read-value ((type (eql :s64)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little))
144 (with-size-and-alignment-read
145 (unsigned-byte 32) alignment array-size
146 (let ((u64 (read-value :u64 self :endian endian)))
147 (if (> u64 #X7FFFFFFFFFFFFFFF)
148 (- u64 #X10000000000000000)
149 u64))))
151 (defmethod read-value ((type (eql :float32)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little))
152 (with-size-and-alignment-read
153 (unsigned-byte 32) alignment array-size
154 (let ((u32 (read-value :u32 self :endian endian)))
155 (ieee-floats::decode-float32 u32))))
157 (defmethod read-value ((type (eql :float64)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little))
158 (with-size-and-alignment-read
159 (unsigned-byte 32) alignment array-size
160 (let ((u64 (read-value :u64 self :endian endian)))
161 (ieee-floats::decode-float64 u64))))
163 (defmethod read-value ((type (eql :asciiz)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little))
164 "Read a number of zero terminated ascii strings from the stream"
165 (declare (ignorable endian))
166 (with-size-and-alignment-read
167 t 0 alignment array-size
168 (let ((result (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t)))
169 (iterate
170 (for byte = (read-byte self))
171 (until (zerop byte))
172 (vector-push-extend (code-char byte) result)) ;; to do - a byte isn't a char, use octets-to-string?
173 result)))
175 (defmethod read-value ((type (eql :nstring32)) (self stream) &key ( array-size 0 ) ( alignment 0 ) (endian :little))
176 "Read a string preceeded with a 32 bit length from the stream"
177 (declare (ignorable endian))
178 (with-size-and-alignment-read
179 t alignment array-size
180 (let ((result (make-array '(0) :element-type 'base-char :fill-pointer 0 :adjustable t)))
181 (let ((string-length (read-value :u32 self :array-size 0 :alignment alignment :endian endian)))
182 (iterate
183 (for index from 0 below string-length)
184 (for byte = (read-byte self))
185 (vector-push-extend (code-char byte) result))
186 result))))