X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=bitmatch.ml;h=e89e381af39bf25367d6c90258b6d8937bcce440;hb=d6d2c281d7f09c4d0a77877d2f8cbe39051d6f1e;hp=7065d661edaa4f528ad822fa5758428cf74bd0b0;hpb=00f782f26fa89fa07dabb7155707b1415f50572b;p=ocaml-bitstring.git diff --git a/bitmatch.ml b/bitmatch.ml index 7065d66..e89e381 100644 --- a/bitmatch.ml +++ b/bitmatch.ml @@ -40,10 +40,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 +429,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 +494,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 +611,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 +695,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 +712,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 +750,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 +767,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 +800,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 +813,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 +857,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;