Added bootstrap and uninstall target
[ocaml-bitstring.git] / bitstring.ml
index 610c2b5..48351bc 100644 (file)
@@ -38,6 +38,8 @@ exception Construct_failure of string * string * int * int
  *)
 type bitstring = string * int * int
 
+type t = bitstring
+
 (* Functions to create and load bitstrings. *)
 let empty_bitstring = "", 0, 0
 
@@ -149,8 +151,8 @@ let takebits n (data, off, len) =
 
 module I = struct
   (* Bitwise operations on ints.  Note that we assume int <= 31 bits. *)
-  let (<<) = (lsl)
-  let (>>) = (lsr)
+  external (<<<) : int -> int -> int = "%lslint"
+  external (>>>) : int -> int -> int = "%lsrint"
   external to_int : int -> int = "%identity"
   let zero = 0
   let one = 1
@@ -158,28 +160,36 @@ module I = struct
   let ff = 0xff
 
   (* Create a mask 0-31 bits wide. *)
-  external mask : int -> int = "ocaml_bitstring_I_mask" "noalloc"
+  let mask bits =
+    if bits < 30 then
+      (one <<< bits) - 1
+    else if bits = 30 then
+      max_int
+    else if bits = 31 then
+      minus_one
+    else
+      invalid_arg "Bitstring.I.mask"
 
   (* Byte swap an int of a given size. *)
   let byteswap v bits =
     if bits <= 8 then v
     else if bits <= 16 then (
       let shift = bits-8 in
-      let v1 = v >> shift in
-      let v2 = (v land (mask shift)) << 8 in
+      let v1 = v >>> shift in
+      let v2 = ((v land (mask shift)) <<< 8) in
       v2 lor v1
     ) else if bits <= 24 then (
       let shift = bits - 16 in
-      let v1 = v >> (8+shift) in
-      let v2 = ((v >> shift) land ff) << 8 in
-      let v3 = (v land (mask shift)) << 16 in
+      let v1 = v >>> (8+shift) in
+      let v2 = ((v >>> shift) land ff) <<< 8 in
+      let v3 = (v land (mask shift)) <<< 16 in
       v3 lor v2 lor v1
     ) else (
       let shift = bits - 24 in
-      let v1 = v >> (16+shift) in
-      let v2 = ((v >> (8+shift)) land ff) << 8 in
-      let v3 = ((v >> shift) land ff) << 16 in
-      let v4 = (v land (mask shift)) << 24 in
+      let v1 = v >>> (16+shift) in
+      let v2 = ((v >>> (8+shift)) land ff) <<< 8 in
+      let v3 = ((v >>> shift) land ff) <<< 16 in
+      let v4 = (v land (mask shift)) <<< 24 in
       v4 lor v3 lor v2 lor v1
     )
 
@@ -193,7 +203,7 @@ module I = struct
    *)
   let rec map_bytes_be g f v bits =
     if bits >= 8 then (
-      map_bytes_be g f (v >> 8) (bits-8);
+      map_bytes_be g f (v >>> 8) (bits-8);
       let lsb = v land ff in
       f (to_int lsb)
     ) else if bits > 0 then (
@@ -208,7 +218,7 @@ module I = struct
     if bits >= 8 then (
       let lsb = v land ff in
       f (to_int lsb);
-      map_bytes_le g f (v >> 8) (bits-8)
+      map_bytes_le g f (v >>> 8) (bits-8)
     ) else if bits > 0 then (
       let lsb = v land (mask bits) in
       g (to_int lsb) bits
@@ -220,8 +230,8 @@ module I32 = struct
    * as possible to the I module above, to make it easier to track
    * down bugs.
    *)
-  let (<<) = Int32.shift_left
-  let (>>) = Int32.shift_right_logical
+  let (<<<) = Int32.shift_left
+  let (>>>) = Int32.shift_right_logical
   let (land) = Int32.logand
   let (lor) = Int32.logor
   let lnot = Int32.lognot
@@ -236,7 +246,7 @@ module I32 = struct
   (* Create a mask so many bits wide. *)
   let mask bits =
     if bits < 31 then
-      pred (one << bits)
+      pred (one <<< bits)
     else if bits = 31 then
       max_int
     else if bits = 32 then
@@ -249,21 +259,21 @@ module I32 = struct
     if bits <= 8 then v
     else if bits <= 16 then (
       let shift = bits-8 in
-      let v1 = v >> shift in
-      let v2 = (v land (mask shift)) << 8 in
+      let v1 = v >>> shift in
+      let v2 = (v land (mask shift)) <<< 8 in
       v2 lor v1
     ) else if bits <= 24 then (
       let shift = bits - 16 in
-      let v1 = v >> (8+shift) in
-      let v2 = ((v >> shift) land ff) << 8 in
-      let v3 = (v land (mask shift)) << 16 in
+      let v1 = v >>> (8+shift) in
+      let v2 = ((v >>> shift) land ff) <<< 8 in
+      let v3 = (v land (mask shift)) <<< 16 in
       v3 lor v2 lor v1
     ) else (
       let shift = bits - 24 in
-      let v1 = v >> (16+shift) in
-      let v2 = ((v >> (8+shift)) land ff) << 8 in
-      let v3 = ((v >> shift) land ff) << 16 in
-      let v4 = (v land (mask shift)) << 24 in
+      let v1 = v >>> (16+shift) in
+      let v2 = ((v >>> (8+shift)) land ff) <<< 8 in
+      let v3 = ((v >>> shift) land ff) <<< 16 in
+      let v4 = (v land (mask shift)) <<< 24 in
       v4 lor v3 lor v2 lor v1
     )
 
@@ -277,7 +287,7 @@ module I32 = struct
    *)
   let rec map_bytes_be g f v bits =
     if bits >= 8 then (
-      map_bytes_be g f (v >> 8) (bits-8);
+      map_bytes_be g f (v >>> 8) (bits-8);
       let lsb = v land ff in
       f (to_int lsb)
     ) else if bits > 0 then (
@@ -292,7 +302,7 @@ module I32 = struct
     if bits >= 8 then (
       let lsb = v land ff in
       f (to_int lsb);
-      map_bytes_le g f (v >> 8) (bits-8)
+      map_bytes_le g f (v >>> 8) (bits-8)
     ) else if bits > 0 then (
       let lsb = v land (mask bits) in
       g (to_int lsb) bits
@@ -304,8 +314,8 @@ module I64 = struct
    * as possible to the I/I32 modules above, to make it easier to track
    * down bugs.
    *)
-  let (<<) = Int64.shift_left
-  let (>>) = Int64.shift_right_logical
+  let (<<<) = Int64.shift_left
+  let (>>>) = Int64.shift_right_logical
   let (land) = Int64.logand
   let (lor) = Int64.logor
   let lnot = Int64.lognot
@@ -320,7 +330,7 @@ module I64 = struct
   (* Create a mask so many bits wide. *)
   let mask bits =
     if bits < 63 then
-      pred (one << bits)
+      pred (one <<< bits)
     else if bits = 63 then
       max_int
     else if bits = 64 then
@@ -341,7 +351,7 @@ module I64 = struct
    *)
   let rec map_bytes_be g f v bits =
     if bits >= 8 then (
-      map_bytes_be g f (v >> 8) (bits-8);
+      map_bytes_be g f (v >>> 8) (bits-8);
       let lsb = v land ff in
       f (to_int lsb)
     ) else if bits > 0 then (
@@ -356,7 +366,7 @@ module I64 = struct
     if bits >= 8 then (
       let lsb = v land ff in
       f (to_int lsb);
-      map_bytes_le g f (v >> 8) (bits-8)
+      map_bytes_le g f (v >>> 8) (bits-8)
     ) else if bits > 0 then (
       let lsb = v land (mask bits) in
       g (to_int lsb) bits
@@ -370,13 +380,6 @@ end
  * the parameters should have been checked for sanity already).
  *)
 
-(* Bitstrings. *)
-let extract_bitstring data off len flen =
-  (data, off, flen), off+flen, len-flen
-
-let extract_remainder data off len =
-  (data, off, len), off+len, 0
-
 (* Extract and convert to numeric.  A single bit is returned as
  * a boolean.  There are no endianness or signedness considerations.
  *)
@@ -384,7 +387,7 @@ let extract_bit data off len _ =    (* final param is always 1 *)
   let byteoff = off lsr 3 in
   let bitmask = 1 lsl (7 - (off land 7)) in
   let b = Char.code data.[byteoff] land bitmask <> 0 in
-  b, off+1, len-1
+  b (*, off+1, len-1*)
 
 (* Returns 8 bit unsigned aligned bytes from the string.
  * If the string ends then this returns 0's.
@@ -405,7 +408,7 @@ let extract_char_unsigned data off len flen =
   (* Optimize the common (byte-aligned) case. *)
   if off land 7 = 0 then (
     let byte = Char.code data.[byteoff] in
-    byte lsr (8 - flen), off+flen, len-flen
+    byte lsr (8 - flen) (*, off+flen, len-flen*)
   ) else (
     (* Extract the 16 bits at byteoff and byteoff+1 (note that the
      * second byte might not exist in the original string).
@@ -423,7 +426,7 @@ let extract_char_unsigned data off len flen =
     let shift = 16 - ((off land 7) + flen) in
     let word = word lsr shift in
 
-    word, off+flen, len-flen
+    word (*, off+flen, len-flen*)
   )
 
 (* Extract [9..31] bits.  We have to consider endianness and signedness. *)
@@ -457,19 +460,22 @@ let extract_int_be_unsigned data off len flen =
     ) else (
       (* Extract the next 31 bits, slow method. *)
       let word =
-       let c0, off, len = extract_char_unsigned data off len 8 in
-       let c1, off, len = extract_char_unsigned data off len 8 in
-       let c2, off, len = extract_char_unsigned data off len 8 in
-       let c3, off, len = extract_char_unsigned data off len 7 in
+       let c0 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c1 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c2 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c3 = extract_char_unsigned data off len 7 in
        (c0 lsl 23) + (c1 lsl 15) + (c2 lsl 7) + c3 in
       word lsr (31 - flen)
     ) in
-  word, off+flen, len-flen
+  word (*, off+flen, len-flen*)
 
 let extract_int_le_unsigned data off len flen =
-  let v, off, len = extract_int_be_unsigned data off len flen in
+  let v = extract_int_be_unsigned data off len flen in
   let v = I.byteswap v flen in
-  v, off, len
+  v
 
 let extract_int_ne_unsigned =
   if nativeendian = BigEndian
@@ -518,10 +524,13 @@ let extract_int32_be_unsigned data off len flen =
     ) else (
       (* Extract the next 32 bits, slow method. *)
       let word =
-       let c0, off, len = extract_char_unsigned data off len 8 in
-       let c1, off, len = extract_char_unsigned data off len 8 in
-       let c2, off, len = extract_char_unsigned data off len 8 in
-       let c3, _, _ = extract_char_unsigned data off len 8 in
+       let c0 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c1 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c2 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c3 = extract_char_unsigned data off len 8 in
        let c0 = Int32.of_int c0 in
        let c1 = Int32.of_int c1 in
        let c2 = Int32.of_int c2 in
@@ -529,12 +538,12 @@ let extract_int32_be_unsigned data off len flen =
        _make_int32_be c0 c1 c2 c3 in
       Int32.shift_right_logical word (32 - flen)
     ) in
-  word, off+flen, len-flen
+  word (*, off+flen, len-flen*)
 
 let extract_int32_le_unsigned data off len flen =
-  let v, off, len = extract_int32_be_unsigned data off len flen in
+  let v = extract_int32_be_unsigned data off len flen in
   let v = I32.byteswap v flen in
-  v, off, len
+  v
 
 let extract_int32_ne_unsigned =
   if nativeendian = BigEndian
@@ -589,14 +598,21 @@ let extract_int64_be_unsigned data off len flen =
     ) else (
       (* Extract the next 64 bits, slow method. *)
       let word =
-       let c0, off, len = extract_char_unsigned data off len 8 in
-       let c1, off, len = extract_char_unsigned data off len 8 in
-       let c2, off, len = extract_char_unsigned data off len 8 in
-       let c3, off, len = extract_char_unsigned data off len 8 in
-       let c4, off, len = extract_char_unsigned data off len 8 in
-       let c5, off, len = extract_char_unsigned data off len 8 in
-       let c6, off, len = extract_char_unsigned data off len 8 in
-       let c7, _, _ = extract_char_unsigned data off len 8 in
+       let c0 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c1 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c2 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c3 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c4 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c5 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c6 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c7 = extract_char_unsigned data off len 8 in
        let c0 = Int64.of_int c0 in
        let c1 = Int64.of_int c1 in
        let c2 = Int64.of_int c2 in
@@ -608,7 +624,7 @@ let extract_int64_be_unsigned data off len flen =
        _make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 in
       Int64.shift_right_logical word (64 - flen)
     ) in
-  word, off+flen, len-flen
+  word (*, off+flen, len-flen*)
 
 let extract_int64_le_unsigned data off len flen =
   let byteoff = off lsr 3 in
@@ -632,14 +648,21 @@ let extract_int64_le_unsigned data off len flen =
     ) else (
       (* Extract the next 64 bits, slow method. *)
       let word =
-       let c0, off, len = extract_char_unsigned data off len 8 in
-       let c1, off, len = extract_char_unsigned data off len 8 in
-       let c2, off, len = extract_char_unsigned data off len 8 in
-       let c3, off, len = extract_char_unsigned data off len 8 in
-       let c4, off, len = extract_char_unsigned data off len 8 in
-       let c5, off, len = extract_char_unsigned data off len 8 in
-       let c6, off, len = extract_char_unsigned data off len 8 in
-       let c7, _, _ = extract_char_unsigned data off len 8 in
+       let c0 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c1 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c2 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c3 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c4 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c5 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c6 = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
+       let c7 = extract_char_unsigned data off len 8 in
        let c0 = Int64.of_int c0 in
        let c1 = Int64.of_int c1 in
        let c2 = Int64.of_int c2 in
@@ -651,7 +674,7 @@ let extract_int64_le_unsigned data off len flen =
        _make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in
       Int64.logand word (I64.mask flen)
     ) in
-  word, off+flen, len-flen
+  word (*, off+flen, len-flen*)
 
 let extract_int64_ne_unsigned =
   if nativeendian = BigEndian
@@ -663,6 +686,94 @@ let extract_int64_ee_unsigned = function
   | LittleEndian -> extract_int64_le_unsigned
   | NativeEndian -> extract_int64_ne_unsigned
 
+external extract_fastpath_int16_be_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_unsigned" "noalloc"
+
+external extract_fastpath_int16_le_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_unsigned" "noalloc"
+
+external extract_fastpath_int16_ne_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_unsigned" "noalloc"
+
+external extract_fastpath_int16_be_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_be_signed" "noalloc"
+
+external extract_fastpath_int16_le_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_le_signed" "noalloc"
+
+external extract_fastpath_int16_ne_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int16_ne_signed" "noalloc"
+
+(*
+external extract_fastpath_int24_be_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_unsigned" "noalloc"
+
+external extract_fastpath_int24_le_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_unsigned" "noalloc"
+
+external extract_fastpath_int24_ne_unsigned : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_unsigned" "noalloc"
+
+external extract_fastpath_int24_be_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_be_signed" "noalloc"
+
+external extract_fastpath_int24_le_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_le_signed" "noalloc"
+
+external extract_fastpath_int24_ne_signed : string -> int -> int = "ocaml_bitstring_extract_fastpath_int24_ne_signed" "noalloc"
+*)
+
+external extract_fastpath_int32_be_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_unsigned" "noalloc"
+
+external extract_fastpath_int32_le_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_unsigned" "noalloc"
+
+external extract_fastpath_int32_ne_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_unsigned" "noalloc"
+
+external extract_fastpath_int32_be_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_signed" "noalloc"
+
+external extract_fastpath_int32_le_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_signed" "noalloc"
+
+external extract_fastpath_int32_ne_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_signed" "noalloc"
+
+(*
+external extract_fastpath_int40_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_unsigned" "noalloc"
+
+external extract_fastpath_int40_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_unsigned" "noalloc"
+
+external extract_fastpath_int40_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_unsigned" "noalloc"
+
+external extract_fastpath_int40_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_signed" "noalloc"
+
+external extract_fastpath_int40_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_signed" "noalloc"
+
+external extract_fastpath_int40_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_signed" "noalloc"
+
+external extract_fastpath_int48_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_unsigned" "noalloc"
+
+external extract_fastpath_int48_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_unsigned" "noalloc"
+
+external extract_fastpath_int48_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_unsigned" "noalloc"
+
+external extract_fastpath_int48_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_signed" "noalloc"
+
+external extract_fastpath_int48_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_signed" "noalloc"
+
+external extract_fastpath_int48_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_signed" "noalloc"
+
+external extract_fastpath_int56_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_unsigned" "noalloc"
+
+external extract_fastpath_int56_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_unsigned" "noalloc"
+
+external extract_fastpath_int56_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_unsigned" "noalloc"
+
+external extract_fastpath_int56_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_signed" "noalloc"
+
+external extract_fastpath_int56_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_signed" "noalloc"
+
+external extract_fastpath_int56_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_signed" "noalloc"
+*)
+
+external extract_fastpath_int64_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_unsigned" "noalloc"
+
+external extract_fastpath_int64_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_unsigned" "noalloc"
+
+external extract_fastpath_int64_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_unsigned" "noalloc"
+
+external extract_fastpath_int64_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_signed" "noalloc"
+
+external extract_fastpath_int64_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_signed" "noalloc"
+
+external extract_fastpath_int64_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_signed" "noalloc"
+
 (*----------------------------------------------------------------------*)
 (* Constructor functions. *)
 
@@ -856,13 +967,11 @@ let construct_int64_le_unsigned buf v flen exn =
 let construct_int64_ne_unsigned =
   if nativeendian = BigEndian
   then construct_int64_be_unsigned
-  else (*construct_int64_le_unsigned*)
-    fun _ _ _ _ -> failwith "construct_int64_le_unsigned"
+  else construct_int64_le_unsigned
 
 let construct_int64_ee_unsigned = function
   | BigEndian -> construct_int64_be_unsigned
-  | LittleEndian -> (*construct_int64_le_unsigned*)
-      (fun _ _ _ _ -> failwith "construct_int64_le_unsigned")
+  | LittleEndian -> construct_int64_le_unsigned
   | NativeEndian -> construct_int64_ne_unsigned
 
 (* Construct from a string of bytes, exact multiple of 8 bits
@@ -882,7 +991,8 @@ let construct_bitstring buf (data, off, len) =
   let rec loop off len blen =
     if blen = 0 then (off, len)
     else (
-      let b, off, len = extract_bit data off len 1 in
+      let b = extract_bit data off len 1
+      and off = off + 1 and len = len + 1 in
       Buffer.add_bit buf b;
       loop off len (blen-1)
     )
@@ -899,9 +1009,14 @@ let construct_bitstring buf (data, off, len) =
 
   Buffer.add_bits buf data len
 
+(* Concatenate bitstrings. *)
+let concat bs =
+  let buf = Buffer.create () in
+  List.iter (construct_bitstring buf) bs;
+  Buffer.contents buf
+
 (*----------------------------------------------------------------------*)
 (* Extract a string from a bitstring. *)
-
 let string_of_bitstring (data, off, len) =
   if off land 7 = 0 && len land 7 = 0 then
     (* Easy case: everything is byte-aligned. *)
@@ -912,11 +1027,12 @@ let string_of_bitstring (data, off, len) =
     let str = String.make strlen '\000' in
     let rec loop data off len i =
       if len >= 8 then (
-       let c, off, len = extract_char_unsigned data off len 8 in
+       let c = extract_char_unsigned data off len 8
+       and off = off + 8 and len = len - 8 in
        str.[i] <- Char.chr c;
        loop data off len (i+1)
       ) else if len > 0 then (
-       let c, _, _ = extract_char_unsigned data off len len in
+       let c = extract_char_unsigned data off len len in
        str.[i] <- Char.chr (c lsl (8-len))
       )
     in
@@ -949,6 +1065,74 @@ let bitstring_to_file bits filename =
     raise exn
 
 (*----------------------------------------------------------------------*)
+(* Comparison. *)
+let compare ((data1, off1, len1) as bs1) ((data2, off2, len2) as bs2) =
+  (* In the fully-aligned case, this is reduced to string comparison ... *)
+  if off1 land 7 = 0 && len1 land 7 = 0 && off2 land 7 = 0 && len2 land 7 = 0
+  then (
+    (* ... but we have to do that by hand because the bits may
+     * not extend to the full length of the underlying string.
+     *)
+    let off1 = off1 lsr 3 and off2 = off2 lsr 3
+    and len1 = len1 lsr 3 and len2 = len2 lsr 3 in
+    let rec loop i =
+      if i < len1 && i < len2 then (
+       let c1 = String.unsafe_get data1 (off1 + i)
+       and c2 = String.unsafe_get data2 (off2 + i) in
+       let r = compare c1 c2 in
+       if r <> 0 then r
+       else loop (i+1)
+      )
+      else len1 - len2
+    in
+    loop 0
+  )
+  else (
+    (* Slow/unaligned. *)
+    let str1 = string_of_bitstring bs1
+    and str2 = string_of_bitstring bs2 in
+    let r = String.compare str1 str2 in
+    if r <> 0 then r else len1 - len2
+  )
+
+let equals ((_, _, len1) as bs1) ((_, _, len2) as bs2) =
+  if len1 <> len2 then false
+  else if bs1 = bs2 then true
+  else 0 = compare bs1 bs2
+
+(*----------------------------------------------------------------------*)
+(* Bit get/set functions. *)
+
+let index_out_of_bounds () = invalid_arg "index out of bounds"
+
+let put (data, off, len) n v =
+  if n < 0 || off+n >= len then index_out_of_bounds ()
+  else (
+    let i = off+n in
+    let si = i lsr 3 and mask = 0x80 lsr (i land 7) in
+    let c = Char.code data.[si] in
+    let c = if v <> 0 then c lor mask else c land (lnot mask) in
+    data.[si] <- Char.unsafe_chr c
+  )
+
+let set bits n = put bits n 1
+
+let clear bits n = put bits n 0
+
+let get (data, off, len) n =
+  if n < 0 || off+n >= len then index_out_of_bounds ()
+  else (
+    let i = off+n in
+    let si = i lsr 3 and mask = 0x80 lsr (i land 7) in
+    let c = Char.code data.[si] in
+    c land mask
+  )
+
+let is_set bits n = get bits n <> 0
+
+let is_clear bits n = get bits n = 0
+
+(*----------------------------------------------------------------------*)
 (* Display functions. *)
 
 let isprint c =
@@ -966,8 +1150,8 @@ let hexdump_bitstring chan (data, off, len) =
 
   while !len > 0 do
     let bits = min !len 8 in
-    let byte, off', len' = extract_char_unsigned data !off !len bits in
-    off := off'; len := len';
+    let byte = extract_char_unsigned data !off !len bits in
+    off := !off + bits; len := !len - bits;
 
     let byte = byte lsl (8-bits) in
     fprintf chan "%02x " byte;