bitmatch.ml

   1 (* Bitmatch library.
   2  * $Id: bitmatch.ml,v 1.3 2008-04-01 10:06:12 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 (* Extract [2..8] bits.  Because the result fits into a single
  60  * byte we don't have to worry about endianness, only signedness.
  61  *)
  62 let extract_char_unsigned data off len flen =
  63   let byteoff = off lsr 3 in
  64
  65   (* Extract the 16 bits at byteoff and byteoff+1 (note that the
  66    * second byte might not exist in the original string).
  67    *)
  68   let word =
  69     (Char.code data.[byteoff] lsl 8) +
  70       (if String.length data > byteoff+1 then Char.code data.[byteoff+1]
  71        else 0) in
  72
  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
  79
  80   word, off+flen, len-flen
  81
  82 (*----------------------------------------------------------------------*)
  83 (* Display functions. *)
  84
  85 let isprint c =
  86   let c = Char.code c in
  87   c >= 32 && c < 127
  88
  89 let hexdump_bitstring chan (data, off, len) =
  90   let count = ref 0 in
  91   let off = ref off in
  92   let len = ref len in
  93   let linelen = ref 0 in
  94   let linechars = String.make 16 ' ' in
  95
  96   fprintf chan "00000000  ";
  97
  98   while !len > 0 do
  99     let bits = min !len 8 in
 100     let byte, off', len' = extract_char_unsigned data !off !len bits in
 101     off := off'; len := len';
 102
 103     let byte = byte lsl (8-bits) in
 104     fprintf chan "%02x " byte;
 105
 106     incr count;
 107     linechars.[!linelen] <-
 108       (let c = Char.chr byte in
 109        if isprint c then c else '.');
 110     incr linelen;
 111     if !linelen = 8 then fprintf chan " ";
 112     if !linelen = 16 then (
 113       fprintf chan " |%s|\n%08x  " linechars !count;
 114       linelen := 0;
 115       for i = 0 to 15 do linechars.[i] <- ' ' done
 116     )
 117   done;
 118
 119   if !linelen > 0 then (
 120     let skip = (16 - !linelen) * 3 + if !linelen < 8 then 1 else 0 in
 121     for i = 0 to skip-1 do fprintf chan " " done;
 122     fprintf chan " |%s|\n" linechars
 123   ) else
 124     fprintf chan "\n"