From 1e0f5625f3618d119c0095236158a16204c94506 Mon Sep 17 00:00:00 2001
From: mzp <mzpppp@gmail.com>
Date: Sun, 4 Oct 2009 09:36:20 +0900
Subject: [PATCH] add bits stream

---
 swflib/OMakefile         |  1 +
 swflib/bitsStream.ml     | 51 ++++++++++++++++++++++++++++++++++++++++++++++++
 swflib/bitsStream.mli    |  5 +++++
 swflib/bitsStreamTest.ml | 40 +++++++++++++++++++++++++++++++++++++
 swflib/swfBaseOutTest.ml |  2 +-
 5 files changed, 98 insertions(+), 1 deletion(-)
 create mode 100644 swflib/bitsStream.ml
 create mode 100644 swflib/bitsStream.mli
 create mode 100644 swflib/bitsStreamTest.ml

diff --git a/swflib/OMakefile b/swflib/OMakefile
index 3315f7e..c139087 100644
--- a/swflib/OMakefile
+++ b/swflib/OMakefile
@@ -47,6 +47,7 @@ OUnitTest(revList  , revList)
 OUnitTest(cpool    , cpool revList)
 
 OUnitTest(swfBaseOut, swfBaseOut)
+OUnitTest(bitsStream, bitsStream)
 
 # phony
 .PHONY: clean
diff --git a/swflib/bitsStream.ml b/swflib/bitsStream.ml
new file mode 100644
index 0000000..0695b98
--- /dev/null
+++ b/swflib/bitsStream.ml
@@ -0,0 +1,51 @@
+open Base
+
+type t = {
+  pos     : int;
+  content : int list;
+  value   : int
+}
+
+let cByte = 8
+
+let empty = {
+  pos     = 0;
+  content = [];
+  value   = 0;
+}
+
+let rec update t =
+  if t.pos < cByte then
+    t
+  else
+    update {
+      pos     = t.pos - cByte;
+      value   = 0;
+      content = t.value :: t.content
+    }
+
+let max_int n =
+  (1 lsl n) - 1
+
+let rec put t ~width ~bits =
+  if bits > max_int width then raise (Invalid_argument "BitsStream.put");
+  let remain =
+    cByte - t.pos in
+    if remain >= width then
+      update {t with
+		value = t.value lor (bits lsl (remain - width));
+		pos   = t.pos + width}
+    else
+      let low =
+	(bits lsr (width - remain)) land max_int remain in
+      let high =
+	bits land max_int (width-remain) in
+      let t1 =
+	put t  ~width:remain ~bits:low in
+	put t1 ~width:(width - remain) ~bits:high
+
+let to_list {pos; value; content} =
+  if pos = 0 then
+    List.rev content
+  else
+    List.rev @@ value::content
diff --git a/swflib/bitsStream.mli b/swflib/bitsStream.mli
new file mode 100644
index 0000000..c5a16e7
--- /dev/null
+++ b/swflib/bitsStream.mli
@@ -0,0 +1,5 @@
+type t
+
+val empty : t
+val put: t -> width:int -> bits:int -> t
+val to_list: t -> int list
diff --git a/swflib/bitsStreamTest.ml b/swflib/bitsStreamTest.ml
new file mode 100644
index 0000000..af1eab8
--- /dev/null
+++ b/swflib/bitsStreamTest.ml
@@ -0,0 +1,40 @@
+open Base
+open OUnit
+open BitsStream
+
+let ok x y =
+  assert_equal ~printer:Std.dump x @@ to_list y
+
+let _ = begin "bitsStream.ml" >::: [
+  "empty" >:: begin fun () ->
+    ok [] @@ empty
+  end;
+  "put" >:: begin fun () ->
+    let t1 =
+      put empty ~width:1 ~bits:1 in
+    let t2 =
+      put t1 ~width:3 ~bits:1 in
+      ok [0b1001_0000] t2
+  end;
+  "put & put" >:: begin fun () ->
+    let t1 =
+      put empty ~width:5 ~bits:1 in
+    let t2 =
+      put t1 ~width:5 ~bits:1 in
+      ok [0b0000_1000] t1;
+      ok [0b0000_1000; 0b0100_0000] t2;
+  end;
+  "padding" >:: begin fun () ->
+    ok [0b1000_0000] @@ put empty ~width:1 ~bits:1
+  end;
+  "put 2 bytes" >:: begin fun () ->
+    ok [0xFF; 0b1000_0000] @@ put empty ~width:9 ~bits:0x1FF;
+  end;
+  "invalid arguments" >:: begin fun () ->
+    try
+      ignore @@ put empty ~width:2 ~bits:0b100;
+      assert_failure "not raise"
+    with Invalid_argument _ ->
+      ()
+  end;
+] end +> run_test_tt_main
diff --git a/swflib/swfBaseOutTest.ml b/swflib/swfBaseOutTest.ml
index 87b5aed..988155f 100644
--- a/swflib/swfBaseOutTest.ml
+++ b/swflib/swfBaseOutTest.ml
@@ -95,4 +95,4 @@ let _ = begin "swfBaseOut.ml" >::: [
       ok_i [0xFF;0xFF;0xFF;0xFF;0x03] @@ EUi32 0x3FFF_FFFFl
     end
   ];
-]end +> run_test_tt_main
+] end +> run_test_tt_main
-- 
2.11.0