2 * $Id: bitmatch.ml,v 1.2 2008-04-01 08:56:43 rjones Exp $
7 (* A bitstring is simply the data itself (as a string), and the
8 * bitoffset and the bitlength within the string. Note offset/length
9 * are counted in bits, not bytes.
11 type bitstring = string * int * int
13 (* Functions to create and load bitstrings. *)
14 let empty_bitstring = "", 0, 0
16 let make_bitstring len c = String.make ((len+7) lsr 3) c, 0, len
18 let create_bitstring len = make_bitstring len '\000'
20 let bitstring_of_chan chan =
21 let tmpsize = 16384 in
22 let buf = Buffer.create tmpsize in
23 let tmp = String.create tmpsize in
25 while n := input chan tmp 0 tmpsize; !n > 0 do
26 Buffer.add_substring buf tmp 0 !n;
28 Buffer.contents buf, 0, Buffer.length buf lsl 3
30 let bitstring_of_file fname =
31 let chan = open_in_bin fname in
32 let bs = bitstring_of_chan chan in
36 (*----------------------------------------------------------------------*)
37 (* Extraction functions.
39 * NB: internal functions, called from the generated macros, and
40 * the parameters should have been checked for sanity already).
44 let extract_bitstring data off len flen =
45 (data, off, flen), off+flen, len-flen
47 let extract_remainder data off len =
48 (data, off, len), off+len, 0
50 (* Extract and convert to numeric. A single bit is returned as
51 * a boolean. There are no endianness or signedness considerations.
53 let extract_bit data off len _ = (* final param is always 1 *)
54 let byteoff = off lsr 3 in
55 let bitmask = 1 lsl (7 - (off land 7)) in
56 let b = Char.code data.[byteoff] land bitmask <> 0 in
59 (* Extract [2..8] bits. Because the result fits into a single
60 * byte we don't have to worry about endianness, only signedness.
62 let extract_char_unsigned data off len flen =
63 let byteoff = off lsr 3 in
65 (* Extract the 16 bits at byteoff and byteoff+1 (note that the
66 * second byte might not exist in the original string).
69 (Char.code data.[byteoff] lsl 8) +
70 (if String.length data > byteoff+1 then Char.code data.[byteoff+1]
73 (* Mask off the top bits. *)
74 let bitmask = (1 lsl (16 - (off land 7))) - 1 in
75 let word = word land bitmask in
76 (* Shift right to get rid of the bottom bits. *)
77 let shift = 16 - ((off land 7) + flen) in
78 let word = word lsr shift in
80 word, off+flen, len-flen