bitmatch.ml

   1 (* Bitmatch library.
   2  * $Id: bitmatch.ml,v 1.4 2008-04-01 10:58:53 rjones Exp $
   3  *)
   4
   5 open Printf
   6
   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.
  10  *)
  11 type bitstring = string * int * int
  12
  13 (* Functions to create and load bitstrings. *)
  14 let empty_bitstring = "", 0, 0
  15
  16 let make_bitstring len c = String.make ((len+7) lsr 3) c, 0, len
  17
  18 let create_bitstring len = make_bitstring len '\000'
  19
  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
  24   let n = ref 0 in
  25   while n := input chan tmp 0 tmpsize; !n > 0 do
  26     Buffer.add_substring buf tmp 0 !n;
  27   done;
  28   Buffer.contents buf, 0, Buffer.length buf lsl 3
  29
  30 let bitstring_of_file fname =
  31   let chan = open_in_bin fname in
  32   let bs = bitstring_of_chan chan in
  33   close_in chan;
  34   bs
  35
  36 (*----------------------------------------------------------------------*)
  37 (* Extraction functions.
  38  *
  39  * NB: internal functions, called from the generated macros, and
  40  * the parameters should have been checked for sanity already).
  41  *)
  42
  43 (* Bitstrings. *)
  44 let extract_bitstring data off len flen =
  45   (data, off, flen), off+flen, len-flen
  46
  47 let extract_remainder data off len =
  48   (data, off, len), off+len, 0
  49
  50 (* Extract and convert to numeric.  A single bit is returned as
  51  * a boolean.  There are no endianness or signedness considerations.
  52  *)
  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
  57   b, off+1, len-1
  58
  59 (* Returns 8 bit unsigned aligned bytes from the string.
  60  * If the string ends then this returns 0's.
  61  *)
  62 let _get_byte data byteoff strlen =
  63   if strlen > byteoff then Char.code data.[byteoff] else 0
  64 let _get_byte32 data byteoff strlen =
  65   if strlen > byteoff then Int32.of_int (Char.code data.[byteoff]) else 0l
  66 let _get_byte64 data byteoff strlen =
  67   if strlen > byteoff then Int64.of_int (Char.code data.[byteoff]) else 0L
  68
  69 (* Extract [2..8] bits.  Because the result fits into a single
  70  * byte we don't have to worry about endianness, only signedness.
  71  *)
  72 let extract_char_unsigned data off len flen =
  73   let byteoff = off lsr 3 in
  74
  75   (* Optimize the common (byte-aligned) case. *)
  76   if off land 7 = 0 then (
  77     let byte = Char.code data.[byteoff] in
  78     byte lsr (8 - flen), off+flen, len-flen
  79   ) else (
  80     (* Extract the 16 bits at byteoff and byteoff+1 (note that the
  81      * second byte might not exist in the original string).
  82      *)
  83     let strlen = String.length data in
  84
  85     let word =
  86       (_get_byte data byteoff strlen lsl 8) +
  87         _get_byte data (byteoff+1) strlen in
  88
  89     (* Mask off the top bits. *)
  90     let bitmask = (1 lsl (16 - (off land 7))) - 1 in
  91     let word = word land bitmask in
  92     (* Shift right to get rid of the bottom bits. *)
  93     let shift = 16 - ((off land 7) + flen) in
  94     let word = word lsr shift in
  95
  96     word, off+flen, len-flen
  97   )
  98
  99 (* Extract [9..31] bits.  We have to consider endianness and signedness. *)
 100 let extract_int_be_unsigned data off len flen =
 101   let byteoff = off lsr 3 in
 102
 103   let strlen = String.length data in
 104
 105   let word =
 106     (* Optimize the common (byte-aligned) case. *)
 107     if off land 7 = 0 then (
 108       let word =
 109         (_get_byte data byteoff strlen lsl 23) +
 110           (_get_byte data (byteoff+1) strlen lsl 15) +
 111           (_get_byte data (byteoff+2) strlen lsl 7) +
 112           (_get_byte data (byteoff+3) strlen lsr 1) in
 113       word lsr (31 - flen)
 114     ) else if flen <= 24 then (
 115       (* Extract the 31 bits at byteoff .. byteoff+3. *)
 116       let word =
 117         (_get_byte data byteoff strlen lsl 23) +
 118           (_get_byte data (byteoff+1) strlen lsl 15) +
 119           (_get_byte data (byteoff+2) strlen lsl 7) +
 120           (_get_byte data (byteoff+3) strlen lsr 1) in
 121       (* Mask off the top bits. *)
 122       let bitmask = (1 lsl (31 - (off land 7))) - 1 in
 123       let word = word land bitmask in
 124       (* Shift right to get rid of the bottom bits. *)
 125       let shift = 31 - ((off land 7) + flen) in
 126       word lsr shift
 127     ) else (
 128       (* Extract the next 31 bits, slow method. *)
 129       let word =
 130         let c0, off, len = extract_char_unsigned data off len 8 in
 131         let c1, off, len = extract_char_unsigned data off len 8 in
 132         let c2, off, len = extract_char_unsigned data off len 8 in
 133         let c3, off, len = extract_char_unsigned data off len 7 in
 134         (c0 lsl 23) + (c1 lsl 15) + (c2 lsl 7) + c3 in
 135       word lsr (31 - flen)
 136     ) in
 137   word, off+flen, len-flen
 138
 139 (* Extract exactly 32 bits.  We have to consider endianness and signedness. *)
 140 let extract_int32_be_unsigned data off len flen =
 141   let byteoff = off lsr 3 in
 142
 143   let strlen = String.length data in
 144
 145   let word =
 146     (* Optimize the common (byte-aligned) case. *)
 147     if off land 7 = 0 then (
 148       let word =
 149         Int32.add
 150           (Int32.add
 151              (Int32.add
 152                 (Int32.shift_left (_get_byte32 data byteoff strlen) 24)
 153                 (Int32.shift_left (_get_byte32 data (byteoff+1) strlen) 16))
 154              (Int32.shift_left (_get_byte32 data (byteoff+2) strlen) 8))
 155           (_get_byte32 data (byteoff+3) strlen) in
 156       Int32.shift_right word (32 - flen)
 157     ) else (
 158       (* Extract the next 32 bits, slow method. *)
 159       let word =
 160         let c0, off, len = extract_char_unsigned data off len 8 in
 161         let c1, off, len = extract_char_unsigned data off len 8 in
 162         let c2, off, len = extract_char_unsigned data off len 8 in
 163         let c3, off, len = extract_char_unsigned data off len 8 in
 164         let c0 = Int32.shift_left (Int32.of_int c0) 24 in
 165         let c1 = Int32.shift_left (Int32.of_int c1) 16 in
 166         let c2 = Int32.shift_left (Int32.of_int c2) 8 in
 167         let c3 = Int32.of_int c3 in
 168         Int32.add c0 (Int32.add c1 (Int32.add c2 c3)) in
 169       Int32.shift_right word (32 - flen)
 170     ) in
 171   word, off+flen, len-flen
 172
 173
 174 (*----------------------------------------------------------------------*)
 175 (* Display functions. *)
 176
 177 let isprint c =
 178   let c = Char.code c in
 179   c >= 32 && c < 127
 180
 181 let hexdump_bitstring chan (data, off, len) =
 182   let count = ref 0 in
 183   let off = ref off in
 184   let len = ref len in
 185   let linelen = ref 0 in
 186   let linechars = String.make 16 ' ' in
 187
 188   fprintf chan "00000000  ";
 189
 190   while !len > 0 do
 191     let bits = min !len 8 in
 192     let byte, off', len' = extract_char_unsigned data !off !len bits in
 193     off := off'; len := len';
 194
 195     let byte = byte lsl (8-bits) in
 196     fprintf chan "%02x " byte;
 197
 198     incr count;
 199     linechars.[!linelen] <-
 200       (let c = Char.chr byte in
 201        if isprint c then c else '.');
 202     incr linelen;
 203     if !linelen = 8 then fprintf chan " ";
 204     if !linelen = 16 then (
 205       fprintf chan " |%s|\n%08x  " linechars !count;
 206       linelen := 0;
 207       for i = 0 to 15 do linechars.[i] <- ' ' done
 208     )
 209   done;
 210
 211   if !linelen > 0 then (
 212     let skip = (16 - !linelen) * 3 + if !linelen < 8 then 1 else 0 in
 213     for i = 0 to skip-1 do fprintf chan " " done;
 214     fprintf chan " |%s|\n" linechars
 215   ) else
 216     fprintf chan "\n"