Allow bitstring to be compiled with Core.

[ocaml-bitstring.git] / bitstring.ml

diff --git a/bitstring.ml b/bitstring.ml
index 831c3b2..c860c08 100644 (file)
--- a/bitstring.ml
+++ b/bitstring.ml
@@ -130,17 +130,17 @@ let bitstring_length (_, _, len) = len
 
 let subbitstring (data, off, len) off' len' =
   let off = off + off' in
-  if len < off' + len' then invalid_arg "subbitstring";
+  if off' < 0 || len' < 0 || off' > len - len' then invalid_arg "subbitstring";
   (data, off, len')
 
 let dropbits n (data, off, len) =
   let off = off + n in
   let len = len - n in
-  if len < 0 then invalid_arg "dropbits";
+  if len < 0 || n < 0 then invalid_arg "dropbits";
   (data, off, len)
 
 let takebits n (data, off, len) =
-  if len < n then invalid_arg "takebits";
+  if len < n || n < 0 then invalid_arg "takebits";
   (data, off, n)
 
 (*----------------------------------------------------------------------*)
@@ -853,7 +853,8 @@ module Buffer = struct
           *)
          let slenbytes = slen lsr 3 in
          if slenbytes > 0 then Buffer.add_substring buf str 0 slenbytes;
-         let last = Char.code str.[slenbytes] in (* last char *)
+         let lastidx = min slenbytes (String.length str - 1) in
+         let last = Char.code str.[lastidx] in (* last char *)
          let mask = 0xff lsl (8 - (slen land 7)) in
          t.last <- last land mask
        );
@@ -992,7 +993,7 @@ let construct_bitstring buf (data, off, len) =
     if blen = 0 then (off, len)
     else (
       let b = extract_bit data off len 1
-      and off = off + 1 and len = len + 1 in
+      and off = off + 1 and len = len - 1 in
       Buffer.add_bit buf b;
       loop off len (blen-1)
     )
@@ -1100,6 +1101,42 @@ let equals ((_, _, len1) as bs1) ((_, _, len2) as bs2) =
   else if bs1 = bs2 then true
   else 0 = compare bs1 bs2
 
+let is_zeroes_bitstring ((data, off, len) as bits) =
+  if off land 7 = 0 && len land 7 = 0 then (
+    let off = off lsr 3 and len = len lsr 3 in
+    let rec loop i =
+      if i < len then (
+        if String.unsafe_get data (off + i) <> '\000' then false
+        else loop (i+1)
+      ) else true
+    in
+    loop 0
+  )
+  else (
+    (* Slow/unaligned case. *)
+    let len = bitstring_length bits in
+    let zeroes = zeroes_bitstring len in
+    0 = compare bits zeroes
+  )
+
+let is_ones_bitstring ((data, off, len) as bits) =
+  if off land 7 = 0 && len land 7 = 0 then (
+    let off = off lsr 3 and len = len lsr 3 in
+    let rec loop i =
+      if i < len then (
+        if String.unsafe_get data (off + i) <> '\xff' then false
+        else loop (i+1)
+      ) else true
+    in
+    loop 0
+  )
+  else (
+    (* Slow/unaligned case. *)
+    let len = bitstring_length bits in
+    let ones = ones_bitstring len in
+    0 = compare bits ones
+  )
+
 (*----------------------------------------------------------------------*)
 (* Bit get/set functions. *)
 
@@ -1175,3 +1212,9 @@ let hexdump_bitstring chan (data, off, len) =
     fprintf chan " |%s|\n%!" linechars
   ) else
     fprintf chan "\n%!"
+
+(*----------------------------------------------------------------------*)
+(* Alias of functions shadowed by Core. *)
+
+let char_code = Char.code
+let int32_of_int = Int32.of_int