From a710d815d53c44bc3589b3ba87dbe13683030891 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rich@annexia.org>
Date: Tue, 1 Apr 2008 10:06:12 +0000
Subject: [PATCH] Added Bitmatch.hexdump_bitstring

---
 bitmatch.ml         | 46 +++++++++++++++++++++++++++++++++++++++++++++-
 bitmatch.mli        |  4 +++-
 tests/.cvsignore    |  2 ++
 tests/03_hexdump.ml | 18 ++++++++++++++++++
 4 files changed, 68 insertions(+), 2 deletions(-)
 create mode 100644 tests/03_hexdump.ml

diff --git a/bitmatch.ml b/bitmatch.ml
index cde163c..975e42e 100644
--- a/bitmatch.ml
+++ b/bitmatch.ml
@@ -1,5 +1,5 @@
 (* Bitmatch library.
- * $Id: bitmatch.ml,v 1.2 2008-04-01 08:56:43 rjones Exp $
+ * $Id: bitmatch.ml,v 1.3 2008-04-01 10:06:12 rjones Exp $
  *)
 
 open Printf
@@ -78,3 +78,47 @@ let extract_char_unsigned data off len flen =
   let word = word lsr shift in
 
   word, off+flen, len-flen
+
+(*----------------------------------------------------------------------*)
+(* Display functions. *)
+
+let isprint c =
+  let c = Char.code c in
+  c >= 32 && c < 127
+
+let hexdump_bitstring chan (data, off, len) =
+  let count = ref 0 in
+  let off = ref off in
+  let len = ref len in
+  let linelen = ref 0 in
+  let linechars = String.make 16 ' ' in
+
+  fprintf chan "00000000  ";
+
+  while !len > 0 do
+    let bits = min !len 8 in
+    let byte, off', len' = extract_char_unsigned data !off !len bits in
+    off := off'; len := len';
+
+    let byte = byte lsl (8-bits) in
+    fprintf chan "%02x " byte;
+
+    incr count;
+    linechars.[!linelen] <-
+      (let c = Char.chr byte in
+       if isprint c then c else '.');
+    incr linelen;
+    if !linelen = 8 then fprintf chan " ";
+    if !linelen = 16 then (
+      fprintf chan " |%s|\n%08x  " linechars !count;
+      linelen := 0;
+      for i = 0 to 15 do linechars.[i] <- ' ' done
+    )
+  done;
+
+  if !linelen > 0 then (
+    let skip = (16 - !linelen) * 3 + if !linelen < 8 then 1 else 0 in
+    for i = 0 to skip-1 do fprintf chan " " done;
+    fprintf chan " |%s|\n" linechars
+  ) else
+    fprintf chan "\n"
diff --git a/bitmatch.mli b/bitmatch.mli
index 05fe22a..7c45aa2 100644
--- a/bitmatch.mli
+++ b/bitmatch.mli
@@ -1,5 +1,5 @@
 (* Bitmatch library.
- * $Id: bitmatch.mli,v 1.2 2008-04-01 08:56:43 rjones Exp $
+ * $Id: bitmatch.mli,v 1.3 2008-04-01 10:06:12 rjones Exp $
  *)
 
 type bitstring = string * int * int
@@ -14,6 +14,8 @@ val bitstring_of_chan : in_channel -> bitstring
 
 val bitstring_of_file : string -> bitstring
 
+val hexdump_bitstring : out_channel -> bitstring -> unit
+
 (**/**)
 
 val extract_bitstring : string -> int -> int -> int -> bitstring * int * int
diff --git a/tests/.cvsignore b/tests/.cvsignore
index 670366b..0f4722c 100644
--- a/tests/.cvsignore
+++ b/tests/.cvsignore
@@ -4,7 +4,9 @@
 *.cma
 *.cmxa
 01_load
+03_hexdump
 05_bits
 06_ints1
 06_ints2
 06_ints3
+60_ping
diff --git a/tests/03_hexdump.ml b/tests/03_hexdump.ml
new file mode 100644
index 0000000..793f92a
--- /dev/null
+++ b/tests/03_hexdump.ml
@@ -0,0 +1,18 @@
+(* Test the hexdump function.
+ * $Id: 03_hexdump.ml,v 1.1 2008-04-01 10:06:12 rjones Exp $
+ *)
+
+open Printf
+
+let bits = Bitmatch.make_bitstring (32*8) '\x5a'
+
+let () =
+  Bitmatch.hexdump_bitstring stdout bits;
+
+  let data, off, len = bits in
+  let bits = data, off+1, len-1 in
+  Bitmatch.hexdump_bitstring stdout bits;
+
+  let data, off, len = bits in
+  let bits = data, off+1, len-1 in
+  Bitmatch.hexdump_bitstring stdout bits
-- 
1.8.3.1