add bytesIn module

diff --git a/swflib/OMakefile b/swflib/OMakefile
index 1eda172..7004d4f 100644 (file)
--- a/swflib/OMakefile
+++ b/swflib/OMakefile
@@ -6,6 +6,7 @@ OCAMLPACKS[] =
        str
 
 FILES[] =
+       bytesIn
        bytesOut
        label
        abcType
@@ -35,6 +36,7 @@ OCamlProgram(gen_typemap,gen_typemap)
 # test
 OUnitTest(label    , label)
 OUnitTest(bytesOut , bytesOut label)
+OUnitTest(bytesIn  , bytesIn)
 OUnitTest(lowInst  , lowInst bytesOut)
 OUnitTest(highInst , highInst label cpool revList)
 OUnitTest(abcOut   , abcOut label bytesOut)

diff --git a/swflib/bytesIn.ml b/swflib/bytesIn.ml
new file mode 100644 (file)
index 0000000..73fbf87
--- /dev/null
+++ b/swflib/bytesIn.ml
@@ -0,0 +1,78 @@
+open Base
+
+let rec repeat n f stream =
+  if n <= 0 then
+    []
+  else
+    match stream with parser
+       [<c = f>] ->
+         c::repeat (n-1) f stream
+      | [<>] ->
+         raise (Stream.Error "invalid format")
+
+
+let of_channel ch =
+  Stream.from (fun _ -> try
+                Some (input_byte ch)
+              with End_of_file ->
+                None)
+
+let (++) x y =
+  (x lsl 8) + y
+
+let byte =
+  Stream.next
+
+let u8 =
+  parser [<c = byte>] -> c
+
+let u16 =
+  parser [<n2 = byte; n1 = byte >] ->
+    n1 ++ n2
+
+let size =
+  Sys.word_size - 24 - 1
+
+let s_extend d =
+  (d lsl size) asr size
+
+let s24 =
+  parser [<n3 = byte; n2 = byte; n1 = byte>] ->
+    s_extend (n1 ++ n2 ++ n3)
+
+let leq n stream =
+  match Stream.peek stream with
+      Some m when m <= n ->
+       Stream.next stream
+    | _ ->
+       raise Stream.Failure
+
+let (+++) x y =
+  Int32.logor (Int32.shift_left x 7) (Int32.logand y 0x7Fl)
+
+let rec read_u32 stream =
+  match stream with parser
+      [<n = leq 0x7F >] ->
+       Int32.of_int n
+    | [<n = byte>] ->
+       (read_u32 stream) +++ (Int32.of_int n)
+    | [<>] ->
+       raise (Stream.Error "invalid format")
+
+let u30 =
+  Int32.to_int $ read_u32
+
+let u32 =
+  read_u32
+
+let s32 =
+  read_u32
+
+let d64 =
+  let shift_or x y =
+    Int64.logor (Int64.shift_left y 8) (Int64.of_int x) in
+    parser
+       [<d = repeat 8 byte>] ->
+         Int64.float_of_bits @@ List.fold_right shift_or d 0L
+
+

diff --git a/swflib/bytesIn.mli b/swflib/bytesIn.mli
new file mode 100644 (file)
index 0000000..7d8471f
--- /dev/null
+++ b/swflib/bytesIn.mli
@@ -0,0 +1,6 @@
+val u8  : int Stream.t -> int
+val u16 : int Stream.t -> int
+val s24 : int Stream.t -> int
+val u30 : int Stream.t -> int
+val u32 : int Stream.t -> int32
+val d64 : int Stream.t -> float

diff --git a/swflib/bytesInTest.ml b/swflib/bytesInTest.ml
new file mode 100644 (file)
index 0000000..306b92c
--- /dev/null
+++ b/swflib/bytesInTest.ml
@@ -0,0 +1,47 @@
+open OUnit
+open Base
+open BytesIn
+
+let of_list xs =
+  Stream.of_list xs
+
+let ok x y =
+  OUnit.assert_equal ~printer:Std.dump x y
+
+let tests = ("byte.ml" >::: [
+  "u8 is single byte" >::
+    (fun _ ->
+       ok 0 (u8 @@ of_list [0]));
+  "u16 is little endian" >::
+    (fun _ ->
+       ok 0x0100 (u16 @@ of_list [0;1] ));
+  "s24" >::
+    (fun _ ->
+       ok 0x000001 (s24 @@ of_list [1;0;0] );
+       ok ~-1 (s24 @@ of_list [0xFF;0xFF;0xFF] ));
+  "u30 is single byte when value < 0x7F" >::
+    (fun _ ->
+       ok 0    (u30 @@ of_list [0]);
+       ok 0x7F (u30 @@ of_list [0x7F]));
+  "u30 is 2 bytes when value <= 0x7F 0xFF"  >::
+    (fun _ ->
+       ok 0xFF    (u30 @@ of_list [0xFF;0x01]);
+       ok 0x3F_FF (u30 @@ of_list [0xFF;0x7F]));
+  "u30 is 3 bytes when value <= 0x7F 0xFF 0xFF" >::
+    (fun _ ->
+       ok 0x7FFF    (u30 @@ of_list [0xFF;0xFF;0x01]);
+       ok 0x1F_FFFF (u30 @@ of_list [0xFF;0xFF;0x7F]));
+  "u30 is 4 bytes when value <= 0x7F 0xFF 0xFF 0xFF" >::
+    (fun _ ->
+       ok 0x003F_FFFF (u30 @@ of_list [0xFF;0xFF;0xFF;0x01]);
+       ok 0x0FFF_FFFF (u30 @@ of_list [0xFF;0xFF;0xFF;0x7F]));
+  "u30 is 5 bytes when value <= 0x7F 0xFF 0xFF 0xFF 0xFF" >::
+    (fun _ ->
+       ok 0x1FFF_FFFF (u30 @@ of_list [0xFF;0xFF;0xFF;0xFF;0x01]));
+  "u32" >::
+    (fun _ ->
+       ok 0xFFFF_FFFFl (u32 @@ of_list [0xFF;0xFF;0xFF;0xFF;0xF]));
+  "d64 is float(IEEE 754 format)" >::
+    (fun _ ->
+       ok 0.75 (d64 @@ of_list [0;0;0;0;0;0;0xe8;0x3f]))
+]) +> run_test_tt_main