X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=bitstring.ml;h=bc29a419cf06c6fa0e86e87287eb196f70fa76a5;hb=ddf96ad11dab238189dbc130544aa0bac5ed9c2a;hp=c860c08d671048ff674e970b56451ba79d9e56bf;hpb=b67caaf64efdc6c96ca4431b6844f294c6c38a7c;p=ocaml-bitstring.git

diff --git a/bitstring.ml b/bitstring.ml
index c860c08..bc29a41 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
@@ -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