[67] | 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 |
---|