annotate lisp/emacs-lisp/bindat.el @ 82142:9077ada922e0

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