annotate lisp/emacs-lisp/bindat.el @ 95263:e0eb4e6f3741

*** empty log message ***
author Kenichi Handa <handa@m17n.org>
date Fri, 23 May 2008 12:53:22 +0000
parents 90a2847062be
children a9dc0e7c3f2b
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
1 ;;; bindat.el --- binary data structure packing and unpacking.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
2
79704
78ee6fae0e41 Add 2008 to copyright years.
Glenn Morris <rgm@gnu.org>
parents: 78217
diff changeset
3 ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
4
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
5 ;; Author: Kim F. Storm <storm@cua.dk>
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
6 ;; Assignment name: struct.el
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
7 ;; Keywords: comm data processes
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
8
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
9 ;; This file is part of GNU Emacs.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
15
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
19 ;; GNU General Public License for more details.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
20
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
23
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
24 ;;; Commentary:
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
25
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
26 ;; Packing and unpacking of (binary) data structures.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
27 ;;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
28 ;; The data formats used in binary files and network protocols are
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
29 ;; often structed data which can be described by a C-style structure
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
30 ;; such as the one shown below. Using the bindat package, decoding
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
31 ;; and encoding binary data formats like these is made simple using a
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
32 ;; structure specification which closely resembles the C style
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
33 ;; structure declarations.
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
34 ;;
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
37 ;; pairs.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
38
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
39 ;; Example:
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
40
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
41 ;; Consider the following C structures:
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
42 ;;
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
43 ;; struct header {
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
44 ;; unsigned long dest_ip;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
45 ;; unsigned long src_ip;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
46 ;; unsigned short dest_port;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
47 ;; unsigned short src_port;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
48 ;; };
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
49 ;;
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
50 ;; struct data {
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
51 ;; unsigned char type;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
52 ;; unsigned char opcode;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
53 ;; unsigned long length; /* In little endian order */
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
54 ;; unsigned char id[8]; /* nul-terminated string */
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
55 ;; unsigned char data[/* (length + 3) & ~3 */];
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
56 ;; };
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
57 ;;
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
58 ;; struct packet {
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
59 ;; struct header header;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
60 ;; unsigned char items;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
61 ;; unsigned char filler[3];
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
62 ;; struct data item[/* items */];
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
63 ;; };
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
64 ;;
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
68 ;; '((dest-ip ip)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
69 ;; (src-ip ip)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
70 ;; (dest-port u16)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
74 ;; '((type u8)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
75 ;; (opcode u8)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
76 ;; (length u16r) ;; little endian order
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
77 ;; (id strz 8)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
78 ;; (data vec (length))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
83 ;; (items u8)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
84 ;; (fill 3)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
88 ;;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
91 ;; 2 3 5 0 ?A ?B ?C ?D ?E ?F 0 0 1 2 3 4 5 0 0 0
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
94 ;; The corresponding decoded structure looks like
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
95 ;;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
96 ;; ((header
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
97 ;; (dest-ip . [192 168 1 100])
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
98 ;; (src-ip . [192 168 1 101])
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
99 ;; (dest-port . 284)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
100 ;; (src-port . 5408))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
101 ;; (items . 2)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
102 ;; (item ((data . [1 2 3 4 5])
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
103 ;; (id . "ABCDEF")
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
104 ;; (length . 5)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
105 ;; (opcode . 3)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
106 ;; (type . 2))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
107 ;; ((data . [6 7 8 9 10 11 12])
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
108 ;; (id . "BCDEFG")
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
109 ;; (length . 7)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
110 ;; (opcode . 4)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
111 ;; (type . 1))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
112 ;;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
113 ;; To access a specific value in this structure, use the function
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
114 ;; bindat-get-field with the structure as first arg followed by a list
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
115 ;; of field names and array indexes, e.g. using the data above,
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
116 ;; (bindat-get-field decoded-structure 'item 1 'id)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
117 ;; returns "BCDEFG".
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
118
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
119 ;; Binary Data Structure Specification Format
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
120 ;; ------------------------------------------
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
125 ;; The data specification is formatted as follows:
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
126
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
127 ;; SPEC ::= ( ITEM... )
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
128
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
129 ;; ITEM ::= ( [FIELD] TYPE )
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
130 ;; | ( [FIELD] eval FORM ) -- eval FORM for side-effect only
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
131 ;; | ( [FIELD] fill LEN ) -- skip LEN bytes
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
132 ;; | ( [FIELD] align LEN ) -- skip to next multiple of LEN bytes
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
133 ;; | ( [FIELD] struct SPEC_NAME )
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
136
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
137 ;; -- In (eval EXPR), the value of the last field is available in
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
138 ;; the dynamically bound variable `last'.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
139
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
140 ;; TYPE ::= ( eval EXPR ) -- interpret result as TYPE
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
141 ;; | u8 | byte -- length 1
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
142 ;; | u16 | word | short -- length 2, network byte order
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
143 ;; | u24 -- 3-byte value
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
144 ;; | u32 | dword | long -- length 4, network byte order
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
145 ;; | u16r | u24r | u32r -- little endian byte order.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
146 ;; | str LEN -- LEN byte string
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
149 ;; | ip -- 4 byte vector
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
150 ;; | bits LEN -- List with bits set in LEN bytes.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
151 ;;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
152 ;; -- Note: 32 bit values may be limited by emacs' INTEGER
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
153 ;; implementation limits.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
157
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
158 ;; FIELD ::= ( eval EXPR ) -- use result as NAME
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
159 ;; | NAME
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
160
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
161 ;; LEN ::= ARG
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
162 ;; | <omitted> | nil -- LEN = 1
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
163
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
164
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
165 ;; TAG_VAL ::= ARG
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
166
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
167 ;; TAG ::= LISP_CONSTANT
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
168 ;; | ( eval EXPR ) -- return non-nil if tag match;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
169 ;; current TAG_VAL in `tag'.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
170
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
171 ;; ARG ::= ( eval EXPR ) -- interpret result as ARG
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
172 ;; | INTEGER_CONSTANT
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
173 ;; | DEREF
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
174
70853
993df0652ff7 Refill; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68648
diff changeset
175 ;; DEREF ::= ( [NAME | INTEGER]... ) -- Field NAME or Array index relative
993df0652ff7 Refill; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68648
diff changeset
176 ;; to current structure spec.
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
177 ;; -- see bindat-get-field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
178
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
179 ;; A `union' specification
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
182 ;; each TAG using equal; if a match is found, the corresponding SPEC
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
183 ;; is used.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
184 ;; If TAG is a form (eval EXPR), EXPR is evalled with `tag' bound to the
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
185 ;; value of TAG_VAL; the corresponding SPEC is used if the result is non-nil.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
186 ;; Finally, if TAG is t, the corresponding SPEC is used unconditionally.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
187 ;;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
188 ;; An `eval' specification
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
189 ;; ([FIELD] eval FORM)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
190 ;; is interpreted by evalling FORM for its side effects only.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
193
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
194 ;;; Code:
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
195
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
201
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
202 (defun bindat--unpack-u8 ()
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
209
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
212
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
215
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
218
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
221
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
226 (if (eq type 'ip)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
227 (setq type 'vec len 4))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
228 (cond
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
229 ((memq type '(u8 byte))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
230 (bindat--unpack-u8))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
231 ((memq type '(u16 word short))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
232 (bindat--unpack-u16))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
233 ((eq type 'u24)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
234 (bindat--unpack-u24))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
235 ((memq type '(u32 dword long))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
236 (bindat--unpack-u32))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
237 ((eq type 'u16r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
238 (bindat--unpack-u16r))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
239 ((eq type 'u24r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
240 (bindat--unpack-u24r))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
241 ((eq type 'u32r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
242 (bindat--unpack-u32r))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
243 ((eq type 'bits)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
244 (let ((bits nil) (bnum (1- (* 8 len))) j m)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
245 (while (>= bnum 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
246 (if (= (setq m (bindat--unpack-u8)) 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
247 (setq bnum (- bnum 8))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
248 (setq j 128)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
249 (while (> j 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
250 (if (/= 0 (logand m j))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
251 (setq bits (cons bnum bits)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
252 (setq bnum (1- bnum)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
253 j (lsh j -1)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
254 bits))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
258 (if (stringp s) s
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
259 (string-make-unibyte (concat s)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
260 ((eq type 'strz)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
266 (if (stringp s) s
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
267 (string-make-unibyte (concat s)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
277 (setq i (1+ i)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
278 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
279 (t nil)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
280
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
281 (defun bindat--unpack-group (spec)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
282 (let (struct last)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
283 (while spec
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
284 (let* ((item (car spec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
285 (field (car item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
286 (type (nth 1 item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
289 (tail 3)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
290 data)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
291 (setq spec (cdr spec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
292 (if (and (consp field) (eq (car field) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
293 (setq field (eval (car (cdr field)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
294 (if (and type (consp type) (eq (car type) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
295 (setq type (eval (car (cdr type)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
296 (if (and len (consp len) (eq (car len) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
297 (setq len (eval (car (cdr len)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
298 (if (memq field '(eval fill align struct union))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
299 (setq tail 2
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
300 len type
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
301 type field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
302 field nil))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
303 (if (and (consp len) (not (eq type 'eval)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
304 (setq len (apply 'bindat-get-field struct len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
305 (if (not len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
306 (setq len 1))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
307 (cond
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
308 ((eq type 'eval)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
309 (if field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
310 (setq data (eval len))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
311 (eval len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
317 ((eq type 'struct)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
318 (setq data (bindat--unpack-group (eval len))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
322 (setq data (cons (bindat--unpack-group (nthcdr tail item)) data))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
323 (setq index (1+ index)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
324 (setq data (nreverse data))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
325 ((eq type 'union)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
326 (let ((tag len) (cases (nthcdr tail item)) case cc)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
327 (while cases
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
328 (setq case (car cases)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
329 cases (cdr cases)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
330 cc (car case))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
331 (if (or (equal cc tag) (equal cc t)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
332 (and (consp cc) (eval cc)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
333 (setq data (bindat--unpack-group (cdr case))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
334 cases nil)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
337 last data)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
338 (if data
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
339 (if field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
340 (setq struct (cons (cons field data) struct))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
341 (setq struct (append data struct))))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
351 (bindat--unpack-group spec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
352
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
353 (defun bindat-get-field (struct &rest field)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
354 "In structured data STRUCT, return value of field named FIELD.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
355 If multiple field names are specified, use the field names to
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
356 lookup nested sub-structures in STRUCT, corresponding to the
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
357 C-language syntax STRUCT.FIELD1.FIELD2.FIELD3...
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
358 An integer value in the field list is taken as an array index,
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
359 e.g. corresponding to STRUCT.FIELD1[INDEX2].FIELD3..."
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
360 (while (and struct field)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
361 (setq struct (if (integerp (car field))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
362 (nth (car field) struct)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
363 (let ((val (assq (car field) struct)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
364 (if (consp val) (cdr val)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
365 (setq field (cdr field)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
366 struct)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
367
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
370
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
371 (defvar bindat--fixed-length-alist
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
372 '((u8 . 1) (byte . 1)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
373 (u16 . 2) (u16r . 2) (word . 2) (short . 2)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
374 (u24 . 3) (u24r . 3)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
375 (u32 . 4) (u32r . 4) (dword . 4) (long . 4)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
376 (ip . 4)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
377
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
378 (defun bindat--length-group (struct spec)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
379 (let (last)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
380 (while spec
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
381 (let* ((item (car spec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
382 (field (car item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
383 (type (nth 1 item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
386 (tail 3))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
387 (setq spec (cdr spec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
388 (if (and (consp field) (eq (car field) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
389 (setq field (eval (car (cdr field)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
390 (if (and type (consp type) (eq (car type) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
391 (setq type (eval (car (cdr type)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
392 (if (and len (consp len) (eq (car len) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
393 (setq len (eval (car (cdr len)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
394 (if (memq field '(eval fill align struct union))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
395 (setq tail 2
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
396 len type
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
397 type field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
398 field nil))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
399 (if (and (consp len) (not (eq type 'eval)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
400 (setq len (apply 'bindat-get-field struct len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
401 (if (not len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
411 ((eq type 'eval)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
412 (if field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
413 (setq struct (cons (cons field (eval len)) struct))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
414 (eval len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
420 ((eq type 'struct)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
421 (bindat--length-group
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
422 (if field (bindat-get-field struct field) struct) (eval len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
993df0652ff7 Refill; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68648
diff changeset
426 (bindat--length-group
993df0652ff7 Refill; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68648
diff changeset
427 (nth index (bindat-get-field struct field))
993df0652ff7 Refill; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68648
diff changeset
428 (nthcdr tail item))
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
429 (setq index (1+ index)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
430 ((eq type 'union)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
431 (let ((tag len) (cases (nthcdr tail item)) case cc)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
432 (while cases
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
433 (setq case (car cases)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
434 cases (cdr cases)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
435 cc (car case))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
436 (if (or (equal cc tag) (equal cc t)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
437 (and (consp cc) (eval cc)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
438 (progn
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
439 (bindat--length-group struct (cdr case))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
440 (setq cases nil))))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
441 (t
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
444 (if field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
447
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
453
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
456
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
465
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
466 (defun bindat--pack-u24 (v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
467 (bindat--pack-u8 (lsh v -16))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
468 (bindat--pack-u16 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
469
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
470 (defun bindat--pack-u32 (v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
471 (bindat--pack-u16 (lsh v -16))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
472 (bindat--pack-u16 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
473
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
478
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
479 (defun bindat--pack-u24r (v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
480 (bindat--pack-u16r v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
481 (bindat--pack-u8 (lsh v -16)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
482
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
483 (defun bindat--pack-u32r (v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
484 (bindat--pack-u16r v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
485 (bindat--pack-u16r (lsh v -16)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
488 (if (eq type 'ip)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
489 (setq type 'vec len 4))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
490 (cond
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
493 ((memq type '(u8 byte))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
494 (bindat--pack-u8 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
495 ((memq type '(u16 word short))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
496 (bindat--pack-u16 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
497 ((eq type 'u24)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
498 (bindat--pack-u24 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
499 ((memq type '(u32 dword long))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
500 (bindat--pack-u32 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
501 ((eq type 'u16r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
502 (bindat--pack-u16r v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
503 ((eq type 'u24r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
504 (bindat--pack-u24r v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
505 ((eq type 'u32r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
506 (bindat--pack-u32r v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
507 ((eq type 'bits)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
508 (let ((bnum (1- (* 8 len))) j m)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
509 (while (>= bnum 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
510 (setq m 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
511 (if (null v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
512 (setq bnum (- bnum 8))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
513 (setq j 128)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
514 (while (> j 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
515 (if (memq bnum v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
516 (setq m (logior m j)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
517 (setq bnum (1- bnum)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
518 j (lsh j -1))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
521 (let ((l (length v)) (i 0))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
522 (if (> l len) (setq l len))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
540
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
541 (defun bindat--pack-group (struct spec)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
542 (let (last)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
543 (while spec
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
544 (let* ((item (car spec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
545 (field (car item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
546 (type (nth 1 item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
549 (tail 3))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
550 (setq spec (cdr spec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
551 (if (and (consp field) (eq (car field) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
552 (setq field (eval (car (cdr field)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
553 (if (and type (consp type) (eq (car type) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
554 (setq type (eval (car (cdr type)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
555 (if (and len (consp len) (eq (car len) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
556 (setq len (eval (car (cdr len)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
557 (if (memq field '(eval fill align struct union))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
558 (setq tail 2
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
559 len type
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
560 type field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
561 field nil))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
562 (if (and (consp len) (not (eq type 'eval)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
563 (setq len (apply 'bindat-get-field struct len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
564 (if (not len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
565 (setq len 1))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
566 (cond
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
567 ((eq type 'eval)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
568 (if field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
569 (setq struct (cons (cons field (eval len)) struct))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
570 (eval len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
576 ((eq type 'struct)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
577 (bindat--pack-group
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
578 (if field (bindat-get-field struct field) struct) (eval len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
993df0652ff7 Refill; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68648
diff changeset
582 (bindat--pack-group
993df0652ff7 Refill; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68648
diff changeset
583 (nth index (bindat-get-field struct field))
993df0652ff7 Refill; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 68648
diff changeset
584 (nthcdr tail item))
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
585 (setq index (1+ index)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
586 ((eq type 'union)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
587 (let ((tag len) (cases (nthcdr tail item)) case cc)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
588 (while cases
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
589 (setq case (car cases)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
590 cases (cdr cases)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
591 cc (car case))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
592 (if (or (equal cc tag) (equal cc t)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
593 (and (consp cc) (eval cc)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
594 (progn
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
595 (bindat--pack-group struct (cdr case))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
596 (setq cases nil))))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
597 (t
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
600 ))))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
5adaaf91c4d5 Fixed typo in docstring.
Kim F. Storm <storm@cua.dk>
parents: 46122
diff changeset
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
b2dddb50f233 (bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents: 71032
diff changeset
612 (setq bindat-raw (make-vector (+ bindat-idx (bindat-length spec struct)) 0)))
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
613 (bindat--pack-group struct spec)
71033
b2dddb50f233 (bindat-idx, bindat-raw): Rename dynamic variables
Kim F. Storm <storm@cua.dk>
parents: 71032
diff changeset
614 (if no-return nil (concat bindat-raw))))
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
615
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
616
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
617 ;; Misc. format conversions
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
618
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
619 (defun bindat-format-vector (vect fmt sep &optional len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
620 "Format vector VECT using element format FMT and separator SEP.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
621 Result is a string with each element of VECT formatted using FMT and
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
622 separated by the string SEP. If optional fourth arg LEN is given, use
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
623 only that many elements from VECT."
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
624 (unless len
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
625 (setq len (length vect)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
626 (let ((i len) (fmt2 (concat sep fmt)) (s nil))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
627 (while (> i 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
628 (setq i (1- i)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
629 s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
630 (apply 'concat s)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
631
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
632 (defun bindat-vector-to-dec (vect &optional sep)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
633 "Format vector VECT in decimal format separated by dots.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
634 If optional second arg SEP is a string, use that as separator."
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
635 (bindat-format-vector vect "%d" (if (stringp sep) sep ".")))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
636
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
637 (defun bindat-vector-to-hex (vect &optional sep)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
638 "Format vector VECT in hex format separated by dots.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
639 If optional second arg SEP is a string, use that as separator."
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
640 (bindat-format-vector vect "%02x" (if (stringp sep) sep ":")))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
641
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
649
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
650 (provide 'bindat)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
653 ;;; bindat.el ends here