From 99ea1a6179afcf79aed36aecdc13fe647918aa37 Mon Sep 17 00:00:00 2001 From: mzp Date: Tue, 29 Sep 2009 08:53:15 +0900 Subject: [PATCH] update cpool/method_info/metadata --- swflib/OMakefile | 2 +- swflib/abcIn.ml | 122 ++++++++++++++++++++++++++++------------------------ swflib/abcIn.mli | 4 +- swflib/abcInTest.ml | 98 ++++++++++++++++++++++++----------------- swflib/abcType.ml | 44 ++++++++++++++++--- 5 files changed, 165 insertions(+), 105 deletions(-) diff --git a/swflib/OMakefile b/swflib/OMakefile index 3275136..e831fff 100644 --- a/swflib/OMakefile +++ b/swflib/OMakefile @@ -39,7 +39,7 @@ OCamlProgram(gen_typemap,gen_typemap) OUnitTest(label , label) OUnitTest(bytesOut , bytesOut label) OUnitTest(bytesIn , bytesIn) -OUnitTest(abcIn , abcIn bytesIn) +OUnitTest(abcIn , abcIn bytesIn bytesOut) OUnitTest(lowInst , lowInst bytesOut bytesIn label) OUnitTest(highInst , highInst label cpool revList) OUnitTest(abcOut , abcOut label bytesOut) diff --git a/swflib/abcIn.ml b/swflib/abcIn.ml index a0dec3e..45b3d65 100644 --- a/swflib/abcIn.ml +++ b/swflib/abcIn.ml @@ -49,26 +49,24 @@ module Make(Inst : Inst) = struct u8 stream in let name = u30 stream in - {kind=kind; namespace_name=name} -(* TDOO *) -(* match kind with + match kind with 0x08 -> - `Namespace name + Namespace name | 0x16 -> - `PackageNamespace name + PackageNamespace name | 0x17 -> - `PackageInternaNs name + PackageInternalNamespace name | 0x18 -> - `ProtectedNamespace name + ProtectedNamespace name | 0x19 -> - `ExplicitNamespace name + ExplicitNamespace name | 0x1A -> - `StaticProtectedNs name + StaticProtectedNamespace name | 0x05 -> - `PrivateNs name + PrivateNamespace name | _ -> failwith "must not happen" -*) + let ns_set_info stream = array u30 stream @@ -82,39 +80,38 @@ module Make(Inst : Inst) = struct let name= u30 stream in QName (ns,name) - | 0x09 -> - let name = + | 0x0D -> + let ns = u30 stream in - let ns_set = + let name= u30 stream in - Multiname (name,ns_set) - | _ -> - failwith "invalid format" -(* TODO *) -(* match kind with - 0x07 -> - `QName { ns=u30 stream; name=u30 stream } - | 0x0D -> - `QNameA { ns=u30 stream; name=u30 stream } + QNameA (ns,name) | 0x0F -> - `RTQName { name=u30 stream } + RTQName (u30 stream) | 0x10 -> - `RTQNameA { name=u30 stream } + RTQNameA (u30 stream) | 0x11 -> - `RTQNameL + RTQNameL | 0x12 -> - `RTQNameLA + RTQNameLA | 0x09 -> - `Multiname {name=u30 stream; ns_set=u30 stream} + let name= + u30 stream in + let ns_set= + u30 stream in + Multiname (name,ns_set) | 0x0E -> - `MultinameA {name=u30 stream; ns_set=u30 stream} + let name= + u30 stream in + let ns_set= + u30 stream in + MultinameA (name,ns_set) | 0x1B -> - `MultinameL {ns_set=u30 stream} + MultinameL (u30 stream) | 0x1C -> - `MultinameLA {ns_set=u30 stream} + MultinameLA (u30 stream) | _ -> failwith "invalid format" -*) let to_cpool stream = let int = @@ -141,23 +138,23 @@ module Make(Inst : Inst) = struct u30 stream in match u8 stream with 0x03 -> - `Int value + IntVal value | 0x04 -> - `UInt value + UIntVal value | 0x06 -> - `Double value + DoubleVal value | 0x01 -> - `String value + StringVal value | 0x0B -> - `Bool true + BoolVal true | 0x0A -> - `Bool false + BoolVal false | 0x0C -> - `Null + NullVal | 0x00 -> - `Undefined + UndefinedVal | 0x08 | 0x16 | 0x17 | 0x18 | 0x19 | 0x1A | 0x05 -> - `Namespace value + NamespaceVal value | _ -> failwith "invalid format" @@ -167,6 +164,9 @@ module Make(Inst : Inst) = struct let has x y = x land y = y + let ifhas x y v = + if has x y then [v] else [] + let to_method_info stream = let param_count = u30 stream in @@ -178,22 +178,29 @@ module Make(Inst : Inst) = struct u30 stream in let flags = u8 stream in -(* let options = + let options = if has flags 0x08 then - Some (option_info stream ) + [HasOptional (option_info stream)] else - None in + [] in let param_names = if has flags 0x80 then - Some (repeat param_count u30 stream) + [HasParamNames (repeat param_count u30 stream)] else - None in*) - { params = param_types; - return = return_type; - method_name = name; - method_flags = flags + [] in + { + params = param_types; + return = return_type; + method_name = name; + method_flags = List.concat [ + ifhas flags 0x01 NeedArguments; + ifhas flags 0x02 NeedActivation; + ifhas flags 0x04 NeedRest; + ifhas flags 0x40 SetDxns; + options; param_names; + ] (* need_arguments = has flags 0x01; - need_activation = has flags 0x02; + need_activation = need_rest = has flags 0x04; set_dxns = has flags 0x40; options = options; @@ -206,11 +213,12 @@ module Make(Inst : Inst) = struct let value=u30 stream in (key,value) - let metadata_info stream = - { - metadata_name = u30 stream; - items = array item_info stream - } + let to_metadata stream = + let metadata_name = + u30 stream in + let items = + array item_info stream in + { metadata_name; items} (* 4.8 Traits *) let to_trait stream = @@ -368,7 +376,7 @@ module Make(Inst : Inst) = struct let method_info = array to_method_info stream in let metadata = - array metadata_info stream in + array to_metadata stream in let class_count = u30 stream in let instances = diff --git a/swflib/abcIn.mli b/swflib/abcIn.mli index df54f30..fcb1366 100644 --- a/swflib/abcIn.mli +++ b/swflib/abcIn.mli @@ -13,10 +13,12 @@ module Make : functor (S : Inst) -> sig (**{6 Debug only}*) val to_cpool : BytesIn.t Stream.t -> cpool + val to_method_info : BytesIn.t Stream.t -> method_info + val to_metadata : BytesIn.t Stream.t -> metadata val to_trait : BytesIn.t Stream.t -> trait val to_script : BytesIn.t Stream.t -> script - val to_method_info : BytesIn.t Stream.t -> method_info + val to_method_body : BytesIn.t Stream.t -> S.t method_body val to_class : BytesIn.t Stream.t -> class_info diff --git a/swflib/abcInTest.ml b/swflib/abcInTest.ml index c429f40..116d500 100644 --- a/swflib/abcInTest.ml +++ b/swflib/abcInTest.ml @@ -1,9 +1,10 @@ open Base open OUnit +open BytesOut open AbcType -let ok x y = - OUnit.assert_equal ~printer:Std.dump x y +let ok ?msg x y = + OUnit.assert_equal ?msg ~printer:Std.dump x y module A = AbcIn.Make(struct type t = int @@ -16,6 +17,9 @@ let example name = open_in_bin @@ Printf.sprintf "%s.abc" name in A.of_bytes @@ BytesIn.of_channel ch +let bytes xs = + Stream.of_list @@ BytesOut.to_int_list xs + let abc = example "hello" @@ -24,44 +28,58 @@ let cpool = let _ = ("asm module test" >::: [ - "cpool" >::: [ - "integer" >:: - (fun () -> ok [] cpool.int); - "uinteger" >:: - (fun () -> ok [] cpool.uint); - "double" >:: - (fun () -> ok [] cpool.double); - "string" >:: - (fun () -> ok [""; "Hello,world!!";"print"] cpool.string); -(* TODO *) -(* "namespace" >:: - (fun () -> - match cpool.namespace with - [ns] -> - ok (`Namespace 1l) ns - | _ -> - assert_failure "list size is over");*) - "namespace set" >:: - (fun () -> - ok [] cpool.namespace_set); - "multiname" >:: - (fun () -> - assert_equal [QName (1,1);QName (1,3)] - cpool.multiname) - ]; - "method signature" >:: - (fun () -> - match abc.method_info with - [m] -> - ok [] m.params; - ok 0 m.return; - ok 1 m.method_name; - ok 0 m.method_flags; - | _ -> - assert_failure "over size"); - "metadata test" >:: - (fun () -> - ok [] abc.metadata); + "cpool" >:: begin fun () -> + let char c = + u8 @@ Char.code c in + let cpool = + A.to_cpool @@ bytes [ + (* int *) + u30 3; s32 1;s32 2; + (* uint *) + u30 2; u32 3; + (* double *) + u30 2; d64 4.2; + (* str *) + u30 2; u30 2; char 'h'; char 'i'; + (* ns *) + u30 3; u8 0x08; u30 1; u8 0x05; u30 1; + (* ns_set *) + u30 2; u30 1; u30 1; + (* mn *) + u30 2; u8 0x07; u30 1; u30 1 + ] in + ok ~msg:"int" [1;2] cpool.int; + ok ~msg:"uint" [3] cpool.uint; + ok ~msg:"double" [4.2] cpool.double; + ok ~msg:"str" ["hi"] cpool.string; + ok ~msg:"ns" [Namespace 1; PrivateNamespace 1] cpool.namespace; + ok ~msg:"ns_set" [[1]] cpool.namespace_set; + ok ~msg:"mn" [QName(1,1)] cpool.multiname; + end; + "method signature" >:: begin fun () -> + let m = + A.to_method_info @@ bytes [ + (* param count *) u30 3; + (* return_type *) u30 1; + (* param types *) u30 1; u30 2; u30 3; + (* name *) u30 4; + (* flags *) u8 0x03; + ] in + ok ~msg:"param" [1;2;3] m.params; + ok ~msg:"return" 1 m.return; + ok ~msg:"name" 4 m.method_name; + ok ~msg:"flags" [NeedArguments; NeedActivation] m.method_flags; + end; + "metadata test" >:: begin fun () -> + let metadata = + A.to_metadata @@ bytes [ + (* name *) u30 0; + (* item_count *) u30 2; + (* items *) u30 1; u30 2; u30 3; u30 4 + ] in + ok ~msg:"name" 0 metadata.metadata_name; + ok ~msg:"items" [(1,2);(3,4)] metadata.items + end; "class and instance size has same size" >:: (fun () -> ok (List.length abc.instances) (List.length abc.classes)); diff --git a/swflib/abcType.ml b/swflib/abcType.ml index be84b20..206829f 100644 --- a/swflib/abcType.ml +++ b/swflib/abcType.ml @@ -1,14 +1,28 @@ open Base -type namespace = { - kind:int; namespace_name:int -} +type namespace = + Namespace of int + | PackageNamespace of int + | PackageInternalNamespace of int + | ProtectedNamespace of int + | ExplicitNamespace of int + | StaticProtectedNamespace of int + | PrivateNamespace of int + type namespace_set = int list type multiname = - QName of int * int - | Multiname of int * int + QName of int * int + | QNameA of int * int + | RTQName of int + | RTQNameA of int + | RTQNameL + | RTQNameLA + | Multiname of int * int + | MultinameA of int * int + | MultinameL of int + | MultinameLA of int type cpool = { int: int list; @@ -20,11 +34,29 @@ type cpool = { multiname: multiname list; } +type option_value = + IntVal of int + | UIntVal of int + | DoubleVal of int + | StringVal of int + | BoolVal of bool + | NullVal + | UndefinedVal + | NamespaceVal of int + +type method_flag = + NeedArguments + | NeedActivation + | NeedRest + | SetDxns + | HasOptional of option_value list + | HasParamNames of int list + type method_info = { params: int list; return: int; method_name: int; - method_flags: int; + method_flags: method_flag list; } (* TODO *) -- 2.11.0