*)
type bitstring = string * int * int
+type t = bitstring
+
(* Functions to create and load bitstrings. *)
let empty_bitstring = "", 0, 0
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)
(*----------------------------------------------------------------------*)
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
let minus_one = -1
let ff = 0xff
- (* Create a mask so many bits wide. *)
+ (* Create a mask 0-31 bits wide. *)
let mask bits =
- if bits < 30 then
- pred (one << bits)
+ if bits < 30 ||
+ (bits < 32 && Sys.word_size = 64) then
+ (one <<< bits) - 1
else if bits = 30 then
max_int
else if bits = 31 then
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
)
let mask = lnot (mask bits) in
(v land mask) = zero
+ let range_signed v bits =
+ if
+ v >= zero
+ then
+ range_unsigned v bits
+ else
+ if
+ bits = 31 && Sys.word_size = 32
+ then
+ v >= min_int
+ else
+ pred (minus_one <<< pred bits) < v
+
(* Call function g on the top bits, then f on each full byte
* (big endian - so start at top).
*)
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 (
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
* 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
(* 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
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
)
*)
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 (
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
* 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
(* 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
*)
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 (
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
* 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.
*)
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.
let _get_byte64 data byteoff strlen =
if strlen > byteoff then Int64.of_int (Char.code data.[byteoff]) else 0L
+(* Extend signed [2..31] bits int to 31 bits int or 63 bits int for 64
+ bits platform*)
+let extend_sign len v =
+ let b = pred Sys.word_size - len in
+ (v lsl b) asr b
+
+let extract_and_extend_sign f data off len flen =
+ let w = f data off len flen in
+ extend_sign len w
+
(* Extract [2..8] bits. Because the result fits into a single
* byte we don't have to worry about endianness, only signedness.
*)
(* 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).
let shift = 16 - ((off land 7) + flen) in
let word = word lsr shift in
- word, off+flen, len-flen
+ word (*, off+flen, len-flen*)
)
+let extract_char_signed =
+ extract_and_extend_sign extract_char_unsigned
+
(* Extract [9..31] bits. We have to consider endianness and signedness. *)
let extract_int_be_unsigned data off len flen =
let byteoff = off lsr 3 in
) 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_be_signed =
+ extract_and_extend_sign extract_int_be_unsigned
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_le_signed =
+ extract_and_extend_sign extract_int_le_unsigned
let extract_int_ne_unsigned =
if nativeendian = BigEndian
then extract_int_be_unsigned
else extract_int_le_unsigned
+let extract_int_ne_signed =
+ extract_and_extend_sign extract_int_ne_unsigned
+
let extract_int_ee_unsigned = function
| BigEndian -> extract_int_be_unsigned
| LittleEndian -> extract_int_le_unsigned
| NativeEndian -> extract_int_ne_unsigned
+let extract_int_ee_signed e =
+ extract_and_extend_sign (extract_int_ee_unsigned e)
+
let _make_int32_be c0 c1 c2 c3 =
Int32.logor
(Int32.logor
) 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
_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
) 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
_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
) 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
_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
| 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. *)
*)
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
);
else
Buffer._add_bits buf v flen
-(* Construct a field of up to 31 bits. *)
-let construct_int_be_unsigned buf v flen exn =
- (* Check value is within range. *)
- if not (I.range_unsigned v flen) then raise exn;
- (* Add the bytes. *)
- I.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
+let construct_char_signed buf v flen exn =
+ let max_val = 1 lsl flen
+ and min_val = - (1 lsl pred flen) in
+ if v < min_val || v >= max_val then
+ raise exn;
+ if flen = 8 then
+ Buffer.add_byte buf (if v >= 0 then v else 256 + v)
+ else
+ Buffer._add_bits buf v flen
(* Construct a field of up to 31 bits. *)
-let construct_int_le_unsigned buf v flen exn =
- (* Check value is within range. *)
- if not (I.range_unsigned v flen) then raise exn;
- (* Add the bytes. *)
- I.map_bytes_le (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
+let construct_int check_func map_func buf v flen exn =
+ if not (check_func v flen) then raise exn;
+ map_func (Buffer._add_bits buf) (Buffer.add_byte buf) v flen
+
+let construct_int_be_unsigned =
+ construct_int I.range_unsigned I.map_bytes_be
+
+let construct_int_be_signed =
+ construct_int I.range_signed I.map_bytes_be
+
+let construct_int_le_unsigned =
+ construct_int I.range_unsigned I.map_bytes_le
+
+let construct_int_le_signed =
+ construct_int I.range_signed I.map_bytes_le
let construct_int_ne_unsigned =
if nativeendian = BigEndian
then construct_int_be_unsigned
else construct_int_le_unsigned
+let construct_int_ne_signed =
+ if nativeendian = BigEndian
+ then construct_int_be_signed
+ else construct_int_le_signed
+
let construct_int_ee_unsigned = function
| BigEndian -> construct_int_be_unsigned
| LittleEndian -> construct_int_le_unsigned
| NativeEndian -> construct_int_ne_unsigned
+let construct_int_ee_signed = function
+ | BigEndian -> construct_int_be_signed
+ | LittleEndian -> construct_int_le_signed
+ | NativeEndian -> construct_int_ne_signed
+
(* Construct a field of exactly 32 bits. *)
let construct_int32_be_unsigned buf v flen _ =
Buffer.add_byte buf
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
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)
)
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. *)
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
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
+
+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 || 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 || 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 =
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;
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
git.annexia.org / ocaml-bitstring.git / blobdiff