Mercurial > emacs
annotate lisp/emacs-lisp/bindat.el @ 107168:282ddc0ca465
* simple.el (save-interprogram-paste-before-kill): Doc fix.
author | Chong Yidong <cyd@stupidchicken.com> |
---|---|
date | Tue, 16 Feb 2010 09:40:45 -0500 |
parents | 1d1d5d9bd884 |
children | 376148b31b5e |
rev | line source |
---|---|
46122 | 1 ;;; bindat.el --- binary data structure packing and unpacking. |
2 | |
106815 | 3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
46122 | 4 |
5 ;; Author: Kim F. Storm <storm@cua.dk> | |
6 ;; Assignment name: struct.el | |
7 ;; Keywords: comm data processes | |
8 | |
9 ;; This file is part of GNU Emacs. | |
10 | |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
46122 | 12 ;; it under the terms of the GNU General Public License as published by |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
14 ;; (at your option) any later version. |
46122 | 15 |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
94655
90a2847062be
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
93975
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
46122 | 23 |
24 ;;; Commentary: | |
25 | |
26 ;; Packing and unpacking of (binary) data structures. | |
27 ;; | |
28 ;; The data formats used in binary files and network protocols are | |
29 ;; often structed data which can be described by a C-style structure | |
30 ;; such as the one shown below. Using the bindat package, decoding | |
31 ;; and encoding binary data formats like these is made simple using a | |
32 ;; structure specification which closely resembles the C style | |
33 ;; structure declarations. | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
34 ;; |
46122 | 35 ;; Encoded (binary) data is stored in a unibyte string or vector, |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
36 ;; while the decoded data is stored in an alist with (FIELD . VALUE) |
46122 | 37 ;; pairs. |
38 | |
39 ;; Example: | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
40 |
46122 | 41 ;; Consider the following C structures: |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
42 ;; |
46122 | 43 ;; struct header { |
44 ;; unsigned long dest_ip; | |
45 ;; unsigned long src_ip; | |
46 ;; unsigned short dest_port; | |
47 ;; unsigned short src_port; | |
48 ;; }; | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
49 ;; |
46122 | 50 ;; struct data { |
51 ;; unsigned char type; | |
52 ;; unsigned char opcode; | |
53 ;; unsigned long length; /* In little endian order */ | |
54 ;; unsigned char id[8]; /* nul-terminated string */ | |
55 ;; unsigned char data[/* (length + 3) & ~3 */]; | |
56 ;; }; | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
57 ;; |
46122 | 58 ;; struct packet { |
59 ;; struct header header; | |
60 ;; unsigned char items; | |
61 ;; unsigned char filler[3]; | |
62 ;; struct data item[/* items */]; | |
63 ;; }; | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
64 ;; |
46122 | 65 ;; The corresponding Lisp bindat specification looks like this: |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
66 ;; |
72719
8c9ac6f51916
(bindat-unpack): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72357
diff
changeset
|
67 ;; (setq header-bindat-spec |
46122 | 68 ;; '((dest-ip ip) |
69 ;; (src-ip ip) | |
70 ;; (dest-port u16) | |
71 ;; (src-port u16))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
72 ;; |
72719
8c9ac6f51916
(bindat-unpack): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72357
diff
changeset
|
73 ;; (setq data-bindat-spec |
46122 | 74 ;; '((type u8) |
75 ;; (opcode u8) | |
76 ;; (length u16r) ;; little endian order | |
77 ;; (id strz 8) | |
78 ;; (data vec (length)) | |
79 ;; (align 4))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
80 ;; |
72719
8c9ac6f51916
(bindat-unpack): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72357
diff
changeset
|
81 ;; (setq packet-bindat-spec |
8c9ac6f51916
(bindat-unpack): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72357
diff
changeset
|
82 ;; '((header struct header-bindat-spec) |
46122 | 83 ;; (items u8) |
84 ;; (fill 3) | |
85 ;; (item repeat (items) | |
72719
8c9ac6f51916
(bindat-unpack): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72357
diff
changeset
|
86 ;; (struct data-bindat-spec)))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
87 ;; |
46122 | 88 ;; |
89 ;; A binary data representation may look like | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
90 ;; [ 192 168 1 100 192 168 1 101 01 28 21 32 2 0 0 0 |
46122 | 91 ;; 2 3 5 0 ?A ?B ?C ?D ?E ?F 0 0 1 2 3 4 5 0 0 0 |
92 ;; 1 4 7 0 ?B ?C ?D ?E ?F ?G 0 0 6 7 8 9 10 11 12 0 ] | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
93 ;; |
46122 | 94 ;; The corresponding decoded structure looks like |
95 ;; | |
96 ;; ((header | |
97 ;; (dest-ip . [192 168 1 100]) | |
98 ;; (src-ip . [192 168 1 101]) | |
99 ;; (dest-port . 284) | |
100 ;; (src-port . 5408)) | |
101 ;; (items . 2) | |
102 ;; (item ((data . [1 2 3 4 5]) | |
103 ;; (id . "ABCDEF") | |
104 ;; (length . 5) | |
105 ;; (opcode . 3) | |
106 ;; (type . 2)) | |
107 ;; ((data . [6 7 8 9 10 11 12]) | |
108 ;; (id . "BCDEFG") | |
109 ;; (length . 7) | |
110 ;; (opcode . 4) | |
111 ;; (type . 1)))) | |
112 ;; | |
113 ;; To access a specific value in this structure, use the function | |
114 ;; bindat-get-field with the structure as first arg followed by a list | |
115 ;; of field names and array indexes, e.g. using the data above, | |
116 ;; (bindat-get-field decoded-structure 'item 1 'id) | |
117 ;; returns "BCDEFG". | |
118 | |
119 ;; Binary Data Structure Specification Format | |
120 ;; ------------------------------------------ | |
121 | |
72719
8c9ac6f51916
(bindat-unpack): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72357
diff
changeset
|
122 ;; We recommend using names that end in `-bindat-spec'; such names |
8c9ac6f51916
(bindat-unpack): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72357
diff
changeset
|
123 ;; are recognized automatically as "risky" variables. |
8c9ac6f51916
(bindat-unpack): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72357
diff
changeset
|
124 |
46122 | 125 ;; The data specification is formatted as follows: |
126 | |
127 ;; SPEC ::= ( ITEM... ) | |
128 | |
129 ;; ITEM ::= ( [FIELD] TYPE ) | |
130 ;; | ( [FIELD] eval FORM ) -- eval FORM for side-effect only | |
131 ;; | ( [FIELD] fill LEN ) -- skip LEN bytes | |
132 ;; | ( [FIELD] align LEN ) -- skip to next multiple of LEN bytes | |
133 ;; | ( [FIELD] struct SPEC_NAME ) | |
134 ;; | ( [FIELD] union TAG_VAL (TAG SPEC)... [(t SPEC)] ) | |
63331
3fc0c472c166
Fix `repeat' BNF and `bits 2' example in Commentary.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
135 ;; | ( [FIELD] repeat COUNT ITEM... ) |
46122 | 136 |
137 ;; -- In (eval EXPR), the value of the last field is available in | |
138 ;; the dynamically bound variable `last'. | |
139 | |
140 ;; TYPE ::= ( eval EXPR ) -- interpret result as TYPE | |
141 ;; | u8 | byte -- length 1 | |
142 ;; | u16 | word | short -- length 2, network byte order | |
143 ;; | u24 -- 3-byte value | |
144 ;; | u32 | dword | long -- length 4, network byte order | |
145 ;; | u16r | u24r | u32r -- little endian byte order. | |
146 ;; | str LEN -- LEN byte string | |
147 ;; | strz LEN -- LEN byte (zero-terminated) string | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
148 ;; | vec LEN [TYPE] -- vector of LEN items of TYPE (default: u8) |
46122 | 149 ;; | ip -- 4 byte vector |
150 ;; | bits LEN -- List with bits set in LEN bytes. | |
151 ;; | |
152 ;; -- Note: 32 bit values may be limited by emacs' INTEGER | |
153 ;; implementation limits. | |
154 ;; | |
63331
3fc0c472c166
Fix `repeat' BNF and `bits 2' example in Commentary.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
155 ;; -- Example: `bits 2' will unpack 0x28 0x1c to (2 3 4 11 13) |
3fc0c472c166
Fix `repeat' BNF and `bits 2' example in Commentary.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52401
diff
changeset
|
156 ;; and 0x1c 0x28 to (3 5 10 11 12). |
46122 | 157 |
158 ;; FIELD ::= ( eval EXPR ) -- use result as NAME | |
159 ;; | NAME | |
160 | |
161 ;; LEN ::= ARG | |
162 ;; | <omitted> | nil -- LEN = 1 | |
163 | |
164 | |
165 ;; TAG_VAL ::= ARG | |
166 | |
167 ;; TAG ::= LISP_CONSTANT | |
168 ;; | ( eval EXPR ) -- return non-nil if tag match; | |
169 ;; current TAG_VAL in `tag'. | |
170 | |
171 ;; ARG ::= ( eval EXPR ) -- interpret result as ARG | |
172 ;; | INTEGER_CONSTANT | |
173 ;; | DEREF | |
174 | |
70853 | 175 ;; DEREF ::= ( [NAME | INTEGER]... ) -- Field NAME or Array index relative |
176 ;; to current structure spec. | |
46122 | 177 ;; -- see bindat-get-field |
178 | |
179 ;; A `union' specification | |
180 ;; ([FIELD] union TAG_VAL (TAG SPEC) ... [(t SPEC)]) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
181 ;; is interpreted by evalling TAG_VAL and then comparing that to |
46122 | 182 ;; each TAG using equal; if a match is found, the corresponding SPEC |
183 ;; is used. | |
184 ;; If TAG is a form (eval EXPR), EXPR is evalled with `tag' bound to the | |
185 ;; value of TAG_VAL; the corresponding SPEC is used if the result is non-nil. | |
186 ;; Finally, if TAG is t, the corresponding SPEC is used unconditionally. | |
187 ;; | |
188 ;; An `eval' specification | |
189 ;; ([FIELD] eval FORM) | |
190 ;; is interpreted by evalling FORM for its side effects only. | |
191 ;; If FIELD is specified, the value is bound to that field. | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
192 ;; The FORM may access and update `bindat-raw' and `bindat-idx' (see `bindat-unpack'). |
46122 | 193 |
194 ;;; Code: | |
195 | |
196 ;; Helper functions for structure unpacking. | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
197 ;; Relies on dynamic binding of BINDAT-RAW and BINDAT-IDX |
46122 | 198 |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
199 (defvar bindat-raw) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
200 (defvar bindat-idx) |
46122 | 201 |
202 (defun bindat--unpack-u8 () | |
203 (prog1 | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
204 (aref bindat-raw bindat-idx) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
205 (setq bindat-idx (1+ bindat-idx)))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
206 |
46122 | 207 (defun bindat--unpack-u16 () |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
208 (logior (lsh (bindat--unpack-u8) 8) (bindat--unpack-u8))) |
46122 | 209 |
210 (defun bindat--unpack-u24 () | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
211 (logior (lsh (bindat--unpack-u16) 8) (bindat--unpack-u8))) |
46122 | 212 |
213 (defun bindat--unpack-u32 () | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
214 (logior (lsh (bindat--unpack-u16) 16) (bindat--unpack-u16))) |
46122 | 215 |
216 (defun bindat--unpack-u16r () | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
217 (logior (bindat--unpack-u8) (lsh (bindat--unpack-u8) 8))) |
46122 | 218 |
219 (defun bindat--unpack-u24r () | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
220 (logior (bindat--unpack-u16r) (lsh (bindat--unpack-u8) 16))) |
46122 | 221 |
222 (defun bindat--unpack-u32r () | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
223 (logior (bindat--unpack-u16r) (lsh (bindat--unpack-u16r) 16))) |
46122 | 224 |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
225 (defun bindat--unpack-item (type len &optional vectype) |
46122 | 226 (if (eq type 'ip) |
227 (setq type 'vec len 4)) | |
228 (cond | |
229 ((memq type '(u8 byte)) | |
230 (bindat--unpack-u8)) | |
231 ((memq type '(u16 word short)) | |
232 (bindat--unpack-u16)) | |
233 ((eq type 'u24) | |
234 (bindat--unpack-u24)) | |
235 ((memq type '(u32 dword long)) | |
236 (bindat--unpack-u32)) | |
237 ((eq type 'u16r) | |
238 (bindat--unpack-u16r)) | |
239 ((eq type 'u24r) | |
240 (bindat--unpack-u24r)) | |
241 ((eq type 'u32r) | |
242 (bindat--unpack-u32r)) | |
243 ((eq type 'bits) | |
244 (let ((bits nil) (bnum (1- (* 8 len))) j m) | |
245 (while (>= bnum 0) | |
246 (if (= (setq m (bindat--unpack-u8)) 0) | |
247 (setq bnum (- bnum 8)) | |
248 (setq j 128) | |
249 (while (> j 0) | |
250 (if (/= 0 (logand m j)) | |
251 (setq bits (cons bnum bits))) | |
252 (setq bnum (1- bnum) | |
253 j (lsh j -1))))) | |
254 bits)) | |
255 ((eq type 'str) | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
256 (let ((s (substring bindat-raw bindat-idx (+ bindat-idx len)))) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
257 (setq bindat-idx (+ bindat-idx len)) |
46122 | 258 (if (stringp s) s |
259 (string-make-unibyte (concat s))))) | |
260 ((eq type 'strz) | |
261 (let ((i 0) s) | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
262 (while (and (< i len) (/= (aref bindat-raw (+ bindat-idx i)) 0)) |
46122 | 263 (setq i (1+ i))) |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
264 (setq s (substring bindat-raw bindat-idx (+ bindat-idx i))) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
265 (setq bindat-idx (+ bindat-idx len)) |
46122 | 266 (if (stringp s) s |
267 (string-make-unibyte (concat s))))) | |
268 ((eq type 'vec) | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
269 (let ((v (make-vector len 0)) (i 0) (vlen 1)) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
270 (if (consp vectype) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
271 (setq vlen (nth 1 vectype) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
272 vectype (nth 2 vectype)) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
273 (setq type (or vectype 'u8) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
274 vectype nil)) |
46122 | 275 (while (< i len) |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
276 (aset v i (bindat--unpack-item type vlen vectype)) |
46122 | 277 (setq i (1+ i))) |
278 v)) | |
279 (t nil))) | |
280 | |
281 (defun bindat--unpack-group (spec) | |
282 (let (struct last) | |
283 (while spec | |
284 (let* ((item (car spec)) | |
285 (field (car item)) | |
286 (type (nth 1 item)) | |
287 (len (nth 2 item)) | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
288 (vectype (and (eq type 'vec) (nth 3 item))) |
46122 | 289 (tail 3) |
290 data) | |
291 (setq spec (cdr spec)) | |
292 (if (and (consp field) (eq (car field) 'eval)) | |
293 (setq field (eval (car (cdr field))))) | |
294 (if (and type (consp type) (eq (car type) 'eval)) | |
295 (setq type (eval (car (cdr type))))) | |
296 (if (and len (consp len) (eq (car len) 'eval)) | |
297 (setq len (eval (car (cdr len))))) | |
298 (if (memq field '(eval fill align struct union)) | |
299 (setq tail 2 | |
300 len type | |
301 type field | |
302 field nil)) | |
303 (if (and (consp len) (not (eq type 'eval))) | |
304 (setq len (apply 'bindat-get-field struct len))) | |
305 (if (not len) | |
306 (setq len 1)) | |
307 (cond | |
308 ((eq type 'eval) | |
309 (if field | |
310 (setq data (eval len)) | |
311 (eval len))) | |
312 ((eq type 'fill) | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
313 (setq bindat-idx (+ bindat-idx len))) |
46122 | 314 ((eq type 'align) |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
315 (while (/= (% bindat-idx len) 0) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
316 (setq bindat-idx (1+ bindat-idx)))) |
46122 | 317 ((eq type 'struct) |
318 (setq data (bindat--unpack-group (eval len)))) | |
319 ((eq type 'repeat) | |
74954
29289b6efd81
(bindat--unpack-group, bindat--length-group)
Kim F. Storm <storm@cua.dk>
parents:
72719
diff
changeset
|
320 (let ((index 0) (count len)) |
29289b6efd81
(bindat--unpack-group, bindat--length-group)
Kim F. Storm <storm@cua.dk>
parents:
72719
diff
changeset
|
321 (while (< index count) |
46122 | 322 (setq data (cons (bindat--unpack-group (nthcdr tail item)) data)) |
323 (setq index (1+ index))) | |
324 (setq data (nreverse data)))) | |
325 ((eq type 'union) | |
326 (let ((tag len) (cases (nthcdr tail item)) case cc) | |
327 (while cases | |
328 (setq case (car cases) | |
329 cases (cdr cases) | |
330 cc (car case)) | |
331 (if (or (equal cc tag) (equal cc t) | |
332 (and (consp cc) (eval cc))) | |
333 (setq data (bindat--unpack-group (cdr case)) | |
334 cases nil))))) | |
335 (t | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
336 (setq data (bindat--unpack-item type len vectype) |
46122 | 337 last data))) |
338 (if data | |
339 (if field | |
340 (setq struct (cons (cons field data) struct)) | |
341 (setq struct (append data struct)))))) | |
342 struct)) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
343 |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
344 (defun bindat-unpack (spec bindat-raw &optional bindat-idx) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
345 "Return structured data according to SPEC for binary data in BINDAT-RAW. |
72719
8c9ac6f51916
(bindat-unpack): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72357
diff
changeset
|
346 BINDAT-RAW is a unibyte string or vector. |
8c9ac6f51916
(bindat-unpack): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
72357
diff
changeset
|
347 Optional third arg BINDAT-IDX specifies the starting offset in BINDAT-RAW." |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
348 (when (multibyte-string-p bindat-raw) |
70906
6d78b8af6fc8
(bindat-unpack, bindat-pack):
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
70858
diff
changeset
|
349 (error "String is multibyte")) |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
350 (unless bindat-idx (setq bindat-idx 0)) |
46122 | 351 (bindat--unpack-group spec)) |
352 | |
353 (defun bindat-get-field (struct &rest field) | |
354 "In structured data STRUCT, return value of field named FIELD. | |
355 If multiple field names are specified, use the field names to | |
356 lookup nested sub-structures in STRUCT, corresponding to the | |
357 C-language syntax STRUCT.FIELD1.FIELD2.FIELD3... | |
358 An integer value in the field list is taken as an array index, | |
359 e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..." | |
360 (while (and struct field) | |
361 (setq struct (if (integerp (car field)) | |
362 (nth (car field) struct) | |
363 (let ((val (assq (car field) struct))) | |
364 (if (consp val) (cdr val))))) | |
365 (setq field (cdr field))) | |
366 struct) | |
367 | |
368 | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
369 ;; Calculate bindat-raw length of structured data |
46122 | 370 |
371 (defvar bindat--fixed-length-alist | |
372 '((u8 . 1) (byte . 1) | |
373 (u16 . 2) (u16r . 2) (word . 2) (short . 2) | |
374 (u24 . 3) (u24r . 3) | |
375 (u32 . 4) (u32r . 4) (dword . 4) (long . 4) | |
376 (ip . 4))) | |
377 | |
378 (defun bindat--length-group (struct spec) | |
379 (let (last) | |
380 (while spec | |
381 (let* ((item (car spec)) | |
382 (field (car item)) | |
383 (type (nth 1 item)) | |
384 (len (nth 2 item)) | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
385 (vectype (and (eq type 'vec) (nth 3 item))) |
46122 | 386 (tail 3)) |
387 (setq spec (cdr spec)) | |
388 (if (and (consp field) (eq (car field) 'eval)) | |
389 (setq field (eval (car (cdr field))))) | |
390 (if (and type (consp type) (eq (car type) 'eval)) | |
391 (setq type (eval (car (cdr type))))) | |
392 (if (and len (consp len) (eq (car len) 'eval)) | |
393 (setq len (eval (car (cdr len))))) | |
394 (if (memq field '(eval fill align struct union)) | |
395 (setq tail 2 | |
396 len type | |
397 type field | |
398 field nil)) | |
399 (if (and (consp len) (not (eq type 'eval))) | |
400 (setq len (apply 'bindat-get-field struct len))) | |
401 (if (not len) | |
402 (setq len 1)) | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
403 (while (eq type 'vec) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
404 (let ((vlen 1)) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
405 (if (consp vectype) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
406 (setq len (* len (nth 1 vectype)) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
407 type (nth 2 vectype)) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
408 (setq type (or vectype 'u8) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
409 vectype nil)))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
410 (cond |
46122 | 411 ((eq type 'eval) |
412 (if field | |
413 (setq struct (cons (cons field (eval len)) struct)) | |
414 (eval len))) | |
415 ((eq type 'fill) | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
416 (setq bindat-idx (+ bindat-idx len))) |
46122 | 417 ((eq type 'align) |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
418 (while (/= (% bindat-idx len) 0) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
419 (setq bindat-idx (1+ bindat-idx)))) |
46122 | 420 ((eq type 'struct) |
421 (bindat--length-group | |
422 (if field (bindat-get-field struct field) struct) (eval len))) | |
423 ((eq type 'repeat) | |
74954
29289b6efd81
(bindat--unpack-group, bindat--length-group)
Kim F. Storm <storm@cua.dk>
parents:
72719
diff
changeset
|
424 (let ((index 0) (count len)) |
29289b6efd81
(bindat--unpack-group, bindat--length-group)
Kim F. Storm <storm@cua.dk>
parents:
72719
diff
changeset
|
425 (while (< index count) |
70853 | 426 (bindat--length-group |
427 (nth index (bindat-get-field struct field)) | |
428 (nthcdr tail item)) | |
46122 | 429 (setq index (1+ index))))) |
430 ((eq type 'union) | |
431 (let ((tag len) (cases (nthcdr tail item)) case cc) | |
432 (while cases | |
433 (setq case (car cases) | |
434 cases (cdr cases) | |
435 cc (car case)) | |
436 (if (or (equal cc tag) (equal cc t) | |
437 (and (consp cc) (eval cc))) | |
438 (progn | |
439 (bindat--length-group struct (cdr case)) | |
440 (setq cases nil)))))) | |
441 (t | |
442 (if (setq type (assq type bindat--fixed-length-alist)) | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
443 (setq len (* len (cdr type)))) |
46122 | 444 (if field |
445 (setq last (bindat-get-field struct field))) | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
446 (setq bindat-idx (+ bindat-idx len)))))))) |
46122 | 447 |
448 (defun bindat-length (spec struct) | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
449 "Calculate bindat-raw length for STRUCT according to bindat SPEC." |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
450 (let ((bindat-idx 0)) |
46122 | 451 (bindat--length-group struct spec) |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
452 bindat-idx)) |
46122 | 453 |
454 | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
455 ;; Pack structured data into bindat-raw |
46122 | 456 |
457 (defun bindat--pack-u8 (v) | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
458 (aset bindat-raw bindat-idx (logand v 255)) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
459 (setq bindat-idx (1+ bindat-idx))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
460 |
46122 | 461 (defun bindat--pack-u16 (v) |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
462 (aset bindat-raw bindat-idx (logand (lsh v -8) 255)) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
463 (aset bindat-raw (1+ bindat-idx) (logand v 255)) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
464 (setq bindat-idx (+ bindat-idx 2))) |
46122 | 465 |
466 (defun bindat--pack-u24 (v) | |
467 (bindat--pack-u8 (lsh v -16)) | |
468 (bindat--pack-u16 v)) | |
469 | |
470 (defun bindat--pack-u32 (v) | |
471 (bindat--pack-u16 (lsh v -16)) | |
472 (bindat--pack-u16 v)) | |
473 | |
474 (defun bindat--pack-u16r (v) | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
475 (aset bindat-raw (1+ bindat-idx) (logand (lsh v -8) 255)) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
476 (aset bindat-raw bindat-idx (logand v 255)) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
477 (setq bindat-idx (+ bindat-idx 2))) |
46122 | 478 |
479 (defun bindat--pack-u24r (v) | |
480 (bindat--pack-u16r v) | |
481 (bindat--pack-u8 (lsh v -16))) | |
482 | |
483 (defun bindat--pack-u32r (v) | |
484 (bindat--pack-u16r v) | |
485 (bindat--pack-u16r (lsh v -16))) | |
486 | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
487 (defun bindat--pack-item (v type len &optional vectype) |
46122 | 488 (if (eq type 'ip) |
489 (setq type 'vec len 4)) | |
490 (cond | |
491 ((null v) | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
492 (setq bindat-idx (+ bindat-idx len))) |
46122 | 493 ((memq type '(u8 byte)) |
494 (bindat--pack-u8 v)) | |
495 ((memq type '(u16 word short)) | |
496 (bindat--pack-u16 v)) | |
497 ((eq type 'u24) | |
498 (bindat--pack-u24 v)) | |
499 ((memq type '(u32 dword long)) | |
500 (bindat--pack-u32 v)) | |
501 ((eq type 'u16r) | |
502 (bindat--pack-u16r v)) | |
503 ((eq type 'u24r) | |
504 (bindat--pack-u24r v)) | |
505 ((eq type 'u32r) | |
506 (bindat--pack-u32r v)) | |
507 ((eq type 'bits) | |
508 (let ((bnum (1- (* 8 len))) j m) | |
509 (while (>= bnum 0) | |
510 (setq m 0) | |
511 (if (null v) | |
512 (setq bnum (- bnum 8)) | |
513 (setq j 128) | |
514 (while (> j 0) | |
515 (if (memq bnum v) | |
516 (setq m (logior m j))) | |
517 (setq bnum (1- bnum) | |
518 j (lsh j -1)))) | |
519 (bindat--pack-u8 m)))) | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
520 ((memq type '(str strz)) |
46122 | 521 (let ((l (length v)) (i 0)) |
522 (if (> l len) (setq l len)) | |
523 (while (< i l) | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
524 (aset bindat-raw (+ bindat-idx i) (aref v i)) |
46122 | 525 (setq i (1+ i))) |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
526 (setq bindat-idx (+ bindat-idx len)))) |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
527 ((eq type 'vec) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
528 (let ((l (length v)) (i 0) (vlen 1)) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
529 (if (consp vectype) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
530 (setq vlen (nth 1 vectype) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
531 vectype (nth 2 vectype)) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
532 (setq type (or vectype 'u8) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
533 vectype nil)) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
534 (if (> l len) (setq l len)) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
535 (while (< i l) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
536 (bindat--pack-item (aref v i) type vlen vectype) |
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
537 (setq i (1+ i))))) |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
538 (t |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
539 (setq bindat-idx (+ bindat-idx len))))) |
46122 | 540 |
541 (defun bindat--pack-group (struct spec) | |
542 (let (last) | |
543 (while spec | |
544 (let* ((item (car spec)) | |
545 (field (car item)) | |
546 (type (nth 1 item)) | |
547 (len (nth 2 item)) | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
548 (vectype (and (eq type 'vec) (nth 3 item))) |
46122 | 549 (tail 3)) |
550 (setq spec (cdr spec)) | |
551 (if (and (consp field) (eq (car field) 'eval)) | |
552 (setq field (eval (car (cdr field))))) | |
553 (if (and type (consp type) (eq (car type) 'eval)) | |
554 (setq type (eval (car (cdr type))))) | |
555 (if (and len (consp len) (eq (car len) 'eval)) | |
556 (setq len (eval (car (cdr len))))) | |
557 (if (memq field '(eval fill align struct union)) | |
558 (setq tail 2 | |
559 len type | |
560 type field | |
561 field nil)) | |
562 (if (and (consp len) (not (eq type 'eval))) | |
563 (setq len (apply 'bindat-get-field struct len))) | |
564 (if (not len) | |
565 (setq len 1)) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
566 (cond |
46122 | 567 ((eq type 'eval) |
568 (if field | |
569 (setq struct (cons (cons field (eval len)) struct)) | |
570 (eval len))) | |
571 ((eq type 'fill) | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
572 (setq bindat-idx (+ bindat-idx len))) |
46122 | 573 ((eq type 'align) |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
574 (while (/= (% bindat-idx len) 0) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
575 (setq bindat-idx (1+ bindat-idx)))) |
46122 | 576 ((eq type 'struct) |
577 (bindat--pack-group | |
578 (if field (bindat-get-field struct field) struct) (eval len))) | |
579 ((eq type 'repeat) | |
74954
29289b6efd81
(bindat--unpack-group, bindat--length-group)
Kim F. Storm <storm@cua.dk>
parents:
72719
diff
changeset
|
580 (let ((index 0) (count len)) |
29289b6efd81
(bindat--unpack-group, bindat--length-group)
Kim F. Storm <storm@cua.dk>
parents:
72719
diff
changeset
|
581 (while (< index count) |
70853 | 582 (bindat--pack-group |
583 (nth index (bindat-get-field struct field)) | |
584 (nthcdr tail item)) | |
46122 | 585 (setq index (1+ index))))) |
586 ((eq type 'union) | |
587 (let ((tag len) (cases (nthcdr tail item)) case cc) | |
588 (while cases | |
589 (setq case (car cases) | |
590 cases (cdr cases) | |
591 cc (car case)) | |
592 (if (or (equal cc tag) (equal cc t) | |
593 (and (consp cc) (eval cc))) | |
594 (progn | |
595 (bindat--pack-group struct (cdr case)) | |
596 (setq cases nil)))))) | |
597 (t | |
598 (setq last (bindat-get-field struct field)) | |
75994
1879f509b310
(bindat--unpack-u*): Optimize.
Kim F. Storm <storm@cua.dk>
parents:
75346
diff
changeset
|
599 (bindat--pack-item last type len vectype) |
46122 | 600 )))))) |
601 | |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
602 (defun bindat-pack (spec struct &optional bindat-raw bindat-idx) |
48031 | 603 "Return binary data packed according to SPEC for structured data STRUCT. |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
604 Optional third arg BINDAT-RAW is a pre-allocated unibyte string or vector to |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
605 pack into. |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
606 Optional fourth arg BINDAT-IDX is the starting offset into BINDAT-RAW." |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
607 (when (multibyte-string-p bindat-raw) |
70906
6d78b8af6fc8
(bindat-unpack, bindat-pack):
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
70858
diff
changeset
|
608 (error "Pre-allocated string is multibyte")) |
71033
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
609 (let ((no-return bindat-raw)) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
610 (unless bindat-idx (setq bindat-idx 0)) |
b2dddb50f233
(bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents:
71032
diff
changeset
|
611 (unless bindat-raw |
103142
5799cf56cf25
* emacs-lisp/bindat.el (bindat-pack): Allocate and set a string
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
612 (setq bindat-raw (make-string (+ bindat-idx (bindat-length spec struct)) 0))) |
46122 | 613 (bindat--pack-group struct spec) |
103142
5799cf56cf25
* emacs-lisp/bindat.el (bindat-pack): Allocate and set a string
Chong Yidong <cyd@stupidchicken.com>
parents:
100908
diff
changeset
|
614 (if no-return nil bindat-raw))) |
46122 | 615 |
616 | |
617 ;; Misc. format conversions | |
618 | |
619 (defun bindat-format-vector (vect fmt sep &optional len) | |
620 "Format vector VECT using element format FMT and separator SEP. | |
621 Result is a string with each element of VECT formatted using FMT and | |
622 separated by the string SEP. If optional fourth arg LEN is given, use | |
623 only that many elements from VECT." | |
624 (unless len | |
625 (setq len (length vect))) | |
626 (let ((i len) (fmt2 (concat sep fmt)) (s nil)) | |
627 (while (> i 0) | |
628 (setq i (1- i) | |
629 s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s))) | |
630 (apply 'concat s))) | |
49598
0d8b17d428b5
Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
48031
diff
changeset
|
631 |
46122 | 632 (defun bindat-vector-to-dec (vect &optional sep) |
633 "Format vector VECT in decimal format separated by dots. | |
634 If optional second arg SEP is a string, use that as separator." | |
635 (bindat-format-vector vect "%d" (if (stringp sep) sep "."))) | |
636 | |
637 (defun bindat-vector-to-hex (vect &optional sep) | |
638 "Format vector VECT in hex format separated by dots. | |
639 If optional second arg SEP is a string, use that as separator." | |
640 (bindat-format-vector vect "%02x" (if (stringp sep) sep ":"))) | |
641 | |
642 (defun bindat-ip-to-string (ip) | |
72357
805ccb94d5d6
(bindat-ip-to-string): Use `format-network-address' if possible.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
71033
diff
changeset
|
643 "Format vector IP as an ip address in dotted notation. |
805ccb94d5d6
(bindat-ip-to-string): Use `format-network-address' if possible.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
71033
diff
changeset
|
644 The port (if any) is omitted. IP can be a string, as well." |
805ccb94d5d6
(bindat-ip-to-string): Use `format-network-address' if possible.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
71033
diff
changeset
|
645 (if (vectorp ip) |
805ccb94d5d6
(bindat-ip-to-string): Use `format-network-address' if possible.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
71033
diff
changeset
|
646 (format-network-address ip t) |
805ccb94d5d6
(bindat-ip-to-string): Use `format-network-address' if possible.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
71033
diff
changeset
|
647 (format "%d.%d.%d.%d" |
805ccb94d5d6
(bindat-ip-to-string): Use `format-network-address' if possible.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
71033
diff
changeset
|
648 (aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3)))) |
46122 | 649 |
650 (provide 'bindat) | |
651 | |
93975
1e3a407766b9
Fix up comment convention on the arch-tag lines.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
79704
diff
changeset
|
652 ;; arch-tag: 5e6708c3-03e2-4ad7-9885-5041b779c3fb |
46122 | 653 ;;; bindat.el ends here |