root/lang/elisp/pdicv-mode/trunk/nt-readval.el

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