X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=bitstring.ml;h=4f4ed2c4a75142a7ac476acab889f88ef4013840;hb=f1673f86fd358706beb7b5ce357eb4e0ff1d970a;hp=c860c08d671048ff674e970b56451ba79d9e56bf;hpb=e7c7bd5bed1125a1aa073fd1bf0797a2df42e6aa;p=ocaml-bitstring.git diff --git a/bitstring.ml b/bitstring.ml index c860c08..4f4ed2c 100644 --- a/bitstring.ml +++ b/bitstring.ml @@ -161,7 +161,8 @@ module I = struct (* Create a mask 0-31 bits wide. *) let mask bits = - if bits < 30 then + if bits < 30 || + (bits < 32 && Sys.word_size = 64) then (one <<< bits) - 1 else if bits = 30 then max_int @@ -198,6 +199,19 @@ module I = struct 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). *) @@ -399,6 +413,16 @@ let _get_byte32 data byteoff strlen = 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. *) @@ -429,6 +453,9 @@ let extract_char_unsigned data off 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 @@ -472,21 +499,33 @@ let extract_int_be_unsigned data off len flen = ) in 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 = extract_int_be_unsigned data off len flen in let v = I.byteswap v flen in 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 @@ -712,67 +751,67 @@ external extract_fastpath_int24_le_signed : string -> int -> int = "ocaml_bitstr 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_be_unsigned : string -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_unsigned" -external extract_fastpath_int32_le_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_unsigned" "noalloc" +external extract_fastpath_int32_le_unsigned : string -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_unsigned" -external extract_fastpath_int32_ne_unsigned : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_unsigned" "noalloc" +external extract_fastpath_int32_ne_unsigned : string -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_unsigned" -external extract_fastpath_int32_be_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_signed" "noalloc" +external extract_fastpath_int32_be_signed : string -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_be_signed" -external extract_fastpath_int32_le_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_signed" "noalloc" +external extract_fastpath_int32_le_signed : string -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_le_signed" -external extract_fastpath_int32_ne_signed : string -> int -> int32 -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_signed" "noalloc" +external extract_fastpath_int32_ne_signed : string -> int -> int32 = "ocaml_bitstring_extract_fastpath_int32_ne_signed" (* -external extract_fastpath_int40_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_unsigned" "noalloc" +external extract_fastpath_int40_be_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_unsigned" -external extract_fastpath_int40_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_unsigned" "noalloc" +external extract_fastpath_int40_le_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_unsigned" -external extract_fastpath_int40_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_unsigned" "noalloc" +external extract_fastpath_int40_ne_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_unsigned" -external extract_fastpath_int40_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_signed" "noalloc" +external extract_fastpath_int40_be_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_be_signed" -external extract_fastpath_int40_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_signed" "noalloc" +external extract_fastpath_int40_le_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_le_signed" -external extract_fastpath_int40_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_signed" "noalloc" +external extract_fastpath_int40_ne_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int40_ne_signed" -external extract_fastpath_int48_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_unsigned" "noalloc" +external extract_fastpath_int48_be_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_unsigned" -external extract_fastpath_int48_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_unsigned" "noalloc" +external extract_fastpath_int48_le_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_unsigned" -external extract_fastpath_int48_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_unsigned" "noalloc" +external extract_fastpath_int48_ne_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_unsigned" -external extract_fastpath_int48_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_signed" "noalloc" +external extract_fastpath_int48_be_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_be_signed" -external extract_fastpath_int48_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_signed" "noalloc" +external extract_fastpath_int48_le_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_le_signed" -external extract_fastpath_int48_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_signed" "noalloc" +external extract_fastpath_int48_ne_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int48_ne_signed" -external extract_fastpath_int56_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_unsigned" "noalloc" +external extract_fastpath_int56_be_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_unsigned" -external extract_fastpath_int56_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_unsigned" "noalloc" +external extract_fastpath_int56_le_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_unsigned" -external extract_fastpath_int56_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_unsigned" "noalloc" +external extract_fastpath_int56_ne_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_unsigned" -external extract_fastpath_int56_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_signed" "noalloc" +external extract_fastpath_int56_be_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_be_signed" -external extract_fastpath_int56_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_signed" "noalloc" +external extract_fastpath_int56_le_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_le_signed" -external extract_fastpath_int56_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_signed" "noalloc" +external extract_fastpath_int56_ne_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int56_ne_signed" *) -external extract_fastpath_int64_be_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_unsigned" "noalloc" +external extract_fastpath_int64_be_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_unsigned" -external extract_fastpath_int64_le_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_unsigned" "noalloc" +external extract_fastpath_int64_le_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_unsigned" -external extract_fastpath_int64_ne_unsigned : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_unsigned" "noalloc" +external extract_fastpath_int64_ne_unsigned : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_unsigned" -external extract_fastpath_int64_be_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_signed" "noalloc" +external extract_fastpath_int64_be_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_be_signed" -external extract_fastpath_int64_le_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_signed" "noalloc" +external extract_fastpath_int64_le_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_le_signed" -external extract_fastpath_int64_ne_signed : string -> int -> int64 -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_signed" "noalloc" +external extract_fastpath_int64_ne_signed : string -> int -> int64 = "ocaml_bitstring_extract_fastpath_int64_ne_signed" (*----------------------------------------------------------------------*) (* Constructor functions. *) @@ -896,30 +935,53 @@ let construct_char_unsigned buf v flen exn = 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