1 | ;;; nt-readval.el --- read value or a string from buffer |
---|
2 | ;; |
---|
3 | ;; Copyright (C) 2005 Naoya TOZUKA. All Rights Reserved. |
---|
4 | ;; |
---|
5 | ;; Author: Naoya TOZUKA <pdicviewer@gmail.com> |
---|
6 | ;; Maintainer: Naoya TOZUKA <pdicviewer@gmail.com> |
---|
7 | ;; Primary distribution site: http://pdicviewer.naochan.com/el/ |
---|
8 | ;; |
---|
9 | ;; Created: 06 Feb 2005 |
---|
10 | ;; Last modified: 15 Dec 2005 (defun --> defsubst) |
---|
11 | ;; Version: 1.0.1 |
---|
12 | ;; Keywords: char uchar short ushort long ulong cstring pstring bcd |
---|
13 | |
---|
14 | (provide 'nt-readval) |
---|
15 | |
---|
16 | ;;; Commentary: |
---|
17 | ;; this package enables you to read an integer value |
---|
18 | ;; such as (u)char,(u)short,(u)long, or a string value |
---|
19 | ;; such as C-string, Pascal-string, from the specified buffer. |
---|
20 | |
---|
21 | ;;; Code: |
---|
22 | ;;============================================================ |
---|
23 | ;; uchar - read unsigned char value (1-byte) from buffer |
---|
24 | ;; /// 1�Х��ȤΥǡ�����signed char ��Ȥ���ɤ� |
---|
25 | ;;============================================================ |
---|
26 | (defsubst nt:read-uchar (s &optional index) |
---|
27 | "1-byte string --> unsigned char" |
---|
28 | (catch 'uchar |
---|
29 | (if (not index) (setq index 0)) |
---|
30 | (if (or (< index 0) (<= (length s) index)) (throw 'uchar 'out-of-bounds-exception)) |
---|
31 | (aref s index) |
---|
32 | ) |
---|
33 | ) |
---|
34 | |
---|
35 | ;;=========================================================== |
---|
36 | ;; char - read (signed) char value (1-byte) from buffer |
---|
37 | ;; /// 1�Х��ȤΥǡ�����igned) char ��Ȥ���ɤ� |
---|
38 | ;;=========================================================== |
---|
39 | (defsubst nt:read-char (s &optional index) |
---|
40 | "1-byte string --> signed char" |
---|
41 | (catch 'char |
---|
42 | ; (let ((uc (uchar s index))) |
---|
43 | ; (if (eq uc 'out-of-bounds-exception) (throw 'char uc)) |
---|
44 | ; (if (< uc 128) uc (- uc 256)) |
---|
45 | ; ) ; let |
---|
46 | (let ((c 0)) |
---|
47 | (if (not index) (setq index 0)) |
---|
48 | (if (or (< index 0) (<= (length s) index)) (throw 'char 'out-of-bounds-exception)) |
---|
49 | (setq c (aref s index)) |
---|
50 | (if (< c 128) c (- c 256)) ; =result |
---|
51 | ); let |
---|
52 | ); caught |
---|
53 | ) |
---|
54 | |
---|
55 | ;;============================================================== |
---|
56 | ;; ushort - read unsigned short value (2-byte) from buffer |
---|
57 | ;; /// 2�Х��ȤΥǡ�����signed short ��Ȥ���ɤ� |
---|
58 | ;;============================================================== |
---|
59 | (defsubst nt:read-ushort (s &optional index) |
---|
60 | "2-byte string (little-endian) --> unsigned short" |
---|
61 | (catch 'ushort |
---|
62 | (if (not index) (setq index 0)) |
---|
63 | (if (or (< index 0) (< (- (length s) 2) index)) (throw 'ushort 'out-of-bounds-exception)) |
---|
64 | (+ (lsh (aref s (1+ index)) 8) |
---|
65 | (aref s index)) |
---|
66 | ) |
---|
67 | ) |
---|
68 | |
---|
69 | (defsubst nt:read-ushort-bigendian (s &optional index) |
---|
70 | "2-byte string (big-endian) --> unsigned short" |
---|
71 | (catch 'ushort |
---|
72 | (if (not index) (setq index 0)) |
---|
73 | (if (or (< index 0) (< (- (length s) 2) index)) (throw 'ushort 'out-of-bounds-exception)) |
---|
74 | (+ (lsh (aref s index) 8) |
---|
75 | (aref s (1+ index))) |
---|
76 | ) |
---|
77 | ) |
---|
78 | |
---|
79 | (defmacro nt:read-ushort-littleendian (s &optional index) |
---|
80 | "2-byte string (little-endian as default) --> unsigned short" |
---|
81 | `(nt:read-ushort ,s ,index)) |
---|
82 | |
---|
83 | ;;============================================================== |
---|
84 | ;; short - read (signed) short value (2-byte) from buffer |
---|
85 | ;; ///���Х��ȤΥǡ�����igned) short ��Ȥ���ɤ� |
---|
86 | ;;============================================================== |
---|
87 | (defsubst nt:read-short (s &optional index) |
---|
88 | "2-byte string (little-endian) --> signed short" |
---|
89 | (catch 'short |
---|
90 | (let ((us (nt:read-ushort s index))) |
---|
91 | (if (eq us 'out-of-bounds-exception) (throw 'short us)) |
---|
92 | (if (< us 32768) us (- us 65536)) |
---|
93 | ) ; let |
---|
94 | );caught |
---|
95 | ) |
---|
96 | |
---|
97 | (defsubst nt:read-short-bigendian (s &optional index) |
---|
98 | "2-byte string (big-endian) --> signed short" |
---|
99 | (catch 'short |
---|
100 | (let ((us (nt:read-ushort-bigendian s index))) |
---|
101 | (if (eq us 'out-of-bounds-exception) (throw 'short us)) |
---|
102 | (if (< us 32768) us (- us 65536)) |
---|
103 | ) ; let |
---|
104 | ) |
---|
105 | ) |
---|
106 | |
---|
107 | (defmacro nt:read-short-littleendian (s &optional index) |
---|
108 | "2-byte string (little-endian as default) --> signed short" |
---|
109 | `(nt:read-short ,s ,index)) |
---|
110 | |
---|
111 | ;;============================================================== |
---|
112 | ;; long - read (signed) long int value (4-byte) from buffer |
---|
113 | ;; # emacs-lisp treates less than 28-bit value |
---|
114 | ;; # -268435456 <= x <= 268435455 (2^28-1) |
---|
115 | ;; ///���Х��ȤΥǡ�����igned) long ��Ȥ���ɤ� |
---|
116 | ;; ///��elisp�Ǥ�8�ӥåȤ��������ʤ��Τ�� |
---|
117 | ;;============================================================== |
---|
118 | (defsubst nt:read-long (s &optional index) |
---|
119 | "4-byte string (little-endian) --> signed long |
---|
120 | -268435456 <= x <= 268435455 (2^28-1)" |
---|
121 | (catch 'long |
---|
122 | (if (not index) (setq index 0)) |
---|
123 | (if (or (< index 0) (< (- (length s) 4) index)) (throw 'long 'out-of-bounds-exception)) |
---|
124 | |
---|
125 | (let* ( |
---|
126 | (hh (aref s (+ index 3))) |
---|
127 | (h0 (lsh hh -4)) |
---|
128 | ) |
---|
129 | |
---|
130 | (cond ((zerop h0) nil) ; plus |
---|
131 | ((= h0 15) nil) ; minus |
---|
132 | ; (t (setq hh (logand 15 hh))) |
---|
133 | ((< h0 8) (throw 'long 'overflow-exception)) |
---|
134 | ((>= h0 8) (throw 'long 'underflow-exception)) |
---|
135 | ) |
---|
136 | ; (logior (lsh (aref s (+ index 3)) 24) |
---|
137 | (logior (lsh hh 24) |
---|
138 | (lsh (aref s (+ index 2)) 16) |
---|
139 | (lsh (aref s (1+ index)) 8) |
---|
140 | (aref s index)) |
---|
141 | ) |
---|
142 | ) |
---|
143 | ) |
---|
144 | |
---|
145 | (defsubst nt:read-long-bigendian (s &optional index) |
---|
146 | "4-byte string (big-endian) --> signed long |
---|
147 | -268435456 <= x <= 268435455 (2^28-1)" |
---|
148 | (catch 'long |
---|
149 | (if (not index) (setq index 0)) |
---|
150 | (if (or (< index 0) (< (- (length s) 4) index)) (throw 'long 'out-of-bounds-exception)) |
---|
151 | |
---|
152 | (let* ( |
---|
153 | (hh (aref s index)) |
---|
154 | (h0 (lsh hh -4)) |
---|
155 | ) |
---|
156 | |
---|
157 | (cond ((zerop h0) nil) ; plus |
---|
158 | ((= h0 15) nil) ; minus |
---|
159 | ; (t (setq hh (logand 15 hh))) |
---|
160 | ((< h0 8) (throw 'long 'overflow-exception)) |
---|
161 | ((>= h0 8) (throw 'long 'underflow-exception)) |
---|
162 | ) |
---|
163 | ; (logior (lsh (aref s (+ index 3)) 24) |
---|
164 | (logior (lsh hh 24) |
---|
165 | (lsh (aref s (1+ index)) 16) |
---|
166 | (lsh (aref s (+ index 2)) 8) |
---|
167 | (aref s (+ index 3))) |
---|
168 | ) |
---|
169 | ) |
---|
170 | ) |
---|
171 | |
---|
172 | (defmacro nt:read-long-littleendian (s &optional index) |
---|
173 | "4-byte string (little-endian as default) --> signed long" |
---|
174 | `(nt:read-long ,s ,index)) |
---|
175 | |
---|
176 | ;;============================================================== |
---|
177 | ;; ulong - read unsigned long int value (4-byte) from buffer |
---|
178 | ;; # emacs-lisp treates less than 28-bit value |
---|
179 | ;; # 0 <= x <= 268435455 (2^28-1) |
---|
180 | ;; ///���Х��ȤΥǡ�����signed long ��Ȥ���ɤ� |
---|
181 | ;; ///��elisp�Ǥ�8�ӥåȤ��������ʤ��Τ�� |
---|
182 | ;;============================================================== |
---|
183 | (defsubst nt:read-ulong (s &optional index) |
---|
184 | "4-byte string (little-endian) --> unsigned long |
---|
185 | 0 <= x <= 268435455 (2^28-1)" |
---|
186 | (catch 'ulong |
---|
187 | (if (not index) (setq index 0)) |
---|
188 | (if (or (< index 0) (< (- (length s) 4) index)) (throw 'ulong 'out-of-bounds-exception)) |
---|
189 | |
---|
190 | (let* ( |
---|
191 | (hh (aref s (+ index 3))) |
---|
192 | (h0 (lsh hh -4)) |
---|
193 | ) |
---|
194 | |
---|
195 | (cond ((zerop h0) nil) ; plus |
---|
196 | ; (t (setq hh (logand 15 hh))) |
---|
197 | (t (throw 'ulong 'overflow-exception))) |
---|
198 | ; (logior (lsh (aref s (+ index 3)) 24) |
---|
199 | (logior (lsh hh 24) |
---|
200 | (lsh (aref s (+ index 2)) 16) |
---|
201 | (lsh (aref s (1+ index)) 8) |
---|
202 | (aref s index)) |
---|
203 | ) |
---|
204 | ) |
---|
205 | |
---|
206 | ; (let ((sl (long s index))) |
---|
207 | ; (if (>= sl 0) sl 0) |
---|
208 | ; ) |
---|
209 | ) |
---|
210 | |
---|
211 | (defsubst nt:read-ulong-bigendian (s &optional index) |
---|
212 | "4-byte string (big-endian) --> unsigned long |
---|
213 | 0 <= x <= 268435455 (2^28-1)" |
---|
214 | (catch 'ulong |
---|
215 | (if (not index) (setq index 0)) |
---|
216 | (if (or (< index 0) (< (- (length s) 4) index)) (throw 'ulong 'out-of-bounds-exception)) |
---|
217 | |
---|
218 | (let* ( |
---|
219 | (hh (aref s index)) |
---|
220 | (h0 (lsh hh -4)) |
---|
221 | ) |
---|
222 | |
---|
223 | (cond ((zerop h0) nil) ; plus |
---|
224 | ; (t (setq hh (logand 15 hh))) |
---|
225 | (t (throw 'ulong 'overflow-exception))) |
---|
226 | ; (logior (lsh (aref s (+ index 3)) 24) |
---|
227 | (logior (lsh hh 24) |
---|
228 | (lsh (aref s (1+ index)) 16) |
---|
229 | (lsh (aref s (+ index 2)) 8) |
---|
230 | (aref s (+ index 3))) |
---|
231 | ) |
---|
232 | ) |
---|
233 | |
---|
234 | ; (let ((sl (long s index))) |
---|
235 | ; (if (>= sl 0) sl 0) |
---|
236 | ; ) |
---|
237 | ) |
---|
238 | |
---|
239 | (defmacro nt:read-ulong-littleendian (s &optional index) |
---|
240 | "4-byte string (little-endian as default) --> unsigned long" |
---|
241 | `(nt:read-ulong ,s ,index)) |
---|
242 | |
---|
243 | ;;============================================================== |
---|
244 | ;; cstring - read a C-string (NULL-terminated) from buffer |
---|
245 | ;; # ie. read the data until just before '\0' |
---|
246 | ;; ///�Хåե��������NULL��ü�ˤ�� |
---|
247 | ;;============================================================== |
---|
248 | (defsubst nt:read-cstring (s &optional index) |
---|
249 | "pick up a C-string. |
---|
250 | returns (string . length)" |
---|
251 | (catch 'cstring |
---|
252 | (if (not index) (setq index 0)) |
---|
253 | (if (or (< index 0) (>= index (length s))) (throw 'cstring 'out-of-bounds-exception)) |
---|
254 | (let ( (ofs 0) (ofs-max (- (length s) index)) ) |
---|
255 | ; (if (> ofs-max 248) (setq ofs-max 248)) |
---|
256 | (while (< ofs ofs-max) |
---|
257 | (if (zerop (aref s (+ index ofs))) |
---|
258 | (throw 'cstring (cons (substring s index (+ index ofs)) ofs) ) |
---|
259 | ) |
---|
260 | (setq ofs (1+ ofs)) |
---|
261 | ) |
---|
262 | (cons (substring s index nil) ofs-max) |
---|
263 | ) |
---|
264 | ) |
---|
265 | ) |
---|
266 | |
---|
267 | ;;============================================== |
---|
268 | ;; pstring - read a Pascal-string from buffer |
---|
269 | ;; ///�Хåե�����scalʸ����� |
---|
270 | ;;============================================== |
---|
271 | (defsubst nt:read-pstring (s &optional index) |
---|
272 | "pick up a Pascal-string. |
---|
273 | returns (string . length)" |
---|
274 | (catch 'pstring |
---|
275 | (if (not index) (setq index 0)) |
---|
276 | (if (or (< index 0) (>= index (length s))) (throw 'pstring 'out-of-bounds-exception)) |
---|
277 | (let ( (ofs 0) (ofs-max (- (length s) index)) |
---|
278 | (size (nt:read-uchar s index)) ) |
---|
279 | (if (> (1+ size) ofs-max) (throw 'pstring 'out-of-bounds-exception)) |
---|
280 | (throw 'pstring (cons (substring s (1+ index) (+ index 1 size)) size) ) |
---|
281 | ); let |
---|
282 | ); caught |
---|
283 | ) |
---|
284 | |
---|
285 | (defsubst nt:read-bcd (s ofs bytes) |
---|
286 | "read BCD value" |
---|
287 | (let ((i 0) (n 0) (c 0)) |
---|
288 | (while (< i bytes) |
---|
289 | (setq c (aref s (+ ofs i))) |
---|
290 | (setq n (+ (* n 100) (* (lsh c -4) 10) (logand c #x0f))) |
---|
291 | (setq i (1+ i)) ;; (++ i) |
---|
292 | );wend |
---|
293 | n |
---|
294 | );let |
---|
295 | ) |
---|
296 | |
---|
297 | ;;; nt-readval.el ends here |
---|