3 <title>Bisect report</title>
4 <link rel="stylesheet" type="text/css" href="style.css">
7 <h3>File: bitstring.ml (<a href="index.html">return to index</a>)</h3>
10 <table class="simple">
11 <tr><th>kind</th><th width="16px"> </th><th>coverage</th></tr>
12 <tr><td>binding</td><td width="16px"> </td><td>119 / 231 (51 %)</td></tr>
13 <tr><td>sequence</td><td width="16px"> </td><td>37 / 93 (39 %)</td></tr>
14 <tr><td>for</td><td width="16px"> </td><td>3 / 5 (60 %)</td></tr>
15 <tr><td>if/then</td><td width="16px"> </td><td>72 / 163 (44 %)</td></tr>
16 <tr><td>try</td><td width="16px"> </td><td>0 / 2 (0 %)</td></tr>
17 <tr><td>while</td><td width="16px"> </td><td>0 / 3 (0 %)</td></tr>
18 <tr><td>match/function</td><td width="16px"> </td><td>41 / 77 (53 %)</td></tr>
19 <tr><td>class expression</td><td width="16px"> </td><td>0 / 0 (- %)</td></tr>
20 <tr><td>class initializer</td><td width="16px"> </td><td>0 / 0 (- %)</td></tr>
21 <tr><td>class method</td><td width="16px"> </td><td>0 / 0 (- %)</td></tr>
22 <tr><td>class value</td><td width="16px"> </td><td>0 / 0 (- %)</td></tr>
23 <tr><td>toplevel expression</td><td width="16px"> </td><td>0 / 0 (- %)</td></tr>
28 <div class="lineNone">000001| (* Bitstring library.</div>
29 <div class="lineNone">000002| * Copyright (C) 2008 Red Hat Inc., Richard W.M. Jones</div>
30 <div class="lineNone">000003| *</div>
31 <div class="lineNone">000004| * This library is free software; you can redistribute it and/or</div>
32 <div class="lineNone">000005| * modify it under the terms of the GNU Lesser General Public</div>
33 <div class="lineNone">000006| * License as published by the Free Software Foundation; either</div>
34 <div class="lineNone">000007| * version 2 of the License, or (at your option) any later version,</div>
35 <div class="lineNone">000008| * with the OCaml linking exception described in COPYING.LIB.</div>
36 <div class="lineNone">000009| *</div>
37 <div class="lineNone">000010| * This library is distributed in the hope that it will be useful,</div>
38 <div class="lineNone">000011| * but WITHOUT ANY WARRANTY; without even the implied warranty of</div>
39 <div class="lineNone">000012| * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU</div>
40 <div class="lineNone">000013| * Lesser General Public License for more details.</div>
41 <div class="lineNone">000014| *</div>
42 <div class="lineNone">000015| * You should have received a copy of the GNU Lesser General Public</div>
43 <div class="lineNone">000016| * License along with this library; if not, write to the Free Software</div>
44 <div class="lineNone">000017| * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA</div>
45 <div class="lineNone">000018| *</div>
46 <div class="lineNone">000019| * $Id: bitstring.ml 153 2008-08-26 08:24:31Z richard.wm.jones $</div>
47 <div class="lineNone">000020| *)</div>
48 <div class="lineNone">000021| </div>
49 <div class="lineNone">000022| open Printf</div>
50 <div class="lineNone">000023| </div>
51 <div class="lineNone">000024| include Bitstring_types</div>
52 <div class="lineNone">000025| include Bitstring_config</div>
53 <div class="lineNone">000026| </div>
54 <div class="lineNone">000027| (* Enable runtime debug messages. Must also have been enabled</div>
55 <div class="lineNone">000028| * in pa_bitstring.ml.</div>
56 <div class="lineNone">000029| *)</div>
57 <div class="lineAllVisited">000030| let debug = (*[28]*)ref false</div>
58 <div class="lineNone">000031| </div>
59 <div class="lineNone">000032| (* Exceptions. *)</div>
60 <div class="lineNone">000033| exception Construct_failure of string * string * int * int</div>
61 <div class="lineNone">000034| </div>
62 <div class="lineNone">000035| (* A bitstring is simply the data itself (as a string), and the</div>
63 <div class="lineNone">000036| * bitoffset and the bitlength within the string. Note offset/length</div>
64 <div class="lineNone">000037| * are counted in bits, not bytes.</div>
65 <div class="lineNone">000038| *)</div>
66 <div class="lineNone">000039| type bitstring = string * int * int</div>
67 <div class="lineNone">000040| </div>
68 <div class="lineNone">000041| (* Functions to create and load bitstrings. *)</div>
69 <div class="lineAllVisited">000042| let empty_bitstring = (*[28]*)"", 0, 0</div>
70 <div class="lineNone">000043| </div>
71 <div class="lineNone">000044| let make_bitstring len c =</div>
72 <div class="lineAllVisited">000045| (*[1197538]*)if len >= 0 then (*[1197538]*)String.make ((len+7) lsr 3) c, 0, len</div>
73 <div class="lineNone">000046| else</div>
74 <div class="lineAllUnvisited">000047| (*[0]*)invalid_arg (</div>
75 <div class="lineNone">000048| sprintf "make_bitstring/create_bitstring: len %d < 0" len</div>
76 <div class="lineNone">000049| )</div>
77 <div class="lineNone">000050| </div>
78 <div class="lineAllVisited">000051| let create_bitstring len = (*[1]*)make_bitstring len '\000'</div>
79 <div class="lineNone">000052| </div>
80 <div class="lineAllVisited">000053| let zeroes_bitstring = (*[28]*)create_bitstring</div>
81 <div class="lineNone">000054| </div>
82 <div class="lineAllVisited">000055| let ones_bitstring len = (*[1197537]*)make_bitstring len '\xff'</div>
83 <div class="lineNone">000056| </div>
84 <div class="lineAllVisited">000057| let bitstring_of_string str = (*[2]*)str, 0, String.length str lsl 3</div>
85 <div class="lineNone">000058| </div>
86 <div class="lineNone">000059| let bitstring_of_chan chan =</div>
87 <div class="lineAllUnvisited">000060| (*[0]*)let tmpsize = 16384 in</div>
88 <div class="lineAllUnvisited">000061| (*[0]*)let buf = Buffer.create tmpsize in</div>
89 <div class="lineAllUnvisited">000062| (*[0]*)let tmp = String.create tmpsize in</div>
90 <div class="lineAllUnvisited">000063| (*[0]*)let n = ref 0 in</div>
91 <div class="lineAllUnvisited">000064| (*[0]*)while (*[0]*)n := input chan tmp 0 tmpsize; !(*[0]*)n > 0 do</div>
92 <div class="lineAllUnvisited">000065| (*[0]*)Buffer.add_substring buf tmp 0 !n;</div>
93 <div class="lineNone">000066| done;</div>
94 <div class="lineAllUnvisited">000067| (*[0]*)Buffer.contents buf, 0, Buffer.length buf lsl 3</div>
95 <div class="lineNone">000068| </div>
96 <div class="lineNone">000069| let bitstring_of_chan_max chan max =</div>
97 <div class="lineAllUnvisited">000070| (*[0]*)let tmpsize = 16384 in</div>
98 <div class="lineAllUnvisited">000071| (*[0]*)let buf = Buffer.create tmpsize in</div>
99 <div class="lineAllUnvisited">000072| (*[0]*)let tmp = String.create tmpsize in</div>
100 <div class="lineAllUnvisited">000073| (*[0]*)let len = ref 0 in</div>
101 <div class="lineAllUnvisited">000074| (*[0]*)let rec loop () =</div>
102 <div class="lineAllUnvisited">000075| (*[0]*)if !len < max then (</div>
103 <div class="lineAllUnvisited">000076| (*[0]*)let r = min tmpsize (max - !len) in</div>
104 <div class="lineAllUnvisited">000077| (*[0]*)let n = input chan tmp 0 r in</div>
105 <div class="lineAllUnvisited">000078| (*[0]*)if n > 0 then (</div>
106 <div class="lineAllUnvisited">000079| (*[0]*)Buffer.add_substring buf tmp 0 n;</div>
107 <div class="lineAllUnvisited">000080| (*[0]*)len (*[0]*):= !len + n;</div>
108 <div class="lineAllUnvisited">000081| (*[0]*)loop ()</div>
109 <div class="lineNone">000082| )</div>
110 <div class="lineNone">000083| )</div>
111 <div class="lineNone">000084| in</div>
112 <div class="lineAllUnvisited">000085| (*[0]*)loop (*[0]*)();</div>
113 <div class="lineAllUnvisited">000086| (*[0]*)Buffer.contents buf, 0, !len lsl 3</div>
114 <div class="lineNone">000087| </div>
115 <div class="lineNone">000088| let bitstring_of_file_descr fd =</div>
116 <div class="lineAllUnvisited">000089| (*[0]*)let tmpsize = 16384 in</div>
117 <div class="lineAllUnvisited">000090| (*[0]*)let buf = Buffer.create tmpsize in</div>
118 <div class="lineAllUnvisited">000091| (*[0]*)let tmp = String.create tmpsize in</div>
119 <div class="lineAllUnvisited">000092| (*[0]*)let n = ref 0 in</div>
120 <div class="lineAllUnvisited">000093| (*[0]*)while (*[0]*)n := Unix.read fd tmp 0 tmpsize; !(*[0]*)n > 0 do</div>
121 <div class="lineAllUnvisited">000094| (*[0]*)Buffer.add_substring buf tmp 0 !n;</div>
122 <div class="lineNone">000095| done;</div>
123 <div class="lineAllUnvisited">000096| (*[0]*)Buffer.contents buf, 0, Buffer.length buf lsl 3</div>
124 <div class="lineNone">000097| </div>
125 <div class="lineNone">000098| let bitstring_of_file_descr_max fd max =</div>
126 <div class="lineAllUnvisited">000099| (*[0]*)let tmpsize = 16384 in</div>
127 <div class="lineAllUnvisited">000100| (*[0]*)let buf = Buffer.create tmpsize in</div>
128 <div class="lineAllUnvisited">000101| (*[0]*)let tmp = String.create tmpsize in</div>
129 <div class="lineAllUnvisited">000102| (*[0]*)let len = ref 0 in</div>
130 <div class="lineAllUnvisited">000103| (*[0]*)let rec loop () =</div>
131 <div class="lineAllUnvisited">000104| (*[0]*)if !len < max then (</div>
132 <div class="lineAllUnvisited">000105| (*[0]*)let r = min tmpsize (max - !len) in</div>
133 <div class="lineAllUnvisited">000106| (*[0]*)let n = Unix.read fd tmp 0 r in</div>
134 <div class="lineAllUnvisited">000107| (*[0]*)if n > 0 then (</div>
135 <div class="lineAllUnvisited">000108| (*[0]*)Buffer.add_substring buf tmp 0 n;</div>
136 <div class="lineAllUnvisited">000109| (*[0]*)len (*[0]*):= !len + n;</div>
137 <div class="lineAllUnvisited">000110| (*[0]*)loop ()</div>
138 <div class="lineNone">000111| )</div>
139 <div class="lineNone">000112| )</div>
140 <div class="lineNone">000113| in</div>
141 <div class="lineAllUnvisited">000114| (*[0]*)loop (*[0]*)();</div>
142 <div class="lineAllUnvisited">000115| (*[0]*)Buffer.contents buf, 0, !len lsl 3</div>
143 <div class="lineNone">000116| </div>
144 <div class="lineNone">000117| let bitstring_of_file fname =</div>
145 <div class="lineAllUnvisited">000118| (*[0]*)let chan = open_in_bin fname in</div>
146 <div class="lineAllUnvisited">000119| (*[0]*)try</div>
147 <div class="lineAllUnvisited">000120| (*[0]*)let bs = bitstring_of_chan chan in</div>
148 <div class="lineAllUnvisited">000121| (*[0]*)close_in (*[0]*)chan;</div>
149 <div class="lineAllUnvisited">000122| (*[0]*)bs</div>
150 <div class="lineNone">000123| with exn -></div>
151 <div class="lineAllUnvisited">000124| (*[0]*)close_in (*[0]*)chan;</div>
152 <div class="lineAllUnvisited">000125| (*[0]*)raise exn</div>
153 <div class="lineNone">000126| </div>
154 <div class="lineAllVisited">000127| let bitstring_length (_, _, len) = (*[1523677]*)len</div>
155 <div class="lineNone">000128| </div>
156 <div class="lineNone">000129| let subbitstring (data, off, len) off' len' =</div>
157 <div class="lineAllUnvisited">000130| (*[0]*)let off = off + off' in</div>
158 <div class="lineAllUnvisited">000131| (*[0]*)if len < off' + len' then (*[0]*)invalid_arg "subbitstring";</div>
159 <div class="lineAllUnvisited">000132| ((*[0]*)data, off, len')</div>
160 <div class="lineNone">000133| </div>
161 <div class="lineNone">000134| let dropbits n (data, off, len) =</div>
162 <div class="lineAllVisited">000135| (*[335487]*)let off = off + n in</div>
163 <div class="lineAllVisited">000136| (*[335487]*)let len = len - n in</div>
164 <div class="lineMixed">000137| (*[335487]*)if len < 0 then (*[0]*)invalid_arg "dropbits";</div>
165 <div class="lineAllVisited">000138| ((*[335487]*)data, off, len)</div>
166 <div class="lineNone">000139| </div>
167 <div class="lineNone">000140| let takebits n (data, off, len) =</div>
168 <div class="lineAllUnvisited">000141| (*[0]*)if len < n then (*[0]*)invalid_arg "takebits";</div>
169 <div class="lineAllUnvisited">000142| ((*[0]*)data, off, n)</div>
170 <div class="lineNone">000143| </div>
171 <div class="lineNone">000144| (*----------------------------------------------------------------------*)</div>
172 <div class="lineNone">000145| (* Bitwise functions.</div>
173 <div class="lineNone">000146| *</div>
174 <div class="lineNone">000147| * We try to isolate all bitwise functions within these modules.</div>
175 <div class="lineNone">000148| *)</div>
176 <div class="lineNone">000149| </div>
177 <div class="lineNone">000150| module I = struct</div>
178 <div class="lineNone">000151| (* Bitwise operations on ints. Note that we assume int <= 31 bits. *)</div>
179 <div class="lineNone">000152| external (<<<) : int -> int -> int = "%lslint"</div>
180 <div class="lineNone">000153| external (>>>) : int -> int -> int = "%lsrint"</div>
181 <div class="lineNone">000154| external to_int : int -> int = "%identity"</div>
182 <div class="lineAllVisited">000155| let zero = (*[28]*)0</div>
183 <div class="lineAllVisited">000156| let one = (*[28]*)1</div>
184 <div class="lineAllVisited">000157| let minus_one = (*[28]*)-1</div>
185 <div class="lineAllVisited">000158| let ff = (*[28]*)0xff</div>
186 <div class="lineNone">000159| </div>
187 <div class="lineNone">000160| (* Create a mask 0-31 bits wide. *)</div>
188 <div class="lineNone">000161| let mask bits =</div>
189 <div class="lineAllVisited">000162| (*[2]*)if bits < 30 then</div>
190 <div class="lineAllVisited">000163| ((*[2]*)one <<< bits) - 1</div>
191 <div class="lineAllUnvisited">000164| else (*[0]*)if bits = 30 then</div>
192 <div class="lineAllUnvisited">000165| (*[0]*)max_int</div>
193 <div class="lineAllUnvisited">000166| else (*[0]*)if bits = 31 then</div>
194 <div class="lineAllUnvisited">000167| (*[0]*)minus_one</div>
195 <div class="lineNone">000168| else</div>
196 <div class="lineAllUnvisited">000169| (*[0]*)invalid_arg "Bitstring.I.mask"</div>
197 <div class="lineNone">000170| </div>
198 <div class="lineNone">000171| (* Byte swap an int of a given size. *)</div>
199 <div class="lineNone">000172| let byteswap v bits =</div>
200 <div class="lineAllUnvisited">000173| (*[0]*)if bits <= 8 then (*[0]*)v</div>
201 <div class="lineAllUnvisited">000174| else (*[0]*)if bits <= 16 then (</div>
202 <div class="lineAllUnvisited">000175| (*[0]*)let shift = bits-8 in</div>
203 <div class="lineAllUnvisited">000176| (*[0]*)let v1 = v >>> shift in</div>
204 <div class="lineAllUnvisited">000177| (*[0]*)let v2 = ((v land (mask shift)) <<< 8) in</div>
205 <div class="lineAllUnvisited">000178| v2 (*[0]*)lor v1</div>
206 <div class="lineAllUnvisited">000179| ) else (*[0]*)if bits <= 24 then (</div>
207 <div class="lineAllUnvisited">000180| (*[0]*)let shift = bits - 16 in</div>
208 <div class="lineAllUnvisited">000181| (*[0]*)let v1 = v >>> (8+shift) in</div>
209 <div class="lineAllUnvisited">000182| (*[0]*)let v2 = ((v >>> shift) land ff) <<< 8 in</div>
210 <div class="lineAllUnvisited">000183| (*[0]*)let v3 = (v land (mask shift)) <<< 16 in</div>
211 <div class="lineAllUnvisited">000184| v3 lor v2 (*[0]*)lor v1</div>
212 <div class="lineNone">000185| ) else (</div>
213 <div class="lineAllUnvisited">000186| (*[0]*)let shift = bits - 24 in</div>
214 <div class="lineAllUnvisited">000187| (*[0]*)let v1 = v >>> (16+shift) in</div>
215 <div class="lineAllUnvisited">000188| (*[0]*)let v2 = ((v >>> (8+shift)) land ff) <<< 8 in</div>
216 <div class="lineAllUnvisited">000189| (*[0]*)let v3 = ((v >>> shift) land ff) <<< 16 in</div>
217 <div class="lineAllUnvisited">000190| (*[0]*)let v4 = (v land (mask shift)) <<< 24 in</div>
218 <div class="lineAllUnvisited">000191| v4 lor v3 lor v2 (*[0]*)lor v1</div>
219 <div class="lineNone">000192| )</div>
220 <div class="lineNone">000193| </div>
221 <div class="lineNone">000194| (* Check a value is in range 0 .. 2^bits-1. *)</div>
222 <div class="lineNone">000195| let range_unsigned v bits =</div>
223 <div class="lineAllVisited">000196| (*[2]*)let mask = lnot (mask bits) in</div>
224 <div class="lineAllVisited">000197| (v (*[2]*)land mask) = zero</div>
225 <div class="lineNone">000198| </div>
226 <div class="lineNone">000199| (* Call function g on the top bits, then f on each full byte</div>
227 <div class="lineNone">000200| * (big endian - so start at top).</div>
228 <div class="lineNone">000201| *)</div>
229 <div class="lineNone">000202| let rec map_bytes_be g f v bits =</div>
230 <div class="lineAllVisited">000203| (*[6]*)if bits >= 8 then (</div>
231 <div class="lineAllVisited">000204| (*[4]*)map_bytes_be g f (v >>> 8) (*[4]*)(bits-8);</div>
232 <div class="lineAllVisited">000205| (*[4]*)let lsb = v land ff in</div>
233 <div class="lineAllVisited">000206| (*[4]*)f (to_int lsb)</div>
234 <div class="lineAllVisited">000207| ) else (*[2]*)if bits > 0 then (</div>
235 <div class="lineAllUnvisited">000208| (*[0]*)let lsb = v land (mask bits) in</div>
236 <div class="lineAllUnvisited">000209| (*[0]*)g (to_int lsb) bits</div>
237 <div class="lineNone">000210| )</div>
238 <div class="lineNone">000211| </div>
239 <div class="lineNone">000212| (* Call function g on the top bits, then f on each full byte</div>
240 <div class="lineNone">000213| * (little endian - so start at root).</div>
241 <div class="lineNone">000214| *)</div>
242 <div class="lineNone">000215| let rec map_bytes_le g f v bits =</div>
243 <div class="lineAllUnvisited">000216| (*[0]*)if bits >= 8 then (</div>
244 <div class="lineAllUnvisited">000217| (*[0]*)let lsb = v land ff in</div>
245 <div class="lineAllUnvisited">000218| (*[0]*)f (*[0]*)(to_int lsb);</div>
246 <div class="lineAllUnvisited">000219| (*[0]*)map_bytes_le g f (v >>> 8) (bits-8)</div>
247 <div class="lineAllUnvisited">000220| ) else (*[0]*)if bits > 0 then (</div>
248 <div class="lineAllUnvisited">000221| (*[0]*)let lsb = v land (mask bits) in</div>
249 <div class="lineAllUnvisited">000222| (*[0]*)g (to_int lsb) bits</div>
250 <div class="lineNone">000223| )</div>
251 <div class="lineNone">000224| end</div>
252 <div class="lineNone">000225| </div>
253 <div class="lineNone">000226| module I32 = struct</div>
254 <div class="lineNone">000227| (* Bitwise operations on int32s. Note we try to keep it as similar</div>
255 <div class="lineNone">000228| * as possible to the I module above, to make it easier to track</div>
256 <div class="lineNone">000229| * down bugs.</div>
257 <div class="lineNone">000230| *)</div>
258 <div class="lineAllVisited">000231| let (<<<) = (*[28]*)Int32.shift_left</div>
259 <div class="lineAllVisited">000232| let (>>>) = (*[28]*)Int32.shift_right_logical</div>
260 <div class="lineAllVisited">000233| let (land) = (*[28]*)Int32.logand</div>
261 <div class="lineAllVisited">000234| let (lor) = (*[28]*)Int32.logor</div>
262 <div class="lineAllVisited">000235| let lnot = (*[28]*)Int32.lognot</div>
263 <div class="lineAllVisited">000236| let pred = (*[28]*)Int32.pred</div>
264 <div class="lineAllVisited">000237| let max_int = (*[28]*)Int32.max_int</div>
265 <div class="lineAllVisited">000238| let to_int = (*[28]*)Int32.to_int</div>
266 <div class="lineAllVisited">000239| let zero = (*[28]*)Int32.zero</div>
267 <div class="lineAllVisited">000240| let one = (*[28]*)Int32.one</div>
268 <div class="lineAllVisited">000241| let minus_one = (*[28]*)Int32.minus_one</div>
269 <div class="lineAllVisited">000242| let ff = (*[28]*)0xff_l</div>
270 <div class="lineNone">000243| </div>
271 <div class="lineNone">000244| (* Create a mask so many bits wide. *)</div>
272 <div class="lineNone">000245| let mask bits =</div>
273 <div class="lineAllVisited">000246| (*[12]*)if bits < 31 then</div>
274 <div class="lineAllVisited">000247| (*[12]*)pred (one <<< bits)</div>
275 <div class="lineAllUnvisited">000248| else (*[0]*)if bits = 31 then</div>
276 <div class="lineAllUnvisited">000249| (*[0]*)max_int</div>
277 <div class="lineAllUnvisited">000250| else (*[0]*)if bits = 32 then</div>
278 <div class="lineAllUnvisited">000251| (*[0]*)minus_one</div>
279 <div class="lineNone">000252| else</div>
280 <div class="lineAllUnvisited">000253| (*[0]*)invalid_arg "Bitstring.I32.mask"</div>
281 <div class="lineNone">000254| </div>
282 <div class="lineNone">000255| (* Byte swap an int of a given size. *)</div>
283 <div class="lineNone">000256| let byteswap v bits =</div>
284 <div class="lineMixed">000257| (*[12]*)if bits <= 8 then (*[0]*)v</div>
285 <div class="lineAllVisited">000258| else (*[12]*)if bits <= 16 then (</div>
286 <div class="lineAllUnvisited">000259| (*[0]*)let shift = bits-8 in</div>
287 <div class="lineAllUnvisited">000260| (*[0]*)let v1 = v >>> shift in</div>
288 <div class="lineAllUnvisited">000261| (*[0]*)let v2 = (v land (mask shift)) <<< 8 in</div>
289 <div class="lineAllUnvisited">000262| v2 (*[0]*)lor v1</div>
290 <div class="lineAllVisited">000263| ) else (*[12]*)if bits <= 24 then (</div>
291 <div class="lineAllUnvisited">000264| (*[0]*)let shift = bits - 16 in</div>
292 <div class="lineAllUnvisited">000265| (*[0]*)let v1 = v >>> (8+shift) in</div>
293 <div class="lineAllUnvisited">000266| (*[0]*)let v2 = ((v >>> shift) land ff) <<< 8 in</div>
294 <div class="lineAllUnvisited">000267| (*[0]*)let v3 = (v land (mask shift)) <<< 16 in</div>
295 <div class="lineAllUnvisited">000268| v3 lor v2 (*[0]*)lor v1</div>
296 <div class="lineNone">000269| ) else (</div>
297 <div class="lineAllVisited">000270| (*[12]*)let shift = bits - 24 in</div>
298 <div class="lineAllVisited">000271| (*[12]*)let v1 = v >>> (16+shift) in</div>
299 <div class="lineAllVisited">000272| (*[12]*)let v2 = ((v >>> (8+shift)) land ff) <<< 8 in</div>
300 <div class="lineAllVisited">000273| (*[12]*)let v3 = ((v >>> shift) land ff) <<< 16 in</div>
301 <div class="lineAllVisited">000274| (*[12]*)let v4 = (v land (mask shift)) <<< 24 in</div>
302 <div class="lineAllVisited">000275| v4 lor v3 lor v2 (*[12]*)lor v1</div>
303 <div class="lineNone">000276| )</div>
304 <div class="lineNone">000277| </div>
305 <div class="lineNone">000278| (* Check a value is in range 0 .. 2^bits-1. *)</div>
306 <div class="lineNone">000279| let range_unsigned v bits =</div>
307 <div class="lineAllUnvisited">000280| (*[0]*)let mask = lnot (mask bits) in</div>
308 <div class="lineAllUnvisited">000281| (v (*[0]*)land mask) = zero</div>
309 <div class="lineNone">000282| </div>
310 <div class="lineNone">000283| (* Call function g on the top bits, then f on each full byte</div>
311 <div class="lineNone">000284| * (big endian - so start at top).</div>
312 <div class="lineNone">000285| *)</div>
313 <div class="lineNone">000286| let rec map_bytes_be g f v bits =</div>
314 <div class="lineAllUnvisited">000287| (*[0]*)if bits >= 8 then (</div>
315 <div class="lineAllUnvisited">000288| (*[0]*)map_bytes_be g f (v >>> 8) (*[0]*)(bits-8);</div>
316 <div class="lineAllUnvisited">000289| (*[0]*)let lsb = v land ff in</div>
317 <div class="lineAllUnvisited">000290| (*[0]*)f (to_int lsb)</div>
318 <div class="lineAllUnvisited">000291| ) else (*[0]*)if bits > 0 then (</div>
319 <div class="lineAllUnvisited">000292| (*[0]*)let lsb = v land (mask bits) in</div>
320 <div class="lineAllUnvisited">000293| (*[0]*)g (to_int lsb) bits</div>
321 <div class="lineNone">000294| )</div>
322 <div class="lineNone">000295| </div>
323 <div class="lineNone">000296| (* Call function g on the top bits, then f on each full byte</div>
324 <div class="lineNone">000297| * (little endian - so start at root).</div>
325 <div class="lineNone">000298| *)</div>
326 <div class="lineNone">000299| let rec map_bytes_le g f v bits =</div>
327 <div class="lineAllUnvisited">000300| (*[0]*)if bits >= 8 then (</div>
328 <div class="lineAllUnvisited">000301| (*[0]*)let lsb = v land ff in</div>
329 <div class="lineAllUnvisited">000302| (*[0]*)f (*[0]*)(to_int lsb);</div>
330 <div class="lineAllUnvisited">000303| (*[0]*)map_bytes_le g f (v >>> 8) (bits-8)</div>
331 <div class="lineAllUnvisited">000304| ) else (*[0]*)if bits > 0 then (</div>
332 <div class="lineAllUnvisited">000305| (*[0]*)let lsb = v land (mask bits) in</div>
333 <div class="lineAllUnvisited">000306| (*[0]*)g (to_int lsb) bits</div>
334 <div class="lineNone">000307| )</div>
335 <div class="lineNone">000308| end</div>
336 <div class="lineNone">000309| </div>
337 <div class="lineNone">000310| module I64 = struct</div>
338 <div class="lineNone">000311| (* Bitwise operations on int64s. Note we try to keep it as similar</div>
339 <div class="lineNone">000312| * as possible to the I/I32 modules above, to make it easier to track</div>
340 <div class="lineNone">000313| * down bugs.</div>
341 <div class="lineNone">000314| *)</div>
342 <div class="lineAllVisited">000315| let (<<<) = (*[28]*)Int64.shift_left</div>
343 <div class="lineAllVisited">000316| let (>>>) = (*[28]*)Int64.shift_right_logical</div>
344 <div class="lineAllVisited">000317| let (land) = (*[28]*)Int64.logand</div>
345 <div class="lineAllVisited">000318| let (lor) = (*[28]*)Int64.logor</div>
346 <div class="lineAllVisited">000319| let lnot = (*[28]*)Int64.lognot</div>
347 <div class="lineAllVisited">000320| let pred = (*[28]*)Int64.pred</div>
348 <div class="lineAllVisited">000321| let max_int = (*[28]*)Int64.max_int</div>
349 <div class="lineAllVisited">000322| let to_int = (*[28]*)Int64.to_int</div>
350 <div class="lineAllVisited">000323| let zero = (*[28]*)Int64.zero</div>
351 <div class="lineAllVisited">000324| let one = (*[28]*)Int64.one</div>
352 <div class="lineAllVisited">000325| let minus_one = (*[28]*)Int64.minus_one</div>
353 <div class="lineAllVisited">000326| let ff = (*[28]*)0xff_L</div>
354 <div class="lineNone">000327| </div>
355 <div class="lineNone">000328| (* Create a mask so many bits wide. *)</div>
356 <div class="lineNone">000329| let mask bits =</div>
357 <div class="lineAllVisited">000330| (*[669050]*)if bits < 63 then</div>
358 <div class="lineAllVisited">000331| (*[664100]*)pred (one <<< bits)</div>
359 <div class="lineAllVisited">000332| else (*[4950]*)if bits = 63 then</div>
360 <div class="lineAllVisited">000333| (*[4950]*)max_int</div>
361 <div class="lineAllUnvisited">000334| else (*[0]*)if bits = 64 then</div>
362 <div class="lineAllUnvisited">000335| (*[0]*)minus_one</div>
363 <div class="lineNone">000336| else</div>
364 <div class="lineAllUnvisited">000337| (*[0]*)invalid_arg "Bitstring.I64.mask"</div>
365 <div class="lineNone">000338| </div>
366 <div class="lineNone">000339| (* Byte swap an int of a given size. *)</div>
367 <div class="lineNone">000340| (* let byteswap v bits = *)</div>
368 <div class="lineNone">000341| </div>
369 <div class="lineNone">000342| (* Check a value is in range 0 .. 2^bits-1. *)</div>
370 <div class="lineNone">000343| let range_unsigned v bits =</div>
371 <div class="lineAllVisited">000344| (*[351850]*)let mask = lnot (mask bits) in</div>
372 <div class="lineAllVisited">000345| (v (*[351850]*)land mask) = zero</div>
373 <div class="lineNone">000346| </div>
374 <div class="lineNone">000347| (* Call function g on the top bits, then f on each full byte</div>
375 <div class="lineNone">000348| * (big endian - so start at top).</div>
376 <div class="lineNone">000349| *)</div>
377 <div class="lineNone">000350| let rec map_bytes_be g f v bits =</div>
378 <div class="lineAllVisited">000351| (*[1460650]*)if bits >= 8 then (</div>
379 <div class="lineAllVisited">000352| (*[1108800]*)map_bytes_be g f (v >>> 8) (*[1108800]*)(bits-8);</div>
380 <div class="lineAllVisited">000353| (*[1108800]*)let lsb = v land ff in</div>
381 <div class="lineAllVisited">000354| (*[1108800]*)f (to_int lsb)</div>
382 <div class="lineAllVisited">000355| ) else (*[34650]*)if bits > 0 then (</div>
383 <div class="lineAllVisited">000356| (*[317200]*)let lsb = v land (mask bits) in</div>
384 <div class="lineAllVisited">000357| (*[317200]*)g (to_int lsb) bits</div>
385 <div class="lineNone">000358| )</div>
386 <div class="lineNone">000359| </div>
387 <div class="lineNone">000360| (* Call function g on the top bits, then f on each full byte</div>
388 <div class="lineNone">000361| * (little endian - so start at root).</div>
389 <div class="lineNone">000362| *)</div>
390 <div class="lineNone">000363| let rec map_bytes_le g f v bits =</div>
391 <div class="lineAllUnvisited">000364| (*[0]*)if bits >= 8 then (</div>
392 <div class="lineAllUnvisited">000365| (*[0]*)let lsb = v land ff in</div>
393 <div class="lineAllUnvisited">000366| (*[0]*)f (*[0]*)(to_int lsb);</div>
394 <div class="lineAllUnvisited">000367| (*[0]*)map_bytes_le g f (v >>> 8) (bits-8)</div>
395 <div class="lineAllUnvisited">000368| ) else (*[0]*)if bits > 0 then (</div>
396 <div class="lineAllUnvisited">000369| (*[0]*)let lsb = v land (mask bits) in</div>
397 <div class="lineAllUnvisited">000370| (*[0]*)g (to_int lsb) bits</div>
398 <div class="lineNone">000371| )</div>
399 <div class="lineNone">000372| end</div>
400 <div class="lineNone">000373| </div>
401 <div class="lineNone">000374| (*----------------------------------------------------------------------*)</div>
402 <div class="lineNone">000375| (* Extraction functions.</div>
403 <div class="lineNone">000376| *</div>
404 <div class="lineNone">000377| * NB: internal functions, called from the generated macros, and</div>
405 <div class="lineNone">000378| * the parameters should have been checked for sanity already).</div>
406 <div class="lineNone">000379| *)</div>
407 <div class="lineNone">000380| </div>
408 <div class="lineNone">000381| (* Extract and convert to numeric. A single bit is returned as</div>
409 <div class="lineNone">000382| * a boolean. There are no endianness or signedness considerations.</div>
410 <div class="lineNone">000383| *)</div>
411 <div class="lineNone">000384| let extract_bit data off len _ = (* final param is always 1 *)</div>
412 <div class="lineAllVisited">000385| (*[2515152]*)let byteoff = off lsr 3 in</div>
413 <div class="lineAllVisited">000386| (*[2515152]*)let bitmask = 1 lsl (7 - (off land 7)) in</div>
414 <div class="lineAllVisited">000387| (*[2515152]*)let b = Char.code data.[byteoff] land bitmask <> 0 in</div>
415 <div class="lineAllVisited">000388| (*[2515152]*)b (*, off+1, len-1*)</div>
416 <div class="lineNone">000389| </div>
417 <div class="lineNone">000390| (* Returns 8 bit unsigned aligned bytes from the string.</div>
418 <div class="lineNone">000391| * If the string ends then this returns 0's.</div>
419 <div class="lineNone">000392| *)</div>
420 <div class="lineNone">000393| let _get_byte data byteoff strlen =</div>
421 <div class="lineAllVisited">000394| (*[9813846]*)if strlen > byteoff then (*[9247619]*)Char.code data.[byteoff] else (*[566227]*)0</div>
422 <div class="lineNone">000395| let _get_byte32 data byteoff strlen =</div>
423 <div class="lineMixed">000396| (*[72]*)if strlen > byteoff then (*[72]*)Int32.of_int (Char.code data.[byteoff]) else (*[0]*)0l</div>
424 <div class="lineNone">000397| let _get_byte64 data byteoff strlen =</div>
425 <div class="lineAllVisited">000398| (*[1626200]*)if strlen > byteoff then (*[1517793]*)Int64.of_int (Char.code data.[byteoff]) else (*[108407]*)0L</div>
426 <div class="lineNone">000399| </div>
427 <div class="lineNone">000400| (* Extract [2..8] bits. Because the result fits into a single</div>
428 <div class="lineNone">000401| * byte we don't have to worry about endianness, only signedness.</div>
429 <div class="lineNone">000402| *)</div>
430 <div class="lineNone">000403| let extract_char_unsigned data off len flen =</div>
431 <div class="lineAllVisited">000404| (*[5009970]*)let byteoff = off lsr 3 in</div>
432 <div class="lineNone">000405| </div>
433 <div class="lineNone">000406| (* Optimize the common (byte-aligned) case. *)</div>
434 <div class="lineAllVisited">000407| (*[5009970]*)if off land 7 = 0 then (</div>
435 <div class="lineAllVisited">000408| (*[103047]*)let byte = Char.code data.[byteoff] in</div>
436 <div class="lineAllVisited">000409| byte (*[103047]*)lsr (8 - flen) (*, off+flen, len-flen*)</div>
437 <div class="lineNone">000410| ) else (</div>
438 <div class="lineNone">000411| (* Extract the 16 bits at byteoff and byteoff+1 (note that the</div>
439 <div class="lineNone">000412| * second byte might not exist in the original string).</div>
440 <div class="lineNone">000413| *)</div>
441 <div class="lineAllVisited">000414| (*[4906923]*)let strlen = String.length data in</div>
442 <div class="lineNone">000415| </div>
443 <div class="lineAllVisited">000416| (*[4906923]*)let word =</div>
444 <div class="lineNone">000417| (_get_byte data byteoff strlen lsl 8) +</div>
445 <div class="lineNone">000418| _get_byte data (byteoff+1) strlen in</div>
446 <div class="lineNone">000419| </div>
447 <div class="lineNone">000420| (* Mask off the top bits. *)</div>
448 <div class="lineAllVisited">000421| (*[4906923]*)let bitmask = (1 lsl (16 - (off land 7))) - 1 in</div>
449 <div class="lineAllVisited">000422| (*[4906923]*)let word = word land bitmask in</div>
450 <div class="lineNone">000423| (* Shift right to get rid of the bottom bits. *)</div>
451 <div class="lineAllVisited">000424| (*[4906923]*)let shift = 16 - ((off land 7) + flen) in</div>
452 <div class="lineAllVisited">000425| (*[4906923]*)let word = word lsr shift in</div>
453 <div class="lineNone">000426| </div>
454 <div class="lineAllVisited">000427| (*[4906923]*)word (*, off+flen, len-flen*)</div>
455 <div class="lineNone">000428| )</div>
456 <div class="lineNone">000429| </div>
457 <div class="lineNone">000430| (* Extract [9..31] bits. We have to consider endianness and signedness. *)</div>
458 <div class="lineNone">000431| let extract_int_be_unsigned data off len flen =</div>
459 <div class="lineAllUnvisited">000432| (*[0]*)let byteoff = off lsr 3 in</div>
460 <div class="lineNone">000433| </div>
461 <div class="lineAllUnvisited">000434| (*[0]*)let strlen = String.length data in</div>
462 <div class="lineNone">000435| </div>
463 <div class="lineAllUnvisited">000436| (*[0]*)let word =</div>
464 <div class="lineNone">000437| (* Optimize the common (byte-aligned) case. *)</div>
465 <div class="lineNone">000438| if off land 7 = 0 then (</div>
466 <div class="lineAllUnvisited">000439| (*[0]*)let word =</div>
467 <div class="lineNone">000440| (_get_byte data byteoff strlen lsl 23) +</div>
468 <div class="lineNone">000441| (_get_byte data (byteoff+1) strlen lsl 15) +</div>
469 <div class="lineNone">000442| (_get_byte data (byteoff+2) strlen lsl 7) +</div>
470 <div class="lineNone">000443| (_get_byte data (byteoff+3) strlen lsr 1) in</div>
471 <div class="lineAllUnvisited">000444| word (*[0]*)lsr (31 - flen)</div>
472 <div class="lineAllUnvisited">000445| ) else (*[0]*)if flen <= 24 then (</div>
473 <div class="lineNone">000446| (* Extract the 31 bits at byteoff .. byteoff+3. *)</div>
474 <div class="lineAllUnvisited">000447| (*[0]*)let word =</div>
475 <div class="lineNone">000448| (_get_byte data byteoff strlen lsl 23) +</div>
476 <div class="lineNone">000449| (_get_byte data (byteoff+1) strlen lsl 15) +</div>
477 <div class="lineNone">000450| (_get_byte data (byteoff+2) strlen lsl 7) +</div>
478 <div class="lineNone">000451| (_get_byte data (byteoff+3) strlen lsr 1) in</div>
479 <div class="lineNone">000452| (* Mask off the top bits. *)</div>
480 <div class="lineAllUnvisited">000453| (*[0]*)let bitmask = (1 lsl (31 - (off land 7))) - 1 in</div>
481 <div class="lineAllUnvisited">000454| (*[0]*)let word = word land bitmask in</div>
482 <div class="lineNone">000455| (* Shift right to get rid of the bottom bits. *)</div>
483 <div class="lineAllUnvisited">000456| (*[0]*)let shift = 31 - ((off land 7) + flen) in</div>
484 <div class="lineAllUnvisited">000457| word (*[0]*)lsr shift</div>
485 <div class="lineNone">000458| ) else (</div>
486 <div class="lineNone">000459| (* Extract the next 31 bits, slow method. *)</div>
487 <div class="lineAllUnvisited">000460| (*[0]*)let word =</div>
488 <div class="lineNone">000461| let c0 = extract_char_unsigned data off len 8</div>
489 <div class="lineNone">000462| and off = off + 8 and len = len - 8 in</div>
490 <div class="lineAllUnvisited">000463| (*[0]*)let c1 = extract_char_unsigned data off len 8</div>
491 <div class="lineNone">000464| and off = off + 8 and len = len - 8 in</div>
492 <div class="lineAllUnvisited">000465| (*[0]*)let c2 = extract_char_unsigned data off len 8</div>
493 <div class="lineNone">000466| and off = off + 8 and len = len - 8 in</div>
494 <div class="lineAllUnvisited">000467| (*[0]*)let c3 = extract_char_unsigned data off len 7 in</div>
495 <div class="lineAllUnvisited">000468| (c0 (*[0]*)lsl 23) + (c1 lsl 15) + (c2 lsl 7) + c3 in</div>
496 <div class="lineAllUnvisited">000469| word (*[0]*)lsr (31 - flen)</div>
497 <div class="lineNone">000470| ) in</div>
498 <div class="lineAllUnvisited">000471| (*[0]*)word (*, off+flen, len-flen*)</div>
499 <div class="lineNone">000472| </div>
500 <div class="lineNone">000473| let extract_int_le_unsigned data off len flen =</div>
501 <div class="lineAllUnvisited">000474| (*[0]*)let v = extract_int_be_unsigned data off len flen in</div>
502 <div class="lineAllUnvisited">000475| (*[0]*)let v = I.byteswap v flen in</div>
503 <div class="lineAllUnvisited">000476| (*[0]*)v</div>
504 <div class="lineNone">000477| </div>
505 <div class="lineNone">000478| let extract_int_ne_unsigned =</div>
506 <div class="lineAllVisited">000479| (*[28]*)if nativeendian = BigEndian</div>
507 <div class="lineAllUnvisited">000480| then (*[0]*)extract_int_be_unsigned</div>
508 <div class="lineAllVisited">000481| else (*[28]*)extract_int_le_unsigned</div>
509 <div class="lineNone">000482| </div>
510 <div class="lineNone">000483| let extract_int_ee_unsigned = function</div>
511 <div class="lineAllUnvisited">000484| | BigEndian -> (*[0]*)extract_int_be_unsigned</div>
512 <div class="lineAllUnvisited">000485| | LittleEndian -> (*[0]*)extract_int_le_unsigned</div>
513 <div class="lineAllUnvisited">000486| | NativeEndian -> (*[0]*)extract_int_ne_unsigned</div>
514 <div class="lineNone">000487| </div>
515 <div class="lineNone">000488| let _make_int32_be c0 c1 c2 c3 =</div>
516 <div class="lineAllVisited">000489| (*[18]*)Int32.logor</div>
517 <div class="lineNone">000490| (Int32.logor</div>
518 <div class="lineNone">000491| (Int32.logor</div>
519 <div class="lineNone">000492| (Int32.shift_left c0 24)</div>
520 <div class="lineNone">000493| (Int32.shift_left c1 16))</div>
521 <div class="lineNone">000494| (Int32.shift_left c2 8))</div>
522 <div class="lineNone">000495| c3</div>
523 <div class="lineNone">000496| </div>
524 <div class="lineNone">000497| let _make_int32_le c0 c1 c2 c3 =</div>
525 <div class="lineAllUnvisited">000498| (*[0]*)Int32.logor</div>
526 <div class="lineNone">000499| (Int32.logor</div>
527 <div class="lineNone">000500| (Int32.logor</div>
528 <div class="lineNone">000501| (Int32.shift_left c3 24)</div>
529 <div class="lineNone">000502| (Int32.shift_left c2 16))</div>
530 <div class="lineNone">000503| (Int32.shift_left c1 8))</div>
531 <div class="lineNone">000504| c0</div>
532 <div class="lineNone">000505| </div>
533 <div class="lineNone">000506| (* Extract exactly 32 bits. We have to consider endianness and signedness. *)</div>
534 <div class="lineNone">000507| let extract_int32_be_unsigned data off len flen =</div>
535 <div class="lineAllVisited">000508| (*[18]*)let byteoff = off lsr 3 in</div>
536 <div class="lineNone">000509| </div>
537 <div class="lineAllVisited">000510| (*[18]*)let strlen = String.length data in</div>
538 <div class="lineNone">000511| </div>
539 <div class="lineAllVisited">000512| (*[18]*)let word =</div>
540 <div class="lineNone">000513| (* Optimize the common (byte-aligned) case. *)</div>
541 <div class="lineNone">000514| if off land 7 = 0 then (</div>
542 <div class="lineAllVisited">000515| (*[18]*)let word =</div>
543 <div class="lineNone">000516| let c0 = _get_byte32 data byteoff strlen in</div>
544 <div class="lineAllVisited">000517| (*[18]*)let c1 = _get_byte32 data (byteoff+1) strlen in</div>
545 <div class="lineAllVisited">000518| (*[18]*)let c2 = _get_byte32 data (byteoff+2) strlen in</div>
546 <div class="lineAllVisited">000519| (*[18]*)let c3 = _get_byte32 data (byteoff+3) strlen in</div>
547 <div class="lineAllVisited">000520| (*[18]*)_make_int32_be c0 c1 c2 c3 in</div>
548 <div class="lineAllVisited">000521| (*[18]*)Int32.shift_right_logical word (32 - flen)</div>
549 <div class="lineNone">000522| ) else (</div>
550 <div class="lineNone">000523| (* Extract the next 32 bits, slow method. *)</div>
551 <div class="lineAllUnvisited">000524| (*[0]*)let word =</div>
552 <div class="lineNone">000525| let c0 = extract_char_unsigned data off len 8</div>
553 <div class="lineNone">000526| and off = off + 8 and len = len - 8 in</div>
554 <div class="lineAllUnvisited">000527| (*[0]*)let c1 = extract_char_unsigned data off len 8</div>
555 <div class="lineNone">000528| and off = off + 8 and len = len - 8 in</div>
556 <div class="lineAllUnvisited">000529| (*[0]*)let c2 = extract_char_unsigned data off len 8</div>
557 <div class="lineNone">000530| and off = off + 8 and len = len - 8 in</div>
558 <div class="lineAllUnvisited">000531| (*[0]*)let c3 = extract_char_unsigned data off len 8 in</div>
559 <div class="lineAllUnvisited">000532| (*[0]*)let c0 = Int32.of_int c0 in</div>
560 <div class="lineAllUnvisited">000533| (*[0]*)let c1 = Int32.of_int c1 in</div>
561 <div class="lineAllUnvisited">000534| (*[0]*)let c2 = Int32.of_int c2 in</div>
562 <div class="lineAllUnvisited">000535| (*[0]*)let c3 = Int32.of_int c3 in</div>
563 <div class="lineAllUnvisited">000536| (*[0]*)_make_int32_be c0 c1 c2 c3 in</div>
564 <div class="lineAllUnvisited">000537| (*[0]*)Int32.shift_right_logical word (32 - flen)</div>
565 <div class="lineNone">000538| ) in</div>
566 <div class="lineAllVisited">000539| (*[18]*)word (*, off+flen, len-flen*)</div>
567 <div class="lineNone">000540| </div>
568 <div class="lineNone">000541| let extract_int32_le_unsigned data off len flen =</div>
569 <div class="lineAllVisited">000542| (*[12]*)let v = extract_int32_be_unsigned data off len flen in</div>
570 <div class="lineAllVisited">000543| (*[12]*)let v = I32.byteswap v flen in</div>
571 <div class="lineAllVisited">000544| (*[12]*)v</div>
572 <div class="lineNone">000545| </div>
573 <div class="lineNone">000546| let extract_int32_ne_unsigned =</div>
574 <div class="lineAllVisited">000547| (*[28]*)if nativeendian = BigEndian</div>
575 <div class="lineAllUnvisited">000548| then (*[0]*)extract_int32_be_unsigned</div>
576 <div class="lineAllVisited">000549| else (*[28]*)extract_int32_le_unsigned</div>
577 <div class="lineNone">000550| </div>
578 <div class="lineNone">000551| let extract_int32_ee_unsigned = function</div>
579 <div class="lineAllVisited">000552| | BigEndian -> (*[6]*)extract_int32_be_unsigned</div>
580 <div class="lineAllVisited">000553| | LittleEndian -> (*[6]*)extract_int32_le_unsigned</div>
581 <div class="lineAllVisited">000554| | NativeEndian -> (*[6]*)extract_int32_ne_unsigned</div>
582 <div class="lineNone">000555| </div>
583 <div class="lineNone">000556| let _make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 =</div>
584 <div class="lineAllVisited">000557| (*[657463]*)Int64.logor</div>
585 <div class="lineNone">000558| (Int64.logor</div>
586 <div class="lineNone">000559| (Int64.logor</div>
587 <div class="lineNone">000560| (Int64.logor</div>
588 <div class="lineNone">000561| (Int64.logor</div>
589 <div class="lineNone">000562| (Int64.logor</div>
590 <div class="lineNone">000563| (Int64.logor</div>
591 <div class="lineNone">000564| (Int64.shift_left c0 56)</div>
592 <div class="lineNone">000565| (Int64.shift_left c1 48))</div>
593 <div class="lineNone">000566| (Int64.shift_left c2 40))</div>
594 <div class="lineNone">000567| (Int64.shift_left c3 32))</div>
595 <div class="lineNone">000568| (Int64.shift_left c4 24))</div>
596 <div class="lineNone">000569| (Int64.shift_left c5 16))</div>
597 <div class="lineNone">000570| (Int64.shift_left c6 8))</div>
598 <div class="lineNone">000571| c7</div>
599 <div class="lineNone">000572| </div>
600 <div class="lineNone">000573| let _make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 =</div>
601 <div class="lineAllUnvisited">000574| (*[0]*)_make_int64_be c7 c6 c5 c4 c3 c2 c1 c0</div>
602 <div class="lineNone">000575| </div>
603 <div class="lineNone">000576| (* Extract [1..64] bits. We have to consider endianness and signedness. *)</div>
604 <div class="lineNone">000577| let extract_int64_be_unsigned data off len flen =</div>
605 <div class="lineAllVisited">000578| (*[657463]*)let byteoff = off lsr 3 in</div>
606 <div class="lineNone">000579| </div>
607 <div class="lineAllVisited">000580| (*[657463]*)let strlen = String.length data in</div>
608 <div class="lineNone">000581| </div>
609 <div class="lineAllVisited">000582| (*[657463]*)let word =</div>
610 <div class="lineNone">000583| (* Optimize the common (byte-aligned) case. *)</div>
611 <div class="lineNone">000584| if off land 7 = 0 then (</div>
612 <div class="lineAllVisited">000585| (*[203275]*)let word =</div>
613 <div class="lineNone">000586| let c0 = _get_byte64 data byteoff strlen in</div>
614 <div class="lineAllVisited">000587| (*[203275]*)let c1 = _get_byte64 data (byteoff+1) strlen in</div>
615 <div class="lineAllVisited">000588| (*[203275]*)let c2 = _get_byte64 data (byteoff+2) strlen in</div>
616 <div class="lineAllVisited">000589| (*[203275]*)let c3 = _get_byte64 data (byteoff+3) strlen in</div>
617 <div class="lineAllVisited">000590| (*[203275]*)let c4 = _get_byte64 data (byteoff+4) strlen in</div>
618 <div class="lineAllVisited">000591| (*[203275]*)let c5 = _get_byte64 data (byteoff+5) strlen in</div>
619 <div class="lineAllVisited">000592| (*[203275]*)let c6 = _get_byte64 data (byteoff+6) strlen in</div>
620 <div class="lineAllVisited">000593| (*[203275]*)let c7 = _get_byte64 data (byteoff+7) strlen in</div>
621 <div class="lineAllVisited">000594| (*[203275]*)_make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in</div>
622 <div class="lineAllVisited">000595| (*[203275]*)Int64.shift_right_logical word (64 - flen)</div>
623 <div class="lineNone">000596| ) else (</div>
624 <div class="lineNone">000597| (* Extract the next 64 bits, slow method. *)</div>
625 <div class="lineAllVisited">000598| (*[454188]*)let word =</div>
626 <div class="lineNone">000599| let c0 = extract_char_unsigned data off len 8</div>
627 <div class="lineNone">000600| and off = off + 8 and len = len - 8 in</div>
628 <div class="lineAllVisited">000601| (*[454188]*)let c1 = extract_char_unsigned data off len 8</div>
629 <div class="lineNone">000602| and off = off + 8 and len = len - 8 in</div>
630 <div class="lineAllVisited">000603| (*[454188]*)let c2 = extract_char_unsigned data off len 8</div>
631 <div class="lineNone">000604| and off = off + 8 and len = len - 8 in</div>
632 <div class="lineAllVisited">000605| (*[454188]*)let c3 = extract_char_unsigned data off len 8</div>
633 <div class="lineNone">000606| and off = off + 8 and len = len - 8 in</div>
634 <div class="lineAllVisited">000607| (*[454188]*)let c4 = extract_char_unsigned data off len 8</div>
635 <div class="lineNone">000608| and off = off + 8 and len = len - 8 in</div>
636 <div class="lineAllVisited">000609| (*[454188]*)let c5 = extract_char_unsigned data off len 8</div>
637 <div class="lineNone">000610| and off = off + 8 and len = len - 8 in</div>
638 <div class="lineAllVisited">000611| (*[454188]*)let c6 = extract_char_unsigned data off len 8</div>
639 <div class="lineNone">000612| and off = off + 8 and len = len - 8 in</div>
640 <div class="lineAllVisited">000613| (*[454188]*)let c7 = extract_char_unsigned data off len 8 in</div>
641 <div class="lineAllVisited">000614| (*[454188]*)let c0 = Int64.of_int c0 in</div>
642 <div class="lineAllVisited">000615| (*[454188]*)let c1 = Int64.of_int c1 in</div>
643 <div class="lineAllVisited">000616| (*[454188]*)let c2 = Int64.of_int c2 in</div>
644 <div class="lineAllVisited">000617| (*[454188]*)let c3 = Int64.of_int c3 in</div>
645 <div class="lineAllVisited">000618| (*[454188]*)let c4 = Int64.of_int c4 in</div>
646 <div class="lineAllVisited">000619| (*[454188]*)let c5 = Int64.of_int c5 in</div>
647 <div class="lineAllVisited">000620| (*[454188]*)let c6 = Int64.of_int c6 in</div>
648 <div class="lineAllVisited">000621| (*[454188]*)let c7 = Int64.of_int c7 in</div>
649 <div class="lineAllVisited">000622| (*[454188]*)_make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in</div>
650 <div class="lineAllVisited">000623| (*[454188]*)Int64.shift_right_logical word (64 - flen)</div>
651 <div class="lineNone">000624| ) in</div>
652 <div class="lineAllVisited">000625| (*[657463]*)word (*, off+flen, len-flen*)</div>
653 <div class="lineNone">000626| </div>
654 <div class="lineNone">000627| let extract_int64_le_unsigned data off len flen =</div>
655 <div class="lineAllUnvisited">000628| (*[0]*)let byteoff = off lsr 3 in</div>
656 <div class="lineNone">000629| </div>
657 <div class="lineAllUnvisited">000630| (*[0]*)let strlen = String.length data in</div>
658 <div class="lineNone">000631| </div>
659 <div class="lineAllUnvisited">000632| (*[0]*)let word =</div>
660 <div class="lineNone">000633| (* Optimize the common (byte-aligned) case. *)</div>
661 <div class="lineNone">000634| if off land 7 = 0 then (</div>
662 <div class="lineAllUnvisited">000635| (*[0]*)let word =</div>
663 <div class="lineNone">000636| let c0 = _get_byte64 data byteoff strlen in</div>
664 <div class="lineAllUnvisited">000637| (*[0]*)let c1 = _get_byte64 data (byteoff+1) strlen in</div>
665 <div class="lineAllUnvisited">000638| (*[0]*)let c2 = _get_byte64 data (byteoff+2) strlen in</div>
666 <div class="lineAllUnvisited">000639| (*[0]*)let c3 = _get_byte64 data (byteoff+3) strlen in</div>
667 <div class="lineAllUnvisited">000640| (*[0]*)let c4 = _get_byte64 data (byteoff+4) strlen in</div>
668 <div class="lineAllUnvisited">000641| (*[0]*)let c5 = _get_byte64 data (byteoff+5) strlen in</div>
669 <div class="lineAllUnvisited">000642| (*[0]*)let c6 = _get_byte64 data (byteoff+6) strlen in</div>
670 <div class="lineAllUnvisited">000643| (*[0]*)let c7 = _get_byte64 data (byteoff+7) strlen in</div>
671 <div class="lineAllUnvisited">000644| (*[0]*)_make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in</div>
672 <div class="lineAllUnvisited">000645| (*[0]*)Int64.logand word (I64.mask flen)</div>
673 <div class="lineNone">000646| ) else (</div>
674 <div class="lineNone">000647| (* Extract the next 64 bits, slow method. *)</div>
675 <div class="lineAllUnvisited">000648| (*[0]*)let word =</div>
676 <div class="lineNone">000649| let c0 = extract_char_unsigned data off len 8</div>
677 <div class="lineNone">000650| and off = off + 8 and len = len - 8 in</div>
678 <div class="lineAllUnvisited">000651| (*[0]*)let c1 = extract_char_unsigned data off len 8</div>
679 <div class="lineNone">000652| and off = off + 8 and len = len - 8 in</div>
680 <div class="lineAllUnvisited">000653| (*[0]*)let c2 = extract_char_unsigned data off len 8</div>
681 <div class="lineNone">000654| and off = off + 8 and len = len - 8 in</div>
682 <div class="lineAllUnvisited">000655| (*[0]*)let c3 = extract_char_unsigned data off len 8</div>
683 <div class="lineNone">000656| and off = off + 8 and len = len - 8 in</div>
684 <div class="lineAllUnvisited">000657| (*[0]*)let c4 = extract_char_unsigned data off len 8</div>
685 <div class="lineNone">000658| and off = off + 8 and len = len - 8 in</div>
686 <div class="lineAllUnvisited">000659| (*[0]*)let c5 = extract_char_unsigned data off len 8</div>
687 <div class="lineNone">000660| and off = off + 8 and len = len - 8 in</div>
688 <div class="lineAllUnvisited">000661| (*[0]*)let c6 = extract_char_unsigned data off len 8</div>
689 <div class="lineNone">000662| and off = off + 8 and len = len - 8 in</div>
690 <div class="lineAllUnvisited">000663| (*[0]*)let c7 = extract_char_unsigned data off len 8 in</div>
691 <div class="lineAllUnvisited">000664| (*[0]*)let c0 = Int64.of_int c0 in</div>
692 <div class="lineAllUnvisited">000665| (*[0]*)let c1 = Int64.of_int c1 in</div>
693 <div class="lineAllUnvisited">000666| (*[0]*)let c2 = Int64.of_int c2 in</div>
694 <div class="lineAllUnvisited">000667| (*[0]*)let c3 = Int64.of_int c3 in</div>
695 <div class="lineAllUnvisited">000668| (*[0]*)let c4 = Int64.of_int c4 in</div>
696 <div class="lineAllUnvisited">000669| (*[0]*)let c5 = Int64.of_int c5 in</div>
697 <div class="lineAllUnvisited">000670| (*[0]*)let c6 = Int64.of_int c6 in</div>
698 <div class="lineAllUnvisited">000671| (*[0]*)let c7 = Int64.of_int c7 in</div>
699 <div class="lineAllUnvisited">000672| (*[0]*)_make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in</div>
700 <div class="lineAllUnvisited">000673| (*[0]*)Int64.logand word (I64.mask flen)</div>
701 <div class="lineNone">000674| ) in</div>
702 <div class="lineAllUnvisited">000675| (*[0]*)word (*, off+flen, len-flen*)</div>
703 <div class="lineNone">000676| </div>
704 <div class="lineNone">000677| let extract_int64_ne_unsigned =</div>
705 <div class="lineAllVisited">000678| (*[28]*)if nativeendian = BigEndian</div>
706 <div class="lineAllUnvisited">000679| then (*[0]*)extract_int64_be_unsigned</div>
707 <div class="lineAllVisited">000680| else (*[28]*)extract_int64_le_unsigned</div>
708 <div class="lineNone">000681| </div>
709 <div class="lineNone">000682| let extract_int64_ee_unsigned = function</div>
710 <div class="lineAllUnvisited">000683| | BigEndian -> (*[0]*)extract_int64_be_unsigned</div>
711 <div class="lineAllUnvisited">000684| | LittleEndian -> (*[0]*)extract_int64_le_unsigned</div>
712 <div class="lineAllUnvisited">000685| | NativeEndian -> (*[0]*)extract_int64_ne_unsigned</div>
713 <div class="lineNone">000686| </div>
714 <div class="lineNone">000687| external extract_fastpath_int16_be_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_unsigned" "noalloc"</div>
715 <div class="lineNone">000688| </div>
716 <div class="lineNone">000689| external extract_fastpath_int16_le_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_unsigned" "noalloc"</div>
717 <div class="lineNone">000690| </div>
718 <div class="lineNone">000691| external extract_fastpath_int16_ne_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_unsigned" "noalloc"</div>
719 <div class="lineNone">000692| </div>
720 <div class="lineNone">000693| external extract_fastpath_int16_be_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_signed" "noalloc"</div>
721 <div class="lineNone">000694| </div>
722 <div class="lineNone">000695| external extract_fastpath_int16_le_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_signed" "noalloc"</div>
723 <div class="lineNone">000696| </div>
724 <div class="lineNone">000697| external extract_fastpath_int16_ne_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_signed" "noalloc"</div>
725 <div class="lineNone">000698| </div>
726 <div class="lineNone">000699| (*</div>
727 <div class="lineNone">000700| external extract_fastpath_int24_be_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_unsigned" "noalloc"</div>
728 <div class="lineNone">000701| </div>
729 <div class="lineNone">000702| external extract_fastpath_int24_le_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_unsigned" "noalloc"</div>
730 <div class="lineNone">000703| </div>
731 <div class="lineNone">000704| external extract_fastpath_int24_ne_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_unsigned" "noalloc"</div>
732 <div class="lineNone">000705| </div>
733 <div class="lineNone">000706| external extract_fastpath_int24_be_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_signed" "noalloc"</div>
734 <div class="lineNone">000707| </div>
735 <div class="lineNone">000708| external extract_fastpath_int24_le_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_signed" "noalloc"</div>
736 <div class="lineNone">000709| </div>
737 <div class="lineNone">000710| external extract_fastpath_int24_ne_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_signed" "noalloc"</div>
738 <div class="lineNone">000711| *)</div>
739 <div class="lineNone">000712| </div>
740 <div class="lineNone">000713| external extract_fastpath_int32_be_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_unsigned" "noalloc"</div>
741 <div class="lineNone">000714| </div>
742 <div class="lineNone">000715| external extract_fastpath_int32_le_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_unsigned" "noalloc"</div>
743 <div class="lineNone">000716| </div>
744 <div class="lineNone">000717| external extract_fastpath_int32_ne_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_unsigned" "noalloc"</div>
745 <div class="lineNone">000718| </div>
746 <div class="lineNone">000719| external extract_fastpath_int32_be_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_signed" "noalloc"</div>
747 <div class="lineNone">000720| </div>
748 <div class="lineNone">000721| external extract_fastpath_int32_le_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_signed" "noalloc"</div>
749 <div class="lineNone">000722| </div>
750 <div class="lineNone">000723| external extract_fastpath_int32_ne_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_signed" "noalloc"</div>
751 <div class="lineNone">000724| </div>
752 <div class="lineNone">000725| (*</div>
753 <div class="lineNone">000726| external extract_fastpath_int40_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_unsigned" "noalloc"</div>
754 <div class="lineNone">000727| </div>
755 <div class="lineNone">000728| external extract_fastpath_int40_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_unsigned" "noalloc"</div>
756 <div class="lineNone">000729| </div>
757 <div class="lineNone">000730| external extract_fastpath_int40_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_unsigned" "noalloc"</div>
758 <div class="lineNone">000731| </div>
759 <div class="lineNone">000732| external extract_fastpath_int40_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_signed" "noalloc"</div>
760 <div class="lineNone">000733| </div>
761 <div class="lineNone">000734| external extract_fastpath_int40_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_signed" "noalloc"</div>
762 <div class="lineNone">000735| </div>
763 <div class="lineNone">000736| external extract_fastpath_int40_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_signed" "noalloc"</div>
764 <div class="lineNone">000737| </div>
765 <div class="lineNone">000738| external extract_fastpath_int48_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_unsigned" "noalloc"</div>
766 <div class="lineNone">000739| </div>
767 <div class="lineNone">000740| external extract_fastpath_int48_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_unsigned" "noalloc"</div>
768 <div class="lineNone">000741| </div>
769 <div class="lineNone">000742| external extract_fastpath_int48_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_unsigned" "noalloc"</div>
770 <div class="lineNone">000743| </div>
771 <div class="lineNone">000744| external extract_fastpath_int48_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_signed" "noalloc"</div>
772 <div class="lineNone">000745| </div>
773 <div class="lineNone">000746| external extract_fastpath_int48_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_signed" "noalloc"</div>
774 <div class="lineNone">000747| </div>
775 <div class="lineNone">000748| external extract_fastpath_int48_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_signed" "noalloc"</div>
776 <div class="lineNone">000749| </div>
777 <div class="lineNone">000750| external extract_fastpath_int56_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_unsigned" "noalloc"</div>
778 <div class="lineNone">000751| </div>
779 <div class="lineNone">000752| external extract_fastpath_int56_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_unsigned" "noalloc"</div>
780 <div class="lineNone">000753| </div>
781 <div class="lineNone">000754| external extract_fastpath_int56_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_unsigned" "noalloc"</div>
782 <div class="lineNone">000755| </div>
783 <div class="lineNone">000756| external extract_fastpath_int56_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_signed" "noalloc"</div>
784 <div class="lineNone">000757| </div>
785 <div class="lineNone">000758| external extract_fastpath_int56_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_signed" "noalloc"</div>
786 <div class="lineNone">000759| </div>
787 <div class="lineNone">000760| external extract_fastpath_int56_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_signed" "noalloc"</div>
788 <div class="lineNone">000761| *)</div>
789 <div class="lineNone">000762| </div>
790 <div class="lineNone">000763| external extract_fastpath_int64_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_unsigned" "noalloc"</div>
791 <div class="lineNone">000764| </div>
792 <div class="lineNone">000765| external extract_fastpath_int64_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_unsigned" "noalloc"</div>
793 <div class="lineNone">000766| </div>
794 <div class="lineNone">000767| external extract_fastpath_int64_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_unsigned" "noalloc"</div>
795 <div class="lineNone">000768| </div>
796 <div class="lineNone">000769| external extract_fastpath_int64_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_signed" "noalloc"</div>
797 <div class="lineNone">000770| </div>
798 <div class="lineNone">000771| external extract_fastpath_int64_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_signed" "noalloc"</div>
799 <div class="lineNone">000772| </div>
800 <div class="lineNone">000773| external extract_fastpath_int64_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_signed" "noalloc"</div>
801 <div class="lineNone">000774| </div>
802 <div class="lineNone">000775| (*----------------------------------------------------------------------*)</div>
803 <div class="lineNone">000776| (* Constructor functions. *)</div>
804 <div class="lineNone">000777| </div>
805 <div class="lineNone">000778| module Buffer = struct</div>
806 <div class="lineNone">000779| type t = {</div>
807 <div class="lineNone">000780| buf : Buffer.t;</div>
808 <div class="lineNone">000781| mutable len : int; (* Length in bits. *)</div>
809 <div class="lineNone">000782| (* Last byte in the buffer (if len is not aligned). We store</div>
810 <div class="lineNone">000783| * it outside the buffer because buffers aren't mutable.</div>
811 <div class="lineNone">000784| *)</div>
812 <div class="lineNone">000785| mutable last : int;</div>
813 <div class="lineNone">000786| }</div>
814 <div class="lineNone">000787| </div>
815 <div class="lineNone">000788| let create () =</div>
816 <div class="lineNone">000789| (* XXX We have almost enough information in the generator to</div>
817 <div class="lineNone">000790| * choose a good initial size.</div>
818 <div class="lineNone">000791| *)</div>
819 <div class="lineAllVisited">000792| (*[452559]*){ buf = Buffer.create 128; len = 0; last = 0 }</div>
820 <div class="lineNone">000793| </div>
821 <div class="lineNone">000794| let contents { buf = buf; len = len; last = last } =</div>
822 <div class="lineAllVisited">000795| (*[452559]*)let data =</div>
823 <div class="lineNone">000796| if len land 7 = 0 then</div>
824 <div class="lineAllVisited">000797| (*[58202]*)Buffer.contents buf</div>
825 <div class="lineNone">000798| else</div>
826 <div class="lineAllVisited">000799| (*[394357]*)Buffer.contents buf ^ (String.make 1 (Char.chr last)) in</div>
827 <div class="lineAllVisited">000800| (*[452559]*)data, 0, len</div>
828 <div class="lineNone">000801| </div>
829 <div class="lineNone">000802| (* Add exactly 8 bits. *)</div>
830 <div class="lineNone">000803| let add_byte ({ buf = buf; len = len; last = last } as t) byte =</div>
831 <div class="lineMixed">000804| (*[8142106]*)if (*[8142106]*)byte < 0 || (*[8142106]*)byte > 255 then (*[0]*)invalid_arg "Bitstring.Buffer.add_byte";</div>
832 <div class="lineAllVisited">000805| (*[8142106]*)let shift = len land 7 in</div>
833 <div class="lineAllVisited">000806| (*[8142106]*)if shift = 0 then</div>
834 <div class="lineNone">000807| (* Target buffer is byte-aligned. *)</div>
835 <div class="lineAllVisited">000808| (*[519924]*)Buffer.add_char buf (Char.chr byte)</div>
836 <div class="lineNone">000809| else (</div>
837 <div class="lineNone">000810| (* Target buffer is unaligned. 'last' is meaningful. *)</div>
838 <div class="lineAllVisited">000811| (*[7622182]*)let first = byte lsr shift in</div>
839 <div class="lineAllVisited">000812| (*[7622182]*)let second = (byte lsl (8 - shift)) land 0xff in</div>
840 <div class="lineAllVisited">000813| (*[7622182]*)Buffer.add_char buf (*[7622182]*)(Char.chr (last lor first));</div>
841 <div class="lineAllVisited">000814| (*[7622182]*)t.last <- second</div>
842 <div class="lineNone">000815| );</div>
843 <div class="lineAllVisited">000816| (*[8142106]*)t.len <- t.len + 8</div>
844 <div class="lineNone">000817| </div>
845 <div class="lineNone">000818| (* Add exactly 1 bit. *)</div>
846 <div class="lineNone">000819| let add_bit ({ buf = buf; len = len; last = last } as t) bit =</div>
847 <div class="lineAllVisited">000820| (*[4192108]*)let shift = 7 - (len land 7) in</div>
848 <div class="lineAllVisited">000821| (*[4192108]*)if shift > 0 then</div>
849 <div class="lineNone">000822| (* Somewhere in the middle of 'last'. *)</div>
850 <div class="lineAllVisited">000823| (*[3692102]*)t.last <- last lor ((if bit then (*[2903776]*)1 else (*[788326]*)0) lsl shift)</div>
851 <div class="lineNone">000824| else (</div>
852 <div class="lineNone">000825| (* Just a single spare bit in 'last'. *)</div>
853 <div class="lineAllVisited">000826| (*[500006]*)let last = last lor if bit then (*[391339]*)1 else (*[108667]*)0 in</div>
854 <div class="lineAllVisited">000827| (*[500006]*)Buffer.add_char buf (*[500006]*)(Char.chr last);</div>
855 <div class="lineAllVisited">000828| (*[500006]*)t.last <- 0</div>
856 <div class="lineNone">000829| );</div>
857 <div class="lineAllVisited">000830| (*[4192108]*)t.len <- len + 1</div>
858 <div class="lineNone">000831| </div>
859 <div class="lineNone">000832| (* Add a small number of bits (definitely < 8). This uses a loop</div>
860 <div class="lineNone">000833| * to call add_bit so it's slow.</div>
861 <div class="lineNone">000834| *)</div>
862 <div class="lineNone">000835| let _add_bits t c slen =</div>
863 <div class="lineMixed">000836| (*[317200]*)if (*[317200]*)slen < 1 || (*[317200]*)slen >= 8 then (*[0]*)invalid_arg "Bitstring.Buffer._add_bits";</div>
864 <div class="lineAllVisited">000837| (*[317200]*)for i = slen-1 downto 0 do</div>
865 <div class="lineAllVisited">000838| (*[1268791]*)let bit = c land (1 lsl i) <> 0 in</div>
866 <div class="lineAllVisited">000839| (*[1268791]*)add_bit t bit</div>
867 <div class="lineNone">000840| done</div>
868 <div class="lineNone">000841| </div>
869 <div class="lineNone">000842| let add_bits ({ buf = buf; len = len } as t) str slen =</div>
870 <div class="lineAllVisited">000843| (*[23330]*)if slen > 0 then (</div>
871 <div class="lineAllVisited">000844| (*[1272292]*)if len land 7 = 0 then (</div>
872 <div class="lineAllVisited">000845| (*[525820]*)if slen land 7 = 0 then</div>
873 <div class="lineNone">000846| (* Common case - everything is byte-aligned. *)</div>
874 <div class="lineAllVisited">000847| (*[58261]*)Buffer.add_substring buf str 0 (slen lsr 3)</div>
875 <div class="lineNone">000848| else (</div>
876 <div class="lineNone">000849| (* Target buffer is aligned. Copy whole bytes then leave the</div>
877 <div class="lineNone">000850| * remaining bits in last.</div>
878 <div class="lineNone">000851| *)</div>
879 <div class="lineAllVisited">000852| (*[467559]*)let slenbytes = slen lsr 3 in</div>
880 <div class="lineAllVisited">000853| (*[335078]*)if slenbytes > 0 then (*[132481]*)Buffer.add_substring buf str 0 slenbytes;</div>
881 <div class="lineAllVisited">000854| (*[467559]*)let last = Char.code str.[slenbytes] in (* last char *)</div>
882 <div class="lineAllVisited">000855| (*[467559]*)let mask = 0xff lsl (8 - (slen land 7)) in</div>
883 <div class="lineAllVisited">000856| (*[467559]*)t.last <- last land mask</div>
884 <div class="lineNone">000857| );</div>
885 <div class="lineAllVisited">000858| (*[525820]*)t.len <- len + slen</div>
886 <div class="lineNone">000859| ) else (</div>
887 <div class="lineNone">000860| (* Target buffer is unaligned. Copy whole bytes using</div>
888 <div class="lineNone">000861| * add_byte which knows how to deal with an unaligned</div>
889 <div class="lineNone">000862| * target buffer, then call add_bit for the remaining < 8 bits.</div>
890 <div class="lineNone">000863| *</div>
891 <div class="lineNone">000864| * XXX This is going to be dog-slow.</div>
892 <div class="lineNone">000865| *)</div>
893 <div class="lineAllVisited">000866| (*[746472]*)let slenbytes = slen lsr 3 in</div>
894 <div class="lineAllVisited">000867| (*[746472]*)for i = 0 to slenbytes-1 do</div>
895 <div class="lineAllVisited">000868| (*[5829660]*)let byte = Char.code str.[i] in</div>
896 <div class="lineAllVisited">000869| (*[5829660]*)add_byte t byte</div>
897 <div class="lineNone">000870| done;</div>
898 <div class="lineAllVisited">000871| (*[746472]*)let bitsleft = slen - (slenbytes lsl 3) in</div>
899 <div class="lineAllVisited">000872| (*[136479]*)if bitsleft > 0 then (</div>
900 <div class="lineAllVisited">000873| (*[609993]*)let c = Char.code str.[slenbytes] in</div>
901 <div class="lineAllVisited">000874| (*[609993]*)for i = 0 to bitsleft - 1 do</div>
902 <div class="lineAllVisited">000875| (*[2423817]*)let bit = c land (0x80 lsr i) <> 0 in</div>
903 <div class="lineAllVisited">000876| (*[2423817]*)add_bit t bit</div>
904 <div class="lineNone">000877| done</div>
905 <div class="lineNone">000878| )</div>
906 <div class="lineNone">000879| );</div>
907 <div class="lineNone">000880| )</div>
908 <div class="lineNone">000881| end</div>
909 <div class="lineNone">000882| </div>
910 <div class="lineNone">000883| (* Construct a single bit. *)</div>
911 <div class="lineNone">000884| let construct_bit buf b _ _ =</div>
912 <div class="lineAllUnvisited">000885| (*[0]*)Buffer.add_bit buf b</div>
913 <div class="lineNone">000886| </div>
914 <div class="lineNone">000887| (* Construct a field, flen = [2..8]. *)</div>
915 <div class="lineNone">000888| let construct_char_unsigned buf v flen exn =</div>
916 <div class="lineAllVisited">000889| (*[1203570]*)let max_val = 1 lsl flen in</div>
917 <div class="lineMixed">000890| (*[1203570]*)if (*[1203570]*)v < 0 || (*[1203570]*)v >= max_val then (*[0]*)raise exn;</div>
918 <div class="lineAllVisited">000891| (*[1203570]*)if flen = 8 then</div>
919 <div class="lineAllVisited">000892| (*[1203570]*)Buffer.add_byte buf v</div>
920 <div class="lineNone">000893| else</div>
921 <div class="lineAllUnvisited">000894| (*[0]*)Buffer._add_bits buf v flen</div>
922 <div class="lineNone">000895| </div>
923 <div class="lineNone">000896| (* Construct a field of up to 31 bits. *)</div>
924 <div class="lineNone">000897| let construct_int_be_unsigned buf v flen exn =</div>
925 <div class="lineNone">000898| (* Check value is within range. *)</div>
926 <div class="lineMixed">000899| (*[2]*)if not (I.range_unsigned v flen) then (*[0]*)raise exn;</div>
927 <div class="lineNone">000900| (* Add the bytes. *)</div>
928 <div class="lineAllVisited">000901| (*[2]*)I.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen</div>
929 <div class="lineNone">000902| </div>
930 <div class="lineNone">000903| (* Construct a field of up to 31 bits. *)</div>
931 <div class="lineNone">000904| let construct_int_le_unsigned buf v flen exn =</div>
932 <div class="lineNone">000905| (* Check value is within range. *)</div>
933 <div class="lineAllUnvisited">000906| (*[0]*)if not (I.range_unsigned v flen) then (*[0]*)raise exn;</div>
934 <div class="lineNone">000907| (* Add the bytes. *)</div>
935 <div class="lineAllUnvisited">000908| (*[0]*)I.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen</div>
936 <div class="lineNone">000909| </div>
937 <div class="lineNone">000910| let construct_int_ne_unsigned =</div>
938 <div class="lineAllVisited">000911| (*[28]*)if nativeendian = BigEndian</div>
939 <div class="lineAllUnvisited">000912| then (*[0]*)construct_int_be_unsigned</div>
940 <div class="lineAllVisited">000913| else (*[28]*)construct_int_le_unsigned</div>
941 <div class="lineNone">000914| </div>
942 <div class="lineNone">000915| let construct_int_ee_unsigned = function</div>
943 <div class="lineAllUnvisited">000916| | BigEndian -> (*[0]*)construct_int_be_unsigned</div>
944 <div class="lineAllUnvisited">000917| | LittleEndian -> (*[0]*)construct_int_le_unsigned</div>
945 <div class="lineAllUnvisited">000918| | NativeEndian -> (*[0]*)construct_int_ne_unsigned</div>
946 <div class="lineNone">000919| </div>
947 <div class="lineNone">000920| (* Construct a field of exactly 32 bits. *)</div>
948 <div class="lineNone">000921| let construct_int32_be_unsigned buf v flen _ =</div>
949 <div class="lineAllVisited">000922| (*[6]*)Buffer.add_byte buf</div>
950 <div class="lineNone">000923| (Int32.to_int (Int32.shift_right_logical v 24));</div>
951 <div class="lineAllVisited">000924| (*[6]*)Buffer.add_byte buf</div>
952 <div class="lineNone">000925| (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l)));</div>
953 <div class="lineAllVisited">000926| (*[6]*)Buffer.add_byte buf</div>
954 <div class="lineAllVisited">000927| (*[6]*)(Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l)));</div>
955 <div class="lineAllVisited">000928| (*[6]*)Buffer.add_byte buf</div>
956 <div class="lineNone">000929| (Int32.to_int (Int32.logand v 0xff_l))</div>
957 <div class="lineNone">000930| </div>
958 <div class="lineNone">000931| let construct_int32_le_unsigned buf v flen _ =</div>
959 <div class="lineAllVisited">000932| (*[12]*)Buffer.add_byte buf</div>
960 <div class="lineNone">000933| (Int32.to_int (Int32.logand v 0xff_l));</div>
961 <div class="lineAllVisited">000934| (*[12]*)Buffer.add_byte buf</div>
962 <div class="lineNone">000935| (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l)));</div>
963 <div class="lineAllVisited">000936| (*[12]*)Buffer.add_byte buf</div>
964 <div class="lineAllVisited">000937| (*[12]*)(Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l)));</div>
965 <div class="lineAllVisited">000938| (*[12]*)Buffer.add_byte buf</div>
966 <div class="lineNone">000939| (Int32.to_int (Int32.shift_right_logical v 24))</div>
967 <div class="lineNone">000940| </div>
968 <div class="lineNone">000941| let construct_int32_ne_unsigned =</div>
969 <div class="lineAllVisited">000942| (*[28]*)if nativeendian = BigEndian</div>
970 <div class="lineAllUnvisited">000943| then (*[0]*)construct_int32_be_unsigned</div>
971 <div class="lineAllVisited">000944| else (*[28]*)construct_int32_le_unsigned</div>
972 <div class="lineNone">000945| </div>
973 <div class="lineNone">000946| let construct_int32_ee_unsigned = function</div>
974 <div class="lineAllVisited">000947| | BigEndian -> (*[6]*)construct_int32_be_unsigned</div>
975 <div class="lineAllVisited">000948| | LittleEndian -> (*[6]*)construct_int32_le_unsigned</div>
976 <div class="lineAllVisited">000949| | NativeEndian -> (*[6]*)construct_int32_ne_unsigned</div>
977 <div class="lineNone">000950| </div>
978 <div class="lineNone">000951| (* Construct a field of up to 64 bits. *)</div>
979 <div class="lineNone">000952| let construct_int64_be_unsigned buf v flen exn =</div>
980 <div class="lineNone">000953| (* Check value is within range. *)</div>
981 <div class="lineMixed">000954| (*[351850]*)if not (I64.range_unsigned v flen) then (*[0]*)raise exn;</div>
982 <div class="lineNone">000955| (* Add the bytes. *)</div>
983 <div class="lineAllVisited">000956| (*[351850]*)I64.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen</div>
984 <div class="lineNone">000957| </div>
985 <div class="lineNone">000958| (* Construct a field of up to 64 bits. *)</div>
986 <div class="lineNone">000959| let construct_int64_le_unsigned buf v flen exn =</div>
987 <div class="lineNone">000960| (* Check value is within range. *)</div>
988 <div class="lineAllUnvisited">000961| (*[0]*)if not (I64.range_unsigned v flen) then (*[0]*)raise exn;</div>
989 <div class="lineNone">000962| (* Add the bytes. *)</div>
990 <div class="lineAllUnvisited">000963| (*[0]*)I64.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen</div>
991 <div class="lineNone">000964| </div>
992 <div class="lineNone">000965| let construct_int64_ne_unsigned =</div>
993 <div class="lineAllVisited">000966| (*[28]*)if nativeendian = BigEndian</div>
994 <div class="lineAllUnvisited">000967| then (*[0]*)construct_int64_be_unsigned</div>
995 <div class="lineNone">000968| else (*construct_int64_le_unsigned*)</div>
996 <div class="lineAllUnvisited">000969| fun _ _ _ _ -> (*[0]*)failwith "construct_int64_le_unsigned"</div>
997 <div class="lineNone">000970| </div>
998 <div class="lineNone">000971| let construct_int64_ee_unsigned = function</div>
999 <div class="lineAllUnvisited">000972| | BigEndian -> (*[0]*)construct_int64_be_unsigned</div>
1000 <div class="lineNone">000973| | LittleEndian -> (*construct_int64_le_unsigned*)</div>
1001 <div class="lineAllUnvisited">000974| (fun _ _ _ _ -> (*[0]*)failwith "construct_int64_le_unsigned")</div>
1002 <div class="lineAllUnvisited">000975| | NativeEndian -> (*[0]*)construct_int64_ne_unsigned</div>
1003 <div class="lineNone">000976| </div>
1004 <div class="lineNone">000977| (* Construct from a string of bytes, exact multiple of 8 bits</div>
1005 <div class="lineNone">000978| * in length of course.</div>
1006 <div class="lineNone">000979| *)</div>
1007 <div class="lineNone">000980| let construct_string buf str =</div>
1008 <div class="lineAllVisited">000981| (*[89505]*)let len = String.length str in</div>
1009 <div class="lineAllVisited">000982| (*[89505]*)Buffer.add_bits buf str (len lsl 3)</div>
1010 <div class="lineNone">000983| </div>
1011 <div class="lineNone">000984| (* Construct from a bitstring. *)</div>
1012 <div class="lineNone">000985| let construct_bitstring buf (data, off, len) =</div>
1013 <div class="lineNone">000986| (* Add individual bits until we get to the next byte boundary of</div>
1014 <div class="lineNone">000987| * the underlying string.</div>
1015 <div class="lineNone">000988| *)</div>
1016 <div class="lineAllVisited">000989| (*[1197537]*)let blen = 7 - ((off + 7) land 7) in</div>
1017 <div class="lineAllVisited">000990| (*[1197537]*)let blen = min blen len in</div>
1018 <div class="lineAllVisited">000991| (*[1197537]*)let rec loop off len blen =</div>
1019 <div class="lineAllVisited">000992| (*[1197537]*)if blen = 0 then ((*[1197537]*)off, len)</div>
1020 <div class="lineNone">000993| else (</div>
1021 <div class="lineAllUnvisited">000994| (*[0]*)let b = extract_bit data off len 1</div>
1022 <div class="lineNone">000995| and off = off + 1 and len = len + 1 in</div>
1023 <div class="lineAllUnvisited">000996| (*[0]*)Buffer.add_bit buf (*[0]*)b;</div>
1024 <div class="lineAllUnvisited">000997| (*[0]*)loop off len (blen-1)</div>
1025 <div class="lineNone">000998| )</div>
1026 <div class="lineNone">000999| in</div>
1027 <div class="lineAllVisited">001000| (*[1197537]*)let off, len = loop off len blen in</div>
1028 <div class="lineAllVisited">001001| (*[1197537]*)assert ((*[1197537]*)len = 0 || (off (*[1174272]*)land 7) = 0);</div>
1029 <div class="lineNone">001002| </div>
1030 <div class="lineNone">001003| (* Add the remaining 'len' bits. *)</div>
1031 <div class="lineAllVisited">001004| (*[1197537]*)let data =</div>
1032 <div class="lineNone">001005| let off = off lsr 3 in</div>
1033 <div class="lineNone">001006| (* XXX dangerous allocation *)</div>
1034 <div class="lineAllVisited">001007| (*[1197537]*)if off = 0 then (*[1197537]*)data</div>
1035 <div class="lineAllUnvisited">001008| else (*[0]*)String.sub data off (String.length data - off) in</div>
1036 <div class="lineNone">001009| </div>
1037 <div class="lineAllVisited">001010| (*[1197537]*)Buffer.add_bits buf data len</div>
1038 <div class="lineNone">001011| </div>
1039 <div class="lineNone">001012| (*----------------------------------------------------------------------*)</div>
1040 <div class="lineNone">001013| (* Extract a string from a bitstring. *)</div>
1041 <div class="lineNone">001014| </div>
1042 <div class="lineNone">001015| let string_of_bitstring (data, off, len) =</div>
1043 <div class="lineAllVisited">001016| (*[63963]*)if off (*[63963]*)land 7 = 0 && len (*[8535]*)land 7 = 0 then</div>
1044 <div class="lineNone">001017| (* Easy case: everything is byte-aligned. *)</div>
1045 <div class="lineAllVisited">001018| (*[8022]*)String.sub data (off lsr 3) (len lsr 3)</div>
1046 <div class="lineNone">001019| else (</div>
1047 <div class="lineNone">001020| (* Bit-twiddling case. *)</div>
1048 <div class="lineAllVisited">001021| (*[55941]*)let strlen = (len + 7) lsr 3 in</div>
1049 <div class="lineAllVisited">001022| (*[55941]*)let str = String.make strlen '\000' in</div>
1050 <div class="lineAllVisited">001023| (*[55941]*)let rec loop data off len i =</div>
1051 <div class="lineAllVisited">001024| (*[305313]*)if len >= 8 then (</div>
1052 <div class="lineAllVisited">001025| (*[249372]*)let c = extract_char_unsigned data off len 8</div>
1053 <div class="lineNone">001026| and off = off + 8 and len = len - 8 in</div>
1054 <div class="lineAllVisited">001027| (*[249372]*)str.[i] (*[249372]*)<- Char.chr c;</div>
1055 <div class="lineAllVisited">001028| (*[249372]*)loop data off len (i+1)</div>
1056 <div class="lineAllVisited">001029| ) else (*[52179]*)if len > 0 then (</div>
1057 <div class="lineAllVisited">001030| (*[3762]*)let c = extract_char_unsigned data off len len in</div>
1058 <div class="lineAllVisited">001031| (*[3762]*)str.[i] <- Char.chr (c lsl (8-len))</div>
1059 <div class="lineNone">001032| )</div>
1060 <div class="lineNone">001033| in</div>
1061 <div class="lineAllVisited">001034| (*[55941]*)loop data off len (*[55941]*)0;</div>
1062 <div class="lineAllVisited">001035| (*[55941]*)str</div>
1063 <div class="lineNone">001036| )</div>
1064 <div class="lineNone">001037| </div>
1065 <div class="lineNone">001038| (* To channel. *)</div>
1066 <div class="lineNone">001039| </div>
1067 <div class="lineNone">001040| let bitstring_to_chan ((data, off, len) as bits) chan =</div>
1068 <div class="lineNone">001041| (* Fail if the bitstring length isn't a multiple of 8. *)</div>
1069 <div class="lineAllUnvisited">001042| (*[0]*)if len land 7 <> 0 then (*[0]*)invalid_arg "bitstring_to_chan";</div>
1070 <div class="lineNone">001043| </div>
1071 <div class="lineAllUnvisited">001044| (*[0]*)if off land 7 = 0 then</div>
1072 <div class="lineNone">001045| (* Easy case: string is byte-aligned. *)</div>
1073 <div class="lineAllUnvisited">001046| (*[0]*)output chan data (off lsr 3) (len lsr 3)</div>
1074 <div class="lineNone">001047| else (</div>
1075 <div class="lineNone">001048| (* Bit-twiddling case: reuse string_of_bitstring *)</div>
1076 <div class="lineAllUnvisited">001049| (*[0]*)let str = string_of_bitstring bits in</div>
1077 <div class="lineAllUnvisited">001050| (*[0]*)output_string chan str</div>
1078 <div class="lineNone">001051| )</div>
1079 <div class="lineNone">001052| </div>
1080 <div class="lineNone">001053| let bitstring_to_file bits filename =</div>
1081 <div class="lineAllUnvisited">001054| (*[0]*)let chan = open_out_bin filename in</div>
1082 <div class="lineAllUnvisited">001055| (*[0]*)try</div>
1083 <div class="lineAllUnvisited">001056| (*[0]*)bitstring_to_chan bits chan;</div>
1084 <div class="lineAllUnvisited">001057| (*[0]*)close_out chan</div>
1085 <div class="lineNone">001058| with exn -></div>
1086 <div class="lineAllUnvisited">001059| (*[0]*)close_out (*[0]*)chan;</div>
1087 <div class="lineAllUnvisited">001060| (*[0]*)raise exn</div>
1088 <div class="lineNone">001061| </div>
1089 <div class="lineNone">001062| (*----------------------------------------------------------------------*)</div>
1090 <div class="lineNone">001063| (* Display functions. *)</div>
1091 <div class="lineNone">001064| </div>
1092 <div class="lineNone">001065| let isprint c =</div>
1093 <div class="lineAllUnvisited">001066| (*[0]*)let c = Char.code c in</div>
1094 <div class="lineAllUnvisited">001067| (*[0]*)c (*[0]*)>= 32 && (*[0]*)c < 127</div>
1095 <div class="lineNone">001068| </div>
1096 <div class="lineNone">001069| let hexdump_bitstring chan (data, off, len) =</div>
1097 <div class="lineAllUnvisited">001070| (*[0]*)let count = ref 0 in</div>
1098 <div class="lineAllUnvisited">001071| (*[0]*)let off = ref off in</div>
1099 <div class="lineAllUnvisited">001072| (*[0]*)let len = ref len in</div>
1100 <div class="lineAllUnvisited">001073| (*[0]*)let linelen = ref 0 in</div>
1101 <div class="lineAllUnvisited">001074| (*[0]*)let linechars = String.make 16 ' ' in</div>
1102 <div class="lineNone">001075| </div>
1103 <div class="lineAllUnvisited">001076| (*[0]*)fprintf chan "00000000 ";</div>
1104 <div class="lineNone">001077| </div>
1105 <div class="lineAllUnvisited">001078| (*[0]*)while !len > 0 do</div>
1106 <div class="lineAllUnvisited">001079| (*[0]*)let bits = min !len 8 in</div>
1107 <div class="lineAllUnvisited">001080| (*[0]*)let byte = extract_char_unsigned data !off !len bits in</div>
1108 <div class="lineAllUnvisited">001081| (*[0]*)off := !off + bits; (*[0]*)len (*[0]*):= !len - bits;</div>
1109 <div class="lineNone">001082| </div>
1110 <div class="lineAllUnvisited">001083| (*[0]*)let byte = byte lsl (8-bits) in</div>
1111 <div class="lineAllUnvisited">001084| (*[0]*)fprintf chan "%02x " byte;</div>
1112 <div class="lineNone">001085| </div>
1113 <div class="lineAllUnvisited">001086| (*[0]*)incr count;</div>
1114 <div class="lineAllUnvisited">001087| (*[0]*)linechars.[!linelen] <-</div>
1115 <div class="lineNone">001088| (let c = Char.chr byte in</div>
1116 <div class="lineAllUnvisited">001089| (*[0]*)if isprint c then (*[0]*)c else (*[0]*)'.');</div>
1117 <div class="lineAllUnvisited">001090| (*[0]*)incr linelen;</div>
1118 <div class="lineAllUnvisited">001091| (*[0]*)if !linelen = 8 then (*[0]*)fprintf chan " ";</div>
1119 <div class="lineAllUnvisited">001092| (*[0]*)if !linelen = 16 then (</div>
1120 <div class="lineAllUnvisited">001093| (*[0]*)fprintf chan " |%s|\n%08x " linechars !count;</div>
1121 <div class="lineAllUnvisited">001094| (*[0]*)linelen (*[0]*):= 0;</div>
1122 <div class="lineAllUnvisited">001095| (*[0]*)for i = 0 to 15 do (*[0]*)linechars.[i] <- ' ' done</div>
1123 <div class="lineNone">001096| )</div>
1124 <div class="lineNone">001097| done;</div>
1125 <div class="lineNone">001098| </div>
1126 <div class="lineAllUnvisited">001099| (*[0]*)if !linelen > 0 then (</div>
1127 <div class="lineAllUnvisited">001100| (*[0]*)let skip = (16 - !linelen) * 3 + if !linelen < 8 then (*[0]*)1 else (*[0]*)0 in</div>
1128 <div class="lineAllUnvisited">001101| (*[0]*)for i = 0 to skip-1 do (*[0]*)fprintf chan " " done;</div>
1129 <div class="lineAllUnvisited">001102| (*[0]*)fprintf chan " |%s|\n%!" linechars</div>
1130 <div class="lineNone">001103| ) else</div>
1131 <div class="lineAllUnvisited">001104| (*[0]*)fprintf chan "\n%!"</div>
1133 <hr class="codeSep"/>
1134 <p class="footer">Generated by <a href="http://bisect.x9c.fr">Bisect</a> on 2008-08-26 10:36:20</p>
git.annexia.org / ocaml-bitstring.git / blob