examples.scm - bitstring - A fork of the CHICKEN bitstring egg for CHICKEN 5
(HTM) git clone git://vernunftzentrum.de/bitstring.git
(DIR) Log
(DIR) Files
(DIR) Refs
(DIR) README
---
examples.scm (5152B)
---
1 (use bitstring)
2 (use srfi-4)
3
4 ; Example 1. Tagged data structure.
5 ;
6 ; struct Tagged {
7 ; enum { IntegerType = 1, FloatType = 2 };
8 ; unsigned char Tag; // integer type = 1, float type = 2
9 ; union {
10 ; unsigned int IValue;
11 ; float FValue;
12 ; };
13 ; };
14 ;
15
16 ; The following will print "integer:3721182122",
17 ; which is the decimal value of #xDDCCBBAA
18 (bitmatch "\x01\xAA\xBB\xCC\xDD"
19 (((#x01) (IValue 32 little))
20 (print "integer:" IValue))
21 (((#x02) (FValue 32 float))
22 (print "float:" FValue)))
23
24 ; Example 2. Fixed length string.
25 ;
26 ; struct FixedString {
27 ; short Length; // length of StringData array
28 ; char StringData[0];
29 ; };
30 ;
31
32 ; This will print "StringData:(65 66 67 68 69)"
33 ; First it reads the length byte of 5, bind it to Length and
34 ; then it will read a bit string with a length of that many octets.
35 (bitmatch "\x05\x00ABCDE"
36 (((Length 16 little)
37 (StringData (* 8 Length) bitstring))
38 (print "StringData:" (bitstring->list StringData 8)))
39 (else
40 (print "invalid string")))
41
42 ; Example 3. IP packet parsing.
43 ;
44
45 (use bitstring srfi-4)
46
47 (define IPRaw `#u8( #x45 #x00 #x00 #x6c
48 #x92 #xcc #x00 #x00
49 #x38 #x06 #x00 #x00
50 #x92 #x95 #xba #x14
51 #xa9 #x7c #x15 #x95 ))
52
53 (bitmatch IPRaw
54 (((Version 4)
55 (IHL 4)
56 (TOS 8)
57 (TL 16)
58 (Identification 16)
59 (Reserved 1) (DF 1) (MF 1)
60 (FramgentOffset 13)
61 (TTL 8)
62 (Protocol 8) (check (or (= Protocol 1)
63 (= Protocol 2)
64 (= Protocol 6)
65 (= Protocol 17)))
66 (CheckSum 16)
67 (SourceAddr 32 bitstring)
68 (DestinationAddr 32 bitstring)
69 (Optional bitstring))
70 ; print packet filds
71 (print "\n Version: " Version
72 "\n IHL: " IHL
73 "\n TOS: " TOS
74 "\n TL: " TL
75 "\n Identification: " Identification
76 "\n DF: " DF
77 "\n MF: " MF
78 "\n FramgentOffset: " FramgentOffset
79 "\n Protocol: " Protocol
80 "\n CheckSum: " CheckSum
81 "\n SourceAddr: "
82 (bitmatch SourceAddr (((A)(B)(C)(D)) (list A B C D)))
83 "\n DestinationAddr: "
84 (bitmatch DestinationAddr (((A)(B)(C)(D)) (list A B C D)))))
85 (else
86 (print "bad datagram")))
87
88 ; Example 3.1 Using bitconstruct.
89
90 (define (construct-fixed-string str)
91 (bitconstruct
92 ((string-length str) 16) (str bitstring) ))
93
94 ; The following will print "#t". First, it reads a 16-bit number length
95 ; and compares it to the immediate value of 7. Then it will read a
96 ; string and compare it to the immediate value of "qwerty.". If there
97 ; was any remaining data in the string, it would fail.
98 (bitmatch (construct-fixed-string "qwerty.")
99 (((7 16) ("qwerty."))
100 (print #t))
101 (else
102 (print #f)))
103
104 ; Example 3.2 Concatenating bitstrings.
105
106 (define (construct-complex-object)
107 (bitconstruct
108 ((construct-fixed-string "A") bitstring)
109 (#xAABB 16)
110 ((construct-fixed-string "RRR") bitstring)
111 (#\X)))
112
113 (print (construct-complex-object))
114
115
116 ; Example 4.1 Using bitpacket for better code reuse
117
118 (bitpacket Point (x float host)
119 (y float host))
120
121 (bitpacket Line (start Point bitpacket)
122 (end Point bitpacket))
123
124 ; parse array of line coordinates
125 (bitmatch (f32vector->blob (f32vector 0.5 -0.5 1.0 0.0))
126 (((Line bitpacket))
127 (print "start x: " start.x " y: " start.y " x2: " end.x " y2: " end.y)))
128
129 ; create line coordinate
130 (define (bitstring->f32vector bs)
131 (blob->f32vector (bitstring->blob bs)))
132
133 ; construct Line
134 (let ((start.x 1.0)
135 (start.y 2.0)
136 (end.x -1.0)
137 (end.y -2.0))
138 (print "Line: "
139 (bitstring->f32vector
140 (bitconstruct (Line bitpacket)))))
141
142 ; Example 4.2 Using bitpacket constructor
143
144 ; Special syntax (bitpacket (packet-name constructor-name) fields ...)
145 (bitpacket (Point3D make-Point3D)
146 (x float host)
147 (y float host)
148 (z float host))
149
150 ; make-Point3D just syntax sugar for '(let (args ...) (bitconstruct (Point3D bitpacket)))'
151 (print "Point3D: " (bitstring->f32vector
152 (make-Point3D (x 0.0) (y -1.0) (z 1.0))))
153
154 ; Example 5. Reader procedure
155
156 ; Pattern: ((Name reader-proc) bitstring)
157 ; Signature: (reader-proc bitstring) -> returns #f or (list num-bits-consumed user-value)
158
159 ; C string reader
160 (define (cstring-reader bs)
161 (let loop ((n 8) (acc '()) (rest bs))
162 (bitmatch rest
163 ; end of stream (fail!)
164 (() #f)
165 ; zero-terminator (success!)
166 (((0) (rest bitstring))
167 (list n ; number of bits consumed
168 (list->string (reverse acc)))) ; result string
169 ; continue
170 (((c) (rest bitstring))
171 (loop (+ n 8) ; accumulate length
172 (cons (integer->char c) acc); save char
173 rest))))) ; inspect rest of stream
174
175 (bitmatch "Kernighan\x00Ritchie\x00"
176 ((((s1 cstring-reader) bitstring)
177 ((s2 cstring-reader) bitstring))
178 (print (string-append s1 " and " s2))))