From 65d01f251b91df36445216d1a44d8f2d6cc4fd8d Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rich@annexia.org>
Date: Tue, 1 Apr 2008 08:56:43 +0000
Subject: [PATCH] extract_char_unsigned

---
 Makefile          |  8 +++++---
 bitmatch.ml       | 40 ++++++++++++++++++++++++++++++++++++----
 bitmatch.mli      |  4 +++-
 pa_bitmatch.ml    | 13 ++++++++++---
 tests/.cvsignore  |  3 +++
 tests/05_bits.ml  | 15 ++++++++-------
 tests/06_ints1.ml | 20 ++++++++++++++++++++
 tests/06_ints2.ml | 24 ++++++++++++++++++++++++
 tests/06_ints3.ml | 22 ++++++++++++++++++++++
 9 files changed, 131 insertions(+), 18 deletions(-)
 create mode 100644 tests/06_ints1.ml
 create mode 100644 tests/06_ints2.ml
 create mode 100644 tests/06_ints3.ml

diff --git a/Makefile b/Makefile
index 348e320..b6697eb 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-# $Id: Makefile,v 1.1 2008-03-31 22:52:17 rjones Exp $
+# $Id: Makefile,v 1.2 2008-04-01 08:56:43 rjones Exp $
 
 OCAMLFIND = ocamlfind
 OCAMLMKLIB = ocamlmklib
@@ -24,12 +24,14 @@ bitmatch.cma: bitmatch.cmo
 bitmatch.cmxa: bitmatch.cmx
 	$(OCAMLFIND) ocamlopt -a -o $@ $^
 
-test:
+test: pa_bitmatch.cmo bitmatch.cma
 	@for f in $(TESTS); do \
 	  echo Test: $$f; \
-	  $(OCAMLFIND) ocamlc -pp "camlp4o pa_bitmatch.cmo" \
+	  $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -pp "camlp4o pa_bitmatch.cmo" \
 	    -I . bitmatch.cma $$f.ml -o $$f; \
+	  if [ $$? -ne 0 ]; then exit 1; fi; \
 	  $$f; \
+	  if [ $$? -ne 0 ]; then exit 1; fi; \
 	done
 
 print-tests: pa_bitmatch.cmo
diff --git a/bitmatch.ml b/bitmatch.ml
index 3135c89..cde163c 100644
--- a/bitmatch.ml
+++ b/bitmatch.ml
@@ -1,7 +1,9 @@
 (* Bitmatch library.
- * $Id: bitmatch.ml,v 1.1 2008-03-31 22:52:17 rjones Exp $
+ * $Id: bitmatch.ml,v 1.2 2008-04-01 08:56:43 rjones Exp $
  *)
 
+open Printf
+
 (* A bitstring is simply the data itself (as a string), and the
  * bitoffset and the bitlength within the string.  Note offset/length
  * are counted in bits, not bytes.
@@ -31,18 +33,48 @@ let bitstring_of_file fname =
   close_in chan;
   bs
 
-(* Extraction functions (internal: called from the generated macros,
- * and the parameters should have been checked for sanity already).
+(*----------------------------------------------------------------------*)
+(* Extraction functions.
+ *
+ * NB: internal functions, called from the generated macros, and
+ * the parameters should have been checked for sanity already).
  *)
+
+(* Bitstrings. *)
 let extract_bitstring data off len flen =
   (data, off, flen), off+flen, len-flen
 
 let extract_remainder data off len =
   (data, off, len), off+len, 0
 
-(* Extract and convert to numeric. *)
+(* Extract and convert to numeric.  A single bit is returned as
+ * a boolean.  There are no endianness or signedness considerations.
+ *)
 let extract_bit data off len _ =	(* final param is always 1 *)
   let byteoff = off lsr 3 in
   let bitmask = 1 lsl (7 - (off land 7)) in
   let b = Char.code data.[byteoff] land bitmask <> 0 in
   b, off+1, len-1
+
+(* Extract [2..8] bits.  Because the result fits into a single
+ * byte we don't have to worry about endianness, only signedness.
+ *)
+let extract_char_unsigned data off len flen =
+  let byteoff = off lsr 3 in
+
+  (* Extract the 16 bits at byteoff and byteoff+1 (note that the
+   * second byte might not exist in the original string).
+   *)
+  let word =
+    (Char.code data.[byteoff] lsl 8) +
+      (if String.length data > byteoff+1 then Char.code data.[byteoff+1]
+       else 0) in
+
+  (* Mask off the top bits. *)
+  let bitmask = (1 lsl (16 - (off land 7))) - 1 in
+  let word = word land bitmask in
+  (* Shift right to get rid of the bottom bits. *)
+  let shift = 16 - ((off land 7) + flen) in
+  let word = word lsr shift in
+
+  word, off+flen, len-flen
diff --git a/bitmatch.mli b/bitmatch.mli
index 7760d5a..05fe22a 100644
--- a/bitmatch.mli
+++ b/bitmatch.mli
@@ -1,5 +1,5 @@
 (* Bitmatch library.
- * $Id: bitmatch.mli,v 1.1 2008-03-31 22:52:17 rjones Exp $
+ * $Id: bitmatch.mli,v 1.2 2008-04-01 08:56:43 rjones Exp $
  *)
 
 type bitstring = string * int * int
@@ -21,3 +21,5 @@ val extract_bitstring : string -> int -> int -> int -> bitstring * int * int
 val extract_remainder : string -> int -> int -> bitstring * int * int
 
 val extract_bit : string -> int -> int -> int -> bool * int * int
+
+val extract_char_unsigned : string -> int -> int -> int -> int * int * int
diff --git a/pa_bitmatch.ml b/pa_bitmatch.ml
index 2c5a6de..95b80a5 100644
--- a/pa_bitmatch.ml
+++ b/pa_bitmatch.ml
@@ -1,5 +1,5 @@
 (* Bitmatch syntax extension.
- * $Id: pa_bitmatch.ml,v 1.1 2008-03-31 22:52:17 rjones Exp $
+ * $Id: pa_bitmatch.ml,v 1.2 2008-04-01 08:56:43 rjones Exp $
  *)
 
 open Printf
@@ -140,9 +140,16 @@ let output_bitmatch _loc bs cases =
 	  | _ -> None in
 
 	let name_of_int_extract_const = function
+	    (* XXX As an enhancement we should allow a 64-bit-only
+	     * mode which lets us use 'int' up to 63 bits and won't
+	     * compile on 32-bit platforms.
+	     *)
+	    (* XXX The meaning of signed/unsigned breaks down at
+	     * 31, 32, 63 and 64 bits.
+	     *)
 	  | (1, _, _) -> "extract_bit"
-	  | ((2|3|4|5|6|7), _, false) -> "extract_char_unsigned"
-	  | ((2|3|4|5|6|7), _, true) -> "extract_char_signed"
+	  | ((2|3|4|5|6|7|8), _, false) -> "extract_char_unsigned"
+	  | ((2|3|4|5|6|7|8), _, true) -> "extract_char_signed"
 	  | (i, BigEndian, false) when i <= 31 -> "extract_int_be_unsigned"
 	  | (i, BigEndian, true) when i <= 31 -> "extract_int_be_signed"
 	  | (i, LittleEndian, false) when i <= 31 -> "extract_int_le_unsigned"
diff --git a/tests/.cvsignore b/tests/.cvsignore
index af0d569..670366b 100644
--- a/tests/.cvsignore
+++ b/tests/.cvsignore
@@ -5,3 +5,6 @@
 *.cmxa
 01_load
 05_bits
+06_ints1
+06_ints2
+06_ints3
diff --git a/tests/05_bits.ml b/tests/05_bits.ml
index df59527..7f78b46 100644
--- a/tests/05_bits.ml
+++ b/tests/05_bits.ml
@@ -1,9 +1,7 @@
 (* Extract bits.
- * $Id: 05_bits.ml,v 1.1 2008-03-31 22:52:17 rjones Exp $
+ * $Id: 05_bits.ml,v 1.2 2008-04-01 08:56:43 rjones Exp $
  *)
 
-open Printf
-
 let bits = Bitmatch.make_bitstring 24 '\x5a' (* makes the string 0x5a5a5a *)
 
 let () =
@@ -12,11 +10,14 @@ let () =
     b8  : 1; b9  : 1; b10 : 1; b11 : 1; b12 : 1; b13 : 1; b14 : 1; b15 : 1;
     b16 : 1; b17 : 1; b18 : 1; b19 : 1; b20 : 1; b21 : 1; b22 : 1; b23 : 1;
     rest : -1 : bitstring ->
-      assert (not b0 && b1 && not b2 && b3 && b4 && not b5 && b6 && not b7);
-      assert (not b8 && b9 && not b10 && b11 && b12 && not b13 && b14 && not b15);
-      assert (not b16 && b17 && not b18 && b19 && b20 && not b21 && b22 && not b23);
+      assert (not b0 && b1 && not b2 && b3 && (* 0x5 *)
+		b4 && not b5 && b6 && not b7); (* 0xA *)
+      assert (not b8 && b9 && not b10 && b11 && (* 0x5 *)
+		b12 && not b13 && b14 && not b15); (* 0xA *)
+      assert (not b16 && b17 && not b18 && b19 && (* 0x5 *)
+		b20 && not b21 && b22 && not b23); (* 0xA *)
       let _, off, len = rest in
-      assert (off = 24 && len = 0)
+      assert (off = 24 && len = 0) (* no further data *)
 
   | _ ->
       failwith "error: did not match\n"
diff --git a/tests/06_ints1.ml b/tests/06_ints1.ml
new file mode 100644
index 0000000..5a49bff
--- /dev/null
+++ b/tests/06_ints1.ml
@@ -0,0 +1,20 @@
+(* Extract some simple integers.
+ * $Id: 06_ints1.ml,v 1.1 2008-04-01 08:56:43 rjones Exp $
+ *)
+
+let bits = Bitmatch.make_bitstring 16 '\xcf' (* makes the string 0xcfcf *)
+
+let () =
+  bitmatch bits with
+  | n0 : 4; n1 : 4; n2 : 4; n3 : 4;
+    rest : -1 : bitstring ->
+      assert (n0 = 0xc);
+      assert (n1 = 0xf);
+      assert (n2 = 0xc);
+      assert (n3 = 0xf);
+
+      let _, off, len = rest in
+      assert (off = 16 && len = 0) (* no further data *)
+
+  | _ ->
+      failwith "error: did not match\n"
diff --git a/tests/06_ints2.ml b/tests/06_ints2.ml
new file mode 100644
index 0000000..c0bd76e
--- /dev/null
+++ b/tests/06_ints2.ml
@@ -0,0 +1,24 @@
+(* Extract some simple integers.
+ * $Id: 06_ints2.ml,v 1.1 2008-04-01 08:56:43 rjones Exp $
+ *)
+
+let bits = Bitmatch.make_bitstring 16 '\xcf' (* makes the string 0xcfcf *)
+
+let () =
+  bitmatch bits with
+  | n0 : 2; n1 : 2; n2 : 2; n3 : 2; n4 : 2; n5 : 2; n6 : 2; n7 : 2;
+    rest : -1 : bitstring ->
+      assert (n0 = 0x3); (* 0xc *)
+      assert (n1 = 0x0);
+      assert (n2 = 0x3); (* 0xf *)
+      assert (n3 = 0x3);
+      assert (n4 = 0x3); (* 0xc *)
+      assert (n5 = 0x0);
+      assert (n6 = 0x3); (* 0xf *)
+      assert (n7 = 0x3);
+
+      let _, off, len = rest in
+      assert (off = 16 && len = 0) (* no further data *)
+
+  | _ ->
+      failwith "error: did not match\n"
diff --git a/tests/06_ints3.ml b/tests/06_ints3.ml
new file mode 100644
index 0000000..dc5b687
--- /dev/null
+++ b/tests/06_ints3.ml
@@ -0,0 +1,22 @@
+(* Extract some simple integers.
+ * $Id: 06_ints3.ml,v 1.1 2008-04-01 08:56:43 rjones Exp $
+ *)
+
+let bits = Bitmatch.make_bitstring 16 '\xcf' (* makes the string 0xcfcf *)
+
+let () =
+  bitmatch bits with
+  | n0 : 3; n1 : 3; n2 : 3; n3 : 3; n4 : 3; n5 : 1;
+    rest : -1 : bitstring ->
+      assert (n0 = 0b110);
+      assert (n1 = 0b011);
+      assert (n2 = 0b111);
+      assert (n3 = 0b100);
+      assert (n4 = 0b111);
+      assert (n5);
+
+      let _, off, len = rest in
+      assert (off = 16 && len = 0) (* no further data *)
+
+  | _ ->
+      failwith "error: did not match\n"
-- 
1.8.3.1