add bits stream

diff --git a/swflib/OMakefile b/swflib/OMakefile
index 3315f7e..c139087 100644 (file)
--- 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 (file)
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 (file)
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 (file)
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 (file)
--- 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