X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=bitmatch.ml;h=249bbff7ee0b774b3e0e02ed80436c03ab6dc895;hb=9c50223e129d33742f2d172edff5761f8b4b8195;hp=c9dba772f2121c9cfcf35e7bc2cc58182a0f7b35;hpb=cc8d8db279d521c89957402f9766dbcf50ddaa26;p=ocaml-bitstring.git diff --git a/bitmatch.ml b/bitmatch.ml index c9dba77..249bbff 100644 --- a/bitmatch.ml +++ b/bitmatch.ml @@ -4,7 +4,8 @@ * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either - * version 2 of the License, or (at your option) any later version. + * version 2 of the License, or (at your option) any later version, + * with the OCaml linking exception described in COPYING.LIB. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -15,7 +16,7 @@ * 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.14 2008-05-12 20:32:55 rjones Exp $ + * $Id$ *) open Printf @@ -40,10 +41,19 @@ type bitstring = string * int * int (* Functions to create and load bitstrings. *) let empty_bitstring = "", 0, 0 -let make_bitstring len c = String.make ((len+7) lsr 3) c, 0, len +let make_bitstring len c = + if len >= 0 then String.make ((len+7) lsr 3) c, 0, len + else + invalid_arg ( + sprintf "make_bitstring/create_bitstring: len %d < 0" len + ) let create_bitstring len = make_bitstring len '\000' +let zeroes_bitstring = create_bitstring + +let ones_bitstring len = make_bitstring len '\xff' + let bitstring_of_string str = str, 0, String.length str lsl 3 let bitstring_of_chan chan = @@ -420,6 +430,11 @@ let extract_int_ne_unsigned = 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 @@ -480,6 +495,11 @@ let extract_int32_ne_unsigned = 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 @@ -592,6 +612,11 @@ let extract_int64_ne_unsigned = 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. *) @@ -671,13 +696,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. *) @@ -686,7 +713,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 @@ -717,6 +751,12 @@ let construct_int_ne_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 @@ -728,11 +768,25 @@ 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*) - fun _ _ _ _ -> failwith "construct_int32_le_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 = @@ -747,6 +801,12 @@ let construct_int64_ne_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. *) @@ -754,6 +814,33 @@ let construct_string buf str = let len = String.length str in Buffer.add_bits buf str (len lsl 3) +(* Construct from a bitstring. *) +let construct_bitstring buf (data, off, len) = + (* Add individual bits until we get to the next byte boundary of + * the underlying string. + *) + let blen = 7 - ((off + 7) land 7) in + let blen = min blen len in + let rec loop off len blen = + if blen = 0 then (off, len) + else ( + let b, off, len = extract_bit data off len 1 in + Buffer.add_bit buf b; + loop off len (blen-1) + ) + in + let off, len = loop off len blen in + assert (len = 0 || (off land 7) = 0); + + (* Add the remaining 'len' bits. *) + let data = + let off = off lsr 3 in + (* XXX dangerous allocation *) + if off = 0 then data + else String.sub data off (String.length data - off) in + + Buffer.add_bits buf data len + (*----------------------------------------------------------------------*) (* Extract a string from a bitstring. *) @@ -771,11 +858,8 @@ let string_of_bitstring (data, off, len) = str.[i] <- Char.chr c; loop data off len (i+1) ) else if len > 0 then ( - (* XXX Is this correct? It should write into the high bits - * of the last byte. - *) - 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;