X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=bitstring.ml;h=48351bcd790ee799d41c084d009a1164b60125ff;hb=64bcd448dc8787b82828a49edb709436ec2de93d;hp=610c2b527cba67e1b4e1420b81c25b2b3ff4255e;hpb=42545798e1ada7e47d7ba56e1c9c2e32bc0e7129;p=ocaml-bitstring.git diff --git a/bitstring.ml b/bitstring.ml index 610c2b5..48351bc 100644 --- a/bitstring.ml +++ b/bitstring.ml @@ -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;