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)
(*----------------------------------------------------------------------*)
*)
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
);
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)
)
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. *)
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 ()
+ if n < 0 || 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 clear bits n = put bits n 0
let get (data, off, len) n =
- if n < 0 || off+n >= len then index_out_of_bounds ()
+ if n < 0 || 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
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