X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=bitmatch.ml;h=e3825045a5a61494b6f1424c03ba5120fff54ad9;hb=5522213ceeb1a53555ab0d8354a9dc789e488784;hp=365b052038b779f1758ab88557c650e2df50f5b7;hpb=dffbeca2dd8a39d66026201760a715f5b25762e2;p=ocaml-bitstring.git diff --git a/bitmatch.ml b/bitmatch.ml index 365b052..e382504 100644 --- a/bitmatch.ml +++ b/bitmatch.ml @@ -15,11 +15,14 @@ * License along with this library; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA * - * $Id: bitmatch.ml,v 1.13 2008-05-08 21:28:28 rjones Exp $ + * $Id$ *) open Printf +include Bitmatch_types +include Bitmatch_config + (* Enable runtime debug messages. Must also have been enabled * in pa_bitmatch.ml. *) @@ -103,9 +106,13 @@ let bitstring_of_file_descr_max fd max = let bitstring_of_file fname = let chan = open_in_bin fname in - let bs = bitstring_of_chan chan in - close_in chan; - bs + try + let bs = bitstring_of_chan chan in + close_in chan; + bs + with exn -> + close_in chan; + raise exn let bitstring_length (_, _, len) = len @@ -408,6 +415,16 @@ let extract_int_le_unsigned data off len flen = let v = I.byteswap v flen in v, off, len +let extract_int_ne_unsigned = + if nativeendian = BigEndian + then extract_int_be_unsigned + else extract_int_le_unsigned + +let extract_int_ee_unsigned = function + | BigEndian -> extract_int_be_unsigned + | LittleEndian -> extract_int_le_unsigned + | NativeEndian -> extract_int_ne_unsigned + let _make_int32_be c0 c1 c2 c3 = Int32.logor (Int32.logor @@ -463,6 +480,16 @@ let extract_int32_le_unsigned data off len flen = let v = I32.byteswap v flen in v, off, len +let extract_int32_ne_unsigned = + if nativeendian = BigEndian + then extract_int32_be_unsigned + else extract_int32_le_unsigned + +let extract_int32_ee_unsigned = function + | BigEndian -> extract_int32_be_unsigned + | LittleEndian -> extract_int32_le_unsigned + | NativeEndian -> extract_int32_ne_unsigned + let _make_int64_be c0 c1 c2 c3 c4 c5 c6 c7 = Int64.logor (Int64.logor @@ -545,7 +572,7 @@ let extract_int64_le_unsigned data off len flen = let c6 = _get_byte64 data (byteoff+6) strlen in let c7 = _get_byte64 data (byteoff+7) strlen in _make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in - Int64.shift_right_logical word (64 - flen) + Int64.logand word (I64.mask flen) ) else ( (* Extract the next 64 bits, slow method. *) let word = @@ -566,10 +593,20 @@ let extract_int64_le_unsigned data off len flen = let c6 = Int64.of_int c6 in let c7 = Int64.of_int c7 in _make_int64_le c0 c1 c2 c3 c4 c5 c6 c7 in - Int64.shift_right_logical word (64 - flen) + Int64.logand word (I64.mask flen) ) in word, off+flen, len-flen +let extract_int64_ne_unsigned = + if nativeendian = BigEndian + then extract_int64_be_unsigned + else extract_int64_le_unsigned + +let extract_int64_ee_unsigned = function + | BigEndian -> extract_int64_be_unsigned + | LittleEndian -> extract_int64_le_unsigned + | NativeEndian -> extract_int64_ne_unsigned + (*----------------------------------------------------------------------*) (* Constructor functions. *) @@ -649,13 +686,15 @@ module Buffer = struct *) let slenbytes = slen lsr 3 in if slenbytes > 0 then Buffer.add_substring buf str 0 slenbytes; - t.last <- Char.code str.[slenbytes] lsl (8 - (slen land 7)) + let last = Char.code str.[slenbytes] in (* last char *) + let mask = 0xff lsl (8 - (slen land 7)) in + t.last <- last land mask ); t.len <- len + slen ) else ( (* Target buffer is unaligned. Copy whole bytes using * add_byte which knows how to deal with an unaligned - * target buffer, then call _add_bits for the remaining < 8 bits. + * target buffer, then call add_bit for the remaining < 8 bits. * * XXX This is going to be dog-slow. *) @@ -664,7 +703,14 @@ module Buffer = struct let byte = Char.code str.[i] in add_byte t byte done; - _add_bits t (Char.code str.[slenbytes]) (slen - (slenbytes lsl 3)) + let bitsleft = slen - (slenbytes lsl 3) in + if bitsleft > 0 then ( + let c = Char.code str.[slenbytes] in + for i = 0 to bitsleft - 1 do + let bit = c land (0x80 lsr i) <> 0 in + add_bit t bit + done + ) ); ) end @@ -689,6 +735,18 @@ let construct_int_be_unsigned buf v flen exn = (* Add the bytes. *) I.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen +let construct_int_ne_unsigned = + if nativeendian = BigEndian + then construct_int_be_unsigned + else (*construct_int_le_unsigned*) + fun _ _ _ _ -> failwith "construct_int_le_unsigned" + +let construct_int_ee_unsigned = function + | BigEndian -> construct_int_be_unsigned + | LittleEndian -> (*construct_int_le_unsigned*) + (fun _ _ _ _ -> failwith "construct_int_le_unsigned") + | NativeEndian -> construct_int_ne_unsigned + (* Construct a field of exactly 32 bits. *) let construct_int32_be_unsigned buf v flen _ = Buffer.add_byte buf @@ -700,6 +758,26 @@ let construct_int32_be_unsigned buf v flen _ = Buffer.add_byte buf (Int32.to_int (Int32.logand v 0xff_l)) +let construct_int32_le_unsigned buf v flen _ = + Buffer.add_byte buf + (Int32.to_int (Int32.logand v 0xff_l)); + Buffer.add_byte buf + (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 8) 0xff_l))); + Buffer.add_byte buf + (Int32.to_int ((Int32.logand (Int32.shift_right_logical v 16) 0xff_l))); + Buffer.add_byte buf + (Int32.to_int (Int32.shift_right_logical v 24)) + +let construct_int32_ne_unsigned = + if nativeendian = BigEndian + then construct_int32_be_unsigned + else construct_int32_le_unsigned + +let construct_int32_ee_unsigned = function + | BigEndian -> construct_int32_be_unsigned + | LittleEndian -> construct_int32_le_unsigned + | NativeEndian -> construct_int32_ne_unsigned + (* Construct a field of up to 64 bits. *) let construct_int64_be_unsigned buf v flen exn = (* Check value is within range. *) @@ -707,6 +785,18 @@ let construct_int64_be_unsigned buf v flen exn = (* Add the bytes. *) I64.map_bytes_be (Buffer._add_bits buf) (Buffer.add_byte buf) v flen +let construct_int64_ne_unsigned = + if nativeendian = BigEndian + then construct_int64_be_unsigned + else (*construct_int64_le_unsigned*) + fun _ _ _ _ -> failwith "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") + | NativeEndian -> construct_int64_ne_unsigned + (* Construct from a string of bytes, exact multiple of 8 bits * in length of course. *) @@ -731,14 +821,38 @@ let string_of_bitstring (data, off, len) = str.[i] <- Char.chr c; loop data off len (i+1) ) else if len > 0 then ( - let c, off, len = extract_char_unsigned data off len len in - str.[i] <- Char.chr c + let c, _, _ = extract_char_unsigned data off len len in + str.[i] <- Char.chr (c lsl (8-len)) ) in loop data off len 0; str ) +(* To channel. *) + +let bitstring_to_chan ((data, off, len) as bits) chan = + (* Fail if the bitstring length isn't a multiple of 8. *) + if len land 7 <> 0 then invalid_arg "bitstring_to_chan"; + + if off land 7 = 0 then + (* Easy case: string is byte-aligned. *) + output chan data (off lsr 3) (len lsr 3) + else ( + (* Bit-twiddling case: reuse string_of_bitstring *) + let str = string_of_bitstring bits in + output_string chan str + ) + +let bitstring_to_file bits filename = + let chan = open_out_bin filename in + try + bitstring_to_chan bits chan; + close_out chan + with exn -> + close_out chan; + raise exn + (*----------------------------------------------------------------------*) (* Display functions. *)