annotate lisp/emacs-lisp/bindat.el @ 68270:556ef00fdd9f

*** empty log message ***
author Richard M. Stallman <rms@gnu.org>
date Thu, 19 Jan 2006 17:52:09 +0000
parents 5b1a238fcbb4
children 067115a6e738 2d92f5c9d6ae
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
64751
5b1a238fcbb4 Update years in copyright notice; nfc.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 64085
diff changeset
3 ;; Copyright (C) 2002, 2003, 2004, 2005 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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
13 ;; the Free Software Foundation; either version 2, or (at your option)
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 ;;
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
69 ;; (setq header-spec
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 ;;
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
75 ;; (setq data-spec
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 ;;
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
83 ;; (setq packet-spec
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
84 ;; '((header struct header-spec)
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)
63331
3fc0c472c166 Fix `repeat' BNF and `bits 2' example in Commentary.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 52401
diff changeset
88 ;; (struct data-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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
124 ;; The data specification is formatted as follows:
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
125
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
126 ;; SPEC ::= ( ITEM... )
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
127
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
128 ;; ITEM ::= ( [FIELD] TYPE )
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
129 ;; | ( [FIELD] eval FORM ) -- eval FORM for side-effect only
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
130 ;; | ( [FIELD] fill LEN ) -- skip LEN bytes
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
131 ;; | ( [FIELD] align LEN ) -- skip to next multiple of LEN bytes
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
132 ;; | ( [FIELD] struct SPEC_NAME )
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
133 ;; | ( [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
134 ;; | ( [FIELD] repeat COUNT ITEM... )
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
135
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
136 ;; -- In (eval EXPR), the value of the last field is available in
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
137 ;; the dynamically bound variable `last'.
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 ;; TYPE ::= ( eval EXPR ) -- interpret result as TYPE
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
140 ;; | u8 | byte -- length 1
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
141 ;; | u16 | word | short -- length 2, network byte order
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
142 ;; | u24 -- 3-byte value
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
143 ;; | u32 | dword | long -- length 4, network byte order
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
144 ;; | u16r | u24r | u32r -- little endian byte order.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
145 ;; | str LEN -- LEN byte string
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
146 ;; | strz LEN -- LEN byte (zero-terminated) string
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
147 ;; | vec LEN -- LEN byte vector
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
148 ;; | ip -- 4 byte vector
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
149 ;; | bits LEN -- List with bits set in LEN bytes.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
150 ;;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
151 ;; -- Note: 32 bit values may be limited by emacs' INTEGER
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
152 ;; implementation limits.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
153 ;;
63331
3fc0c472c166 Fix `repeat' BNF and `bits 2' example in Commentary.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 52401
diff changeset
154 ;; -- 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
155 ;; and 0x1c 0x28 to (3 5 10 11 12).
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
156
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
157 ;; FIELD ::= ( eval EXPR ) -- use result as NAME
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
158 ;; | NAME
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 ;; LEN ::= ARG
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
161 ;; | <omitted> | nil -- LEN = 1
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
164 ;; TAG_VAL ::= ARG
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 ;; TAG ::= LISP_CONSTANT
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
167 ;; | ( eval EXPR ) -- return non-nil if tag match;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
168 ;; current TAG_VAL in `tag'.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
169
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
170 ;; ARG ::= ( eval EXPR ) -- interpret result as ARG
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
171 ;; | INTEGER_CONSTANT
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
172 ;; | DEREF
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
173
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
174 ;; DEREF ::= ( [NAME | INTEGER]... ) -- Field NAME or Array index relative to
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
175 ;; current structure spec.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
176 ;; -- see bindat-get-field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
177
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
178 ;; A `union' specification
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
179 ;; ([FIELD] union TAG_VAL (TAG SPEC) ... [(t SPEC)])
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
180 ;; is interpreted by evalling TAG_VAL and then comparing that to
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
181 ;; each TAG using equal; if a match is found, the corresponding SPEC
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
182 ;; is used.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
183 ;; 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
184 ;; 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
185 ;; Finally, if TAG is t, the corresponding SPEC is used unconditionally.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
186 ;;
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
187 ;; An `eval' specification
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
188 ;; ([FIELD] eval FORM)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
189 ;; is interpreted by evalling FORM for its side effects only.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
190 ;; If FIELD is specified, the value is bound to that field.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
191 ;; The FORM may access and update `raw-data' and `pos' (see `bindat-unpack'),
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
192 ;; as well as the lisp data structure in `struct'.
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.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
197 ;; Relies on dynamic binding of RAW-DATA and POS
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
198
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
199 (defvar raw-data)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
200 (defvar pos)
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
204 (if (stringp raw-data)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
205 (string-to-char (substring raw-data pos (1+ pos)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
206 (aref raw-data pos))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
207 (setq pos (1+ pos))))
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 ()
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
210 (let* ((a (bindat--unpack-u8)) (b (bindat--unpack-u8)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
211 (logior (lsh a 8) b)))
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-u24 ()
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
214 (let* ((a (bindat--unpack-u16)) (b (bindat--unpack-u8)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
215 (logior (lsh a 8) b)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
216
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
217 (defun bindat--unpack-u32 ()
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
218 (let* ((a (bindat--unpack-u16)) (b (bindat--unpack-u16)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
219 (logior (lsh a 16) b)))
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-u16r ()
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
222 (let* ((a (bindat--unpack-u8)) (b (bindat--unpack-u8)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
223 (logior a (lsh b 8))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
224
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
225 (defun bindat--unpack-u24r ()
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
226 (let* ((a (bindat--unpack-u16r)) (b (bindat--unpack-u8)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
227 (logior a (lsh b 16))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
228
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
229 (defun bindat--unpack-u32r ()
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
230 (let* ((a (bindat--unpack-u16r)) (b (bindat--unpack-u16r)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
231 (logior a (lsh b 16))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
232
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
233 (defun bindat--unpack-item (type len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
234 (if (eq type 'ip)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
235 (setq type 'vec len 4))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
236 (cond
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
237 ((memq type '(u8 byte))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
238 (bindat--unpack-u8))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
239 ((memq type '(u16 word short))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
240 (bindat--unpack-u16))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
241 ((eq type 'u24)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
242 (bindat--unpack-u24))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
243 ((memq type '(u32 dword long))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
244 (bindat--unpack-u32))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
245 ((eq type 'u16r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
246 (bindat--unpack-u16r))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
247 ((eq type 'u24r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
248 (bindat--unpack-u24r))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
249 ((eq type 'u32r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
250 (bindat--unpack-u32r))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
251 ((eq type 'bits)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
252 (let ((bits nil) (bnum (1- (* 8 len))) j m)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
253 (while (>= bnum 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
254 (if (= (setq m (bindat--unpack-u8)) 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
255 (setq bnum (- bnum 8))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
256 (setq j 128)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
257 (while (> j 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
258 (if (/= 0 (logand m j))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
259 (setq bits (cons bnum bits)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
260 (setq bnum (1- bnum)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
261 j (lsh j -1)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
262 bits))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
263 ((eq type 'str)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
264 (let ((s (substring raw-data pos (+ pos len))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
265 (setq pos (+ pos len))
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 'strz)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
269 (let ((i 0) s)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
270 (while (and (< i len) (/= (aref raw-data (+ pos i)) 0))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
271 (setq i (1+ i)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
272 (setq s (substring raw-data pos (+ pos i)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
273 (setq pos (+ pos len))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
274 (if (stringp s) s
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
275 (string-make-unibyte (concat s)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
276 ((eq type 'vec)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
277 (let ((v (make-vector len 0)) (i 0))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
278 (while (< i len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
279 (aset v i (bindat--unpack-u8))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
280 (setq i (1+ i)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
281 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
282 (t nil)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
283
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
284 (defun bindat--unpack-group (spec)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
285 (let (struct last)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
286 (while spec
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
287 (let* ((item (car spec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
288 (field (car item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
289 (type (nth 1 item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
290 (len (nth 2 item))
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)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
315 (setq pos (+ pos len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
316 ((eq type 'align)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
317 (while (/= (% pos len) 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
318 (setq pos (1+ pos))))
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)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
322 (let ((index 0))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
323 (while (< index len)
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
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
338 (setq data (bindat--unpack-item type len)
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
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
346 (defun bindat-unpack (spec raw-data &optional pos)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
347 "Return structured data according to SPEC for binary data in RAW-DATA.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
348 RAW-DATA is a string or vector. Optional third arg POS specifies the
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
349 starting offset in RAW-DATA."
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
350 (unless pos (setq pos 0))
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
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
369 ;; Calculate raw-data 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))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
385 (tail 3))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
386 (setq spec (cdr spec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
387 (if (and (consp field) (eq (car field) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
388 (setq field (eval (car (cdr field)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
389 (if (and type (consp type) (eq (car type) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
390 (setq type (eval (car (cdr type)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
391 (if (and len (consp len) (eq (car len) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
392 (setq len (eval (car (cdr len)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
393 (if (memq field '(eval fill align struct union))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
394 (setq tail 2
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
395 len type
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
396 type field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
397 field nil))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
398 (if (and (consp len) (not (eq type 'eval)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
399 (setq len (apply 'bindat-get-field struct len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
400 (if (not len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
401 (setq len 1))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
402 (cond
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
403 ((eq type 'eval)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
404 (if field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
405 (setq struct (cons (cons field (eval len)) struct))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
406 (eval len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
407 ((eq type 'fill)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
408 (setq pos (+ pos len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
409 ((eq type 'align)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
410 (while (/= (% pos len) 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
411 (setq pos (1+ pos))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
412 ((eq type 'struct)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
413 (bindat--length-group
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
414 (if field (bindat-get-field struct field) struct) (eval len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
415 ((eq type 'repeat)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
416 (let ((index 0))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
417 (while (< index len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
418 (bindat--length-group (nth index (bindat-get-field struct field)) (nthcdr tail item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
419 (setq index (1+ index)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
420 ((eq type 'union)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
421 (let ((tag len) (cases (nthcdr tail item)) case cc)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
422 (while cases
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
423 (setq case (car cases)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
424 cases (cdr cases)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
425 cc (car case))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
426 (if (or (equal cc tag) (equal cc t)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
427 (and (consp cc) (eval cc)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
428 (progn
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
429 (bindat--length-group struct (cdr case))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
430 (setq cases nil))))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
431 (t
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
432 (if (setq type (assq type bindat--fixed-length-alist))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
433 (setq len (cdr type)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
434 (if field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
435 (setq last (bindat-get-field struct field)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
436 (setq pos (+ pos len))))))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
437
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
438 (defun bindat-length (spec struct)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
439 "Calculate raw-data length for STRUCT according to bindat specification SPEC."
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
440 (let ((pos 0))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
441 (bindat--length-group struct spec)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
442 pos))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
443
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
444
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
445 ;; Pack structured data into raw-data
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
446
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
447 (defun bindat--pack-u8 (v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
448 (aset raw-data pos (logand v 255))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
449 (setq pos (1+ pos)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
450
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
451 (defun bindat--pack-u16 (v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
452 (aset raw-data pos (logand (lsh v -8) 255))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
453 (aset raw-data (1+ pos) (logand v 255))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
454 (setq pos (+ pos 2)))
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 (defun bindat--pack-u24 (v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
457 (bindat--pack-u8 (lsh v -16))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
458 (bindat--pack-u16 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
459
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
460 (defun bindat--pack-u32 (v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
461 (bindat--pack-u16 (lsh v -16))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
462 (bindat--pack-u16 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
463
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
464 (defun bindat--pack-u16r (v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
465 (aset raw-data (1+ pos) (logand (lsh v -8) 255))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
466 (aset raw-data pos (logand v 255))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
467 (setq pos (+ pos 2)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
468
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
469 (defun bindat--pack-u24r (v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
470 (bindat--pack-u16r v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
471 (bindat--pack-u8 (lsh v -16)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
472
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
473 (defun bindat--pack-u32r (v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
474 (bindat--pack-u16r v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
475 (bindat--pack-u16r (lsh v -16)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
476
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
477 (defun bindat--pack-item (v type len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
478 (if (eq type 'ip)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
479 (setq type 'vec len 4))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
480 (cond
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
481 ((null v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
482 (setq pos (+ pos len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
483 ((memq type '(u8 byte))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
484 (bindat--pack-u8 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
485 ((memq type '(u16 word short))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
486 (bindat--pack-u16 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
487 ((eq type 'u24)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
488 (bindat--pack-u24 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
489 ((memq type '(u32 dword long))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
490 (bindat--pack-u32 v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
491 ((eq type 'u16r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
492 (bindat--pack-u16r v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
493 ((eq type 'u24r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
494 (bindat--pack-u24r v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
495 ((eq type 'u32r)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
496 (bindat--pack-u32r v))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
497 ((eq type 'bits)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
498 (let ((bnum (1- (* 8 len))) j m)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
499 (while (>= bnum 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
500 (setq m 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
501 (if (null v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
502 (setq bnum (- bnum 8))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
503 (setq j 128)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
504 (while (> j 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
505 (if (memq bnum v)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
506 (setq m (logior m j)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
507 (setq bnum (1- bnum)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
508 j (lsh j -1))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
509 (bindat--pack-u8 m))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
510 ((memq type '(str strz vec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
511 (let ((l (length v)) (i 0))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
512 (if (> l len) (setq l len))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
513 (while (< i l)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
514 (aset raw-data (+ pos i) (aref v i))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
515 (setq i (1+ i)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
516 (setq pos (+ pos len))))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
517 (t
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
518 (setq pos (+ pos len)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
519
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
520 (defun bindat--pack-group (struct spec)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
521 (let (last)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
522 (while spec
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
523 (let* ((item (car spec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
524 (field (car item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
525 (type (nth 1 item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
526 (len (nth 2 item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
527 (tail 3))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
528 (setq spec (cdr spec))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
529 (if (and (consp field) (eq (car field) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
530 (setq field (eval (car (cdr field)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
531 (if (and type (consp type) (eq (car type) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
532 (setq type (eval (car (cdr type)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
533 (if (and len (consp len) (eq (car len) 'eval))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
534 (setq len (eval (car (cdr len)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
535 (if (memq field '(eval fill align struct union))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
536 (setq tail 2
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
537 len type
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
538 type field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
539 field nil))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
540 (if (and (consp len) (not (eq type 'eval)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
541 (setq len (apply 'bindat-get-field struct len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
542 (if (not len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
543 (setq len 1))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
544 (cond
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
545 ((eq type 'eval)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
546 (if field
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
547 (setq struct (cons (cons field (eval len)) struct))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
548 (eval len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
549 ((eq type 'fill)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
550 (setq pos (+ pos len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
551 ((eq type 'align)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
552 (while (/= (% pos len) 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
553 (setq pos (1+ pos))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
554 ((eq type 'struct)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
555 (bindat--pack-group
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
556 (if field (bindat-get-field struct field) struct) (eval len)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
557 ((eq type 'repeat)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
558 (let ((index 0))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
559 (while (< index len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
560 (bindat--pack-group (nth index (bindat-get-field struct field)) (nthcdr tail item))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
561 (setq index (1+ index)))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
562 ((eq type 'union)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
563 (let ((tag len) (cases (nthcdr tail item)) case cc)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
564 (while cases
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
565 (setq case (car cases)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
566 cases (cdr cases)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
567 cc (car case))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
568 (if (or (equal cc tag) (equal cc t)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
569 (and (consp cc) (eval cc)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
570 (progn
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
571 (bindat--pack-group struct (cdr case))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
572 (setq cases nil))))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
573 (t
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
574 (setq last (bindat-get-field struct field))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
575 (bindat--pack-item last type len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
576 ))))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
577
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
578 (defun bindat-pack (spec struct &optional raw-data pos)
48031
5adaaf91c4d5 Fixed typo in docstring.
Kim F. Storm <storm@cua.dk>
parents: 46122
diff changeset
579 "Return binary data packed according to SPEC for structured data STRUCT.
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
580 Optional third arg RAW-DATA is a pre-allocated string or vector to unpack into.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
581 Optional fourth arg POS is the starting offset into RAW-DATA.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
582 Note: The result is a multibyte string; use `string-make-unibyte' on it
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
583 to make it unibyte if necessary."
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
584 (let ((no-return raw-data))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
585 (unless pos (setq pos 0))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
586 (unless raw-data (setq raw-data (make-vector (+ pos (bindat-length spec struct)) 0)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
587 (bindat--pack-group struct spec)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
588 (if no-return nil (concat raw-data))))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
589
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
590
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
591 ;; Misc. format conversions
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
592
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
593 (defun bindat-format-vector (vect fmt sep &optional len)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
594 "Format vector VECT using element format FMT and separator SEP.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
595 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
596 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
597 only that many elements from VECT."
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
598 (unless len
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
599 (setq len (length vect)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
600 (let ((i len) (fmt2 (concat sep fmt)) (s nil))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
601 (while (> i 0)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
602 (setq i (1- i)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
603 s (cons (format (if (= i 0) fmt fmt2) (aref vect i)) s)))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
604 (apply 'concat s)))
49598
0d8b17d428b5 Trailing whitepace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 48031
diff changeset
605
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
606 (defun bindat-vector-to-dec (vect &optional sep)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
607 "Format vector VECT in decimal format separated by dots.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
608 If optional second arg SEP is a string, use that as separator."
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
609 (bindat-format-vector vect "%d" (if (stringp sep) sep ".")))
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
610
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
611 (defun bindat-vector-to-hex (vect &optional sep)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
612 "Format vector VECT in hex format separated by dots.
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
613 If optional second arg SEP is a string, use that as separator."
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
614 (bindat-format-vector vect "%02x" (if (stringp sep) sep ":")))
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 (defun bindat-ip-to-string (ip)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
617 "Format vector IP as an ip address in dotted notation."
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
618 (format "%d.%d.%d.%d"
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
619 (aref ip 0) (aref ip 1) (aref ip 2) (aref ip 3)))
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 (provide 'bindat)
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
622
52401
695cf19ef79e Add arch taglines
Miles Bader <miles@gnu.org>
parents: 49598
diff changeset
623 ;;; arch-tag: 5e6708c3-03e2-4ad7-9885-5041b779c3fb
46122
17067a24204d New file.
Kim F. Storm <storm@cua.dk>
parents:
diff changeset
624 ;;; bindat.el ends here