From 15c54237774f6e6c9e295a2e8320dfe0e82ec2bf Mon Sep 17 00:00:00 2001 From: mzp Date: Fri, 18 Sep 2009 08:12:52 +0900 Subject: [PATCH] add disasm --- swflib/OMakefile | 4 ++- swflib/bytesIn.ml | 79 +++++++++++++++++++++++++++++++++++++++++++++++++++ swflib/bytesIn.mli | 7 +++++ swflib/bytesInTest.ml | 47 ++++++++++++++++++++++++++++++ swflib/gen_inst.ml | 15 ++++++++++ swflib/gen_typemap.ml | 16 +++++++---- swflib/lowInst.mlp | 11 +++++++ swflib/lowInstTest.ml | 3 +- 8 files changed, 175 insertions(+), 7 deletions(-) create mode 100644 swflib/bytesIn.ml create mode 100644 swflib/bytesIn.mli create mode 100644 swflib/bytesInTest.ml diff --git a/swflib/OMakefile b/swflib/OMakefile index 1eda172..979af9e 100644 --- a/swflib/OMakefile +++ b/swflib/OMakefile @@ -7,6 +7,7 @@ OCAMLPACKS[] = FILES[] = bytesOut + bytesIn label abcType abcOut @@ -35,7 +36,8 @@ OCamlProgram(gen_typemap,gen_typemap) # test OUnitTest(label , label) OUnitTest(bytesOut , bytesOut label) -OUnitTest(lowInst , lowInst bytesOut) +OUnitTest(bytesIn , bytesIn) +OUnitTest(lowInst , lowInst bytesOut bytesIn label) OUnitTest(highInst , highInst label cpool revList) OUnitTest(abcOut , abcOut label bytesOut) OUnitTest(methodOut, methodOut cpool bytesOut label revList) diff --git a/swflib/bytesIn.ml b/swflib/bytesIn.ml new file mode 100644 index 0000000..52661cd --- /dev/null +++ b/swflib/bytesIn.ml @@ -0,0 +1,79 @@ +open Base + +let rec repeat n f stream = + if n <= 0 then + [] + else + match stream with parser + [] -> + 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 + +let u16 = + parser [] -> + n1 ++ n2 + +let size = + Sys.word_size - 24 - 1 + +let s_extend d = + (d lsl size) asr size + +let s24 = + parser [] -> + 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_u30 stream = + match stream with parser + [] -> + Int32.of_int n + | [] -> + (read_u30 stream) +++ (Int32.of_int n) + | [<>] -> + raise (Stream.Error "invalid format") + +let u30 s = + Int32.to_int @@ read_u30 s + +let u32 = + read_u30 + +let s32 = + read_u30 + +let d64 = + let shift_or x y = + Int64.logor (Int64.shift_left y 8) (Int64.of_int x) in + parser + [] -> + Int64.float_of_bits @@ List.fold_right shift_or d 0L + +let sample () = + Stream.of_list @@ range 0 10 diff --git a/swflib/bytesIn.mli b/swflib/bytesIn.mli new file mode 100644 index 0000000..7885a51 --- /dev/null +++ b/swflib/bytesIn.mli @@ -0,0 +1,7 @@ +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 s32: int Stream.t -> int32 +val d64: int Stream.t ->float diff --git a/swflib/bytesInTest.ml b/swflib/bytesInTest.ml new file mode 100644 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 diff --git a/swflib/gen_inst.ml b/swflib/gen_inst.ml index 7914304..a8e1afe 100644 --- a/swflib/gen_inst.ml +++ b/swflib/gen_inst.ml @@ -135,6 +135,21 @@ let cmds = [ sprintf "| %s -> %s" pat record end; + begin "-disasm",fun {name; opcode; args} -> + let pat = + sprintf "[< _ = op %d %s %s >]" + opcode + (if args = [] then "" else ";") @@ + concat_mapi ";" (fun x i -> sprintf "arg%d = read_%s" i x ) args in + let body = + if args <> [] then + sprintf "`%s (%s)" name @@ + concat_mapi "," (fun _ i -> sprintf "arg%d" i) args + else + sprintf "`%s" name in + sprintf "| %s -> %s" pat body + end; + begin "-compile",fun {name;args}-> let pat = make_pat name args in diff --git a/swflib/gen_typemap.ml b/swflib/gen_typemap.ml index 4ecd78e..576db75 100644 --- a/swflib/gen_typemap.ml +++ b/swflib/gen_typemap.ml @@ -31,7 +31,8 @@ let none = let cpool name ~high ~entry = regist name ~low:"int" ~high ~funs:[ - "byte" => "u30"; + "byte" => "BytesOut.u30"; + "read" => "BytesIn.u30"; "const" => sprintf "fun x -> Some ((%s x) :> Cpool.entry)" entry; "arg" => sprintf "fun ctx x -> Cpool.index ctx#cpool (%s x)" entry; "class" => none; @@ -41,7 +42,8 @@ let cpool name ~high ~entry = let literal name = regist name ~low:"int" ~high:"int" ~funs:[ - "byte" => name; + "byte" => sprintf "BytesOut.%s" name; + "read" => sprintf "BytesIn.%s" name; "const" => none; "arg" => "fun _ -> id"; "class" => none; @@ -51,7 +53,8 @@ let literal name = (* type regist *) regist "method_" ~low:"int" ~high:"method_" ~funs:[ - "byte" => "u30"; + "byte" => "BytesOut.u30"; + "read" => "BytesIn.u30"; "const" => none; "method" => "fun x -> Some x"; "class" => none; @@ -60,7 +63,8 @@ regist "method_" ~low:"int" ~high:"method_" regist "class_" ~low:"int" ~high:"class_" ~funs:[ - "byte" => "u30"; + "byte" => "BytesOut.u30"; + "read" => "BytesIn.u30"; "const" => none; "method" => none; "class" => "fun x -> Some x"; @@ -74,6 +78,7 @@ regist "label" ~low:"(Label.t,int) either" ~high:"Label.t" "byte" => "function Left label -> label_ref label | Right address -> s24 address"; + "read" => "fun s -> Right (BytesIn.s24 s)"; "const" => none; "method" => none; "class" => none; @@ -83,6 +88,7 @@ regist "label" ~low:"(Label.t,int) either" ~high:"Label.t" regist "label_def" ~low:"Label.t" ~high:"Label.t" ~funs:[ "byte" => "fun l ->label l"; + "read" => "fun _ -> Label.make()"; "const" => none; "method" => none; "class" => none; @@ -105,7 +111,7 @@ let print_field t fs = let _ = match Sys.argv.(1) with "-low" -> - print_field "low" ["byte"] + print_field "low" ["byte";"read"] | "-high" -> print_field "high" ["const"; "arg"; diff --git a/swflib/lowInst.mlp b/swflib/lowInst.mlp index 80232a1..bf95f0e 100644 --- a/swflib/lowInst.mlp +++ b/swflib/lowInst.mlp @@ -9,3 +9,14 @@ type t = [ let to_bytes : t -> BytesOut.t list = function #include "asm.inst.h" + +let op n stream = + match Stream.peek stream with + Some m when m = n -> + Stream.next stream + | _ -> + raise Stream.Failure + +let of_int_list : int Stream.t -> t = + parser +#include "disasm.inst.h" diff --git a/swflib/lowInstTest.ml b/swflib/lowInstTest.ml index ca20448..51ce9f6 100644 --- a/swflib/lowInstTest.ml +++ b/swflib/lowInstTest.ml @@ -4,7 +4,8 @@ open LowInst open BytesOut let ok x y = - assert_equal x (to_bytes y) + assert_equal x @@ to_bytes y; + assert_equal y @@ of_int_list @@ Stream.of_list @@ BytesOut.to_int_list x let _ = ("lowInst.ml" >::: [ -- 2.11.0