[67] | 1 | ;;; nt-readval.el --- read value or a string from buffer |
---|
| 2 | ;; |
---|
[71] | 3 | ;; Copyright (C) 2005-2009 naoya_t. All Rights Reserved. |
---|
[67] | 4 | ;; |
---|
[71] | 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 |
---|
[67] | 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)) |
---|
[71] | 32 | (aref s index))) |
---|
[67] | 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)) |
---|
[71] | 49 | (if (< c 128) c (- c 256))))) ; =result |
---|
[67] | 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) |
---|
[71] | 61 | (aref s index)))) |
---|
[67] | 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) |
---|
[71] | 69 | (aref s (1+ index))))) |
---|
[67] | 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)) |
---|
[71] | 84 | (if (< us 32768) us (- us 65536))))) |
---|
[67] | 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)) |
---|
[71] | 91 | (if (< us 32768) us (- us 65536))))) |
---|
[67] | 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 | |
---|
[71] | 111 | (let* ((hh (aref s (+ index 3))) |
---|
| 112 | (h0 (lsh hh -4))) |
---|
[67] | 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)) |
---|
[71] | 117 | ((>= h0 8) (throw 'long 'underflow-exception))) |
---|
[67] | 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) |
---|
[71] | 122 | (aref s index))))) |
---|
[67] | 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 | |
---|
[71] | 131 | (let* ((hh (aref s index)) |
---|
| 132 | (h0 (lsh hh -4))) |
---|
[67] | 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)) |
---|
[71] | 137 | ((>= h0 8) (throw 'long 'underflow-exception))) |
---|
[67] | 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) |
---|
[71] | 142 | (aref s (+ index 3)))))) |
---|
[67] | 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 |
---|
| 157 | 0 <= 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 | |
---|
[71] | 162 | (let* ((hh (aref s (+ index 3))) |
---|
| 163 | (h0 (lsh hh -4))) |
---|
[67] | 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) |
---|
[71] | 171 | (aref s index))))) |
---|
[67] | 172 | |
---|
| 173 | (defsubst nt:read-ulong-bigendian (s &optional index) |
---|
| 174 | "4-byte string (big-endian) --> unsigned long |
---|
| 175 | 0 <= 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 | |
---|
[71] | 180 | (let* ((hh (aref s index)) |
---|
| 181 | (h0 (lsh hh -4))) |
---|
[67] | 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) |
---|
[71] | 189 | (aref s (+ index 3)))))) |
---|
[67] | 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. |
---|
| 202 | returns (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) |
---|
[71] | 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)))) |
---|
[67] | 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. |
---|
| 220 | returns (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)) |
---|
[71] | 227 | (throw 'pstring (cons (substring s (1+ index) (+ index 1 size)) size) )))) |
---|
[67] | 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))) |
---|
[71] | 235 | (setq i (1+ i))) ;; (++ i) |
---|
| 236 | n)) |
---|
[67] | 237 | |
---|
| 238 | ;;; nt-readval.el ends here |
---|