From bde918e476fa097e457b89956fb75d62d7201388 Mon Sep 17 00:00:00 2001 From: mzp Date: Thu, 10 Sep 2009 08:50:49 +0900 Subject: [PATCH] wc --- base/base.ml | 2 +- swflib/OMakefile | 18 +- swflib/abc.ml | 267 +-------------------- swflib/{abc.mli => abcType.ml} | 67 ++---- swflib/abcWriter.ml | 177 ++++++++++++++ swflib/asm.ml | 513 +++++++++++++---------------------------- swflib/asm.mli | 25 -- swflib/gen_inst.ml | 16 +- swflib/gen_typemap | 1 + swflib/gen_typemap.ml | 32 +++ swflib/inst.ml | 101 ++++++++ swflib/inst.mlp | 5 + swflib/instruction.ml | 224 ++++++++++++++++++ swflib/instruction.mlp | 63 +---- swflib/instruction.txt | 120 +++++----- swflib/match_body.h | 89 +++++++ swflib/opcode.h | 89 +++++++ swflib/type.h | 89 +++++++ swflib/typemap.h | 28 +++ swflib/write.h | 89 +++++++ swflib/write_type.h | 24 ++ swflib/writer.h | 24 ++ 22 files changed, 1237 insertions(+), 826 deletions(-) rename swflib/{abc.mli => abcType.ml} (51%) create mode 100644 swflib/abcWriter.ml delete mode 100644 swflib/asm.mli create mode 120000 swflib/gen_typemap create mode 100644 swflib/gen_typemap.ml create mode 100644 swflib/inst.ml create mode 100644 swflib/inst.mlp create mode 100644 swflib/instruction.ml create mode 100644 swflib/match_body.h create mode 100644 swflib/opcode.h create mode 100644 swflib/type.h create mode 100644 swflib/typemap.h create mode 100644 swflib/write.h create mode 100644 swflib/write_type.h create mode 100644 swflib/writer.h diff --git a/base/base.ml b/base/base.ml index 6efacaa..e9d280d 100644 --- a/base/base.ml +++ b/base/base.ml @@ -19,7 +19,7 @@ let sure f = let maybe f x = try Some (f x) with Not_found -> None let tee f x = try ignore @@ f x; x with _ -> x -type ('a,'b) either = Val of 'a | Err of 'b +type ('a,'b) either = Left of 'a | Right of 'b let string_of_list xs = Printf.sprintf "[%s]" diff --git a/swflib/OMakefile b/swflib/OMakefile index b2092bf..b75e1a6 100644 --- a/swflib/OMakefile +++ b/swflib/OMakefile @@ -1,4 +1,3 @@ - # build OCAMLPACKS[] = extlib @@ -9,12 +8,10 @@ OCAMLPACKS[] = FILES[] = bytes label - abc - cpool - revList instruction - iSpec + abcType asm + abc UseCamlp4(pa_openin pa_oo) PROGRAM=../swflib @@ -22,11 +19,11 @@ PROGRAM=../swflib OCAMLINCLUDES += $(ROOT)/base OCAML_LIBS += $(ROOT)/base/base - OCAMLOPT = ocamlopt -for-pack $(capitalize $(basename $(PROGRAM))) OCAMLOPTLINK= ocamlopt OCamlProgram(gen_inst,gen_inst) +OCamlProgram(gen_typemap,gen_typemap) # test OUnitTest(bytes , bytes label) @@ -38,14 +35,17 @@ OUnitTest(asm , bytes asm cpool revList) # phony .PHONY: clean .DEFAULT: $(MyOCamlPackage $(PROGRAM), $(FILES)) -match_body.h: gen_inst$(EXE) instruction.txt +write.h: gen_inst$(EXE) instruction.txt ./gen_inst$(EXE) -writer < instruction.txt > $@ -opcode.h: gen_inst$(EXE) instruction.txt +type.h: gen_inst$(EXE) instruction.txt ./gen_inst$(EXE) -type < instruction.txt > $@ +write_type.h: gen_typemap$(EXE) + ./gen_typemap$(EXE) -writer > $@ + .SCANNER: instruction.ml : instruction.mlp grep "#include \"" $< | sed 's/.*"\(.*\)".*/'$@': \1/' clean: - ocaml-clean opcode.h match_body.h instruction.ml gen_inst$(EXE) + ocaml-clean opcode.h match_body.h instruction.ml gen_inst$(EXE) gen_typemap$(EXE) diff --git a/swflib/abc.ml b/swflib/abc.ml index 2a52a46..cea45ae 100644 --- a/swflib/abc.ml +++ b/swflib/abc.ml @@ -1,264 +1,11 @@ open Base -open Bytes -(* ---------------------------------------- - Type - ---------------------------------------- *) -type namespace = { - kind:int; namespace_name:int -} +include AbcType +type 'a s = 'a t -type namespace_set = int list +module A = Asm.Make(Instruction) -type multiname = - QName of int * int - | Multiname of int * int - -type cpool = { - int: int list; - uint: int list; - double: float list; - string: string list; - namespace: namespace list; - namespace_set: namespace_set list; - multiname: multiname list; -} - -type method_info = { - params: int list; - return: int; - method_name: int; - method_flags: int; -} -type trait_attr = - ATTR_Final | ATTR_Override | ATTR_Medadata - -type trait_data = - SlotTrait of int * int * int * int - | MethodTrait of int * int * trait_attr list - | GetterTrait of int * int * trait_attr list - | SetterTrait of int * int * trait_attr list - | ClassTrait of int * int - | FunctionTrait of int * int - | ConstTrait of int * int * int * int - -type trait = { - trait_name:int; - data:trait_data -} - -type script = { - init: int; - script_traits: trait list -} - -type class_info = { - cinit: int; - class_traits: trait list -} - -type class_flag = - Sealed | Final | Interface | ProtectedNs of int - -type instance_info={ - instance_name: int; - super_name: int; - instance_flags: class_flag list; - interface: int list; - iinit: int; - instance_traits:trait list -} - -type method_body = { - method_sig: int; - max_stack: int; - local_count: int; - init_scope_depth: int; - max_scope_depth: int; - code: Bytes.t list; - exceptions: int list; - method_traits: trait list -} - -type abc = { - cpool: cpool; - method_info: method_info list; - metadata: int list; - classes: class_info list; - instances: instance_info list; - scripts: script list; - method_bodies: method_body list -} - -(* ---------------------------------------- - Utils - ---------------------------------------- *) -let dummy _ = [u30 0] - -let array f xs = - let ys = - HList.concat_map f xs in - (u30 (List.length xs))::ys - -(* ---------------------------------------- - Constant Pool - ---------------------------------------- *) -let empty_cpool = - { int=[]; uint=[]; double=[]; string=[]; namespace=[]; namespace_set=[]; multiname=[]} - -let cpool_map f xs = - let ys = - HList.concat_map f xs in - let size = - 1+ List.length xs in - (u30 size)::ys - -let of_string str = - array (fun c -> [u8 (Char.code c)]) @@ ExtString.String.explode str - -let of_ns {kind=kind;namespace_name=name} = - [u8 kind; u30 name] - -let of_ns_set = - array (fun ns->[u30 ns]) - -let of_multiname = - function - QName (ns,name) -> - [u8 0x07;u30 ns; u30 name] - | Multiname (name,ns_set) -> - [u8 0x09;u30 name; u30 ns_set] - -let of_cpool cpool = - List.concat [ - cpool_map (fun x->[s32 x]) cpool.int; - cpool_map (fun x->[u32 x]) cpool.uint; - cpool_map (fun x->[d64 x]) cpool.double; - cpool_map of_string cpool.string; - cpool_map of_ns cpool.namespace; - cpool_map of_ns_set cpool.namespace_set; - cpool_map of_multiname cpool.multiname; - ] - -(* ---------------------------------------- - Trait - ---------------------------------------- *) -let of_trait_attrs attrs = - let of_attr attr = List.assoc attr [ATTR_Final ,0x01; - ATTR_Override,0x02; - ATTR_Medadata,0x04] in - List.fold_left (lor) 0 @@ List.map of_attr attrs - -(* kind field contains two four-bit fields. The lower four bits determine the kind of this trait. - The upper four bits comprise a bit vector providing attributes of the trait. *) -let kind attr kind = - u8 @@ ((of_trait_attrs attr) lsl 4) lor kind - -let of_trait_body = - function - SlotTrait (slot_id,type_name,vindex,vkind) -> - if vindex = 0 then - [u8 0;u30 slot_id; u30 type_name;u30 0] - else - [u8 0;u30 slot_id; u30 type_name;u30 vindex;u8 vkind] - | MethodTrait (disp_id,meth,attrs) -> - [kind attrs 1;u30 disp_id; u30 meth] - | GetterTrait (disp_id,meth,attrs) -> - [kind attrs 2;u30 disp_id; u30 meth] - | SetterTrait (disp_id,meth,attrs) -> - [kind attrs 3;u30 disp_id; u30 meth] - | ClassTrait (slot_id,classi) -> - [u8 4; u30 slot_id; u30 classi] - | FunctionTrait (slot_id,func) -> - [u8 5;u30 slot_id; u30 func] - | ConstTrait (slot_id,type_name,vindex,vkind) -> - if vindex = 0 then - [u8 6;u30 slot_id; u30 type_name;u30 0] - else - [u8 6;u30 slot_id; u30 type_name;u30 vindex;u8 vkind] - -let of_trait {trait_name=name; data=data} = - List.concat [[u30 name]; - of_trait_body data] - -(* ---------------------------------------- - Other - ---------------------------------------- *) -let of_method_info info = - List.concat [[u30 (List.length info.params); - u30 info.return]; - List.map u30 info.params; - [u30 info.method_name; - u8 info.method_flags]] - -let of_script {init=init; script_traits=traits} = - (u30 init)::array of_trait traits - -let of_method_body body = - let t = - Label.make () in - List.concat [ - [ u30 body.method_sig; - u30 body.max_stack; - u30 body.local_count; - u30 body.init_scope_depth; - u30 body.max_scope_depth]; - [backpatch 0 (fun addr map -> to_int_list [u30 (find map t - addr)])]; - body.code; - [label t]; - dummy body.exceptions; - array of_trait body.method_traits] - -let of_class {cinit=init; class_traits=traits} = - List.concat [ - [u30 init]; - array of_trait traits] - -let of_instance {instance_name = name; - super_name = sname; - instance_flags = flags; - interface = inf; - iinit = init; - instance_traits = traits} = - let flag = - function - Sealed -> 0x01 - | Final -> 0x02 - | Interface -> 0x04 - | ProtectedNs _ -> 0x08 in - let flags' = - List.fold_left (fun x y -> x lor (flag y)) 0 flags in - let ns = - flags - +> HList.concat_map begin function - ProtectedNs ns -> [u30 ns] - | Sealed | Final | Interface -> [] - end - +> function [] -> [] | x::_ -> [x] in - List.concat [ - [u30 name; - u30 sname; - u8 flags']; - ns; - array (fun x -> [u30 x]) inf; - [u30 init]; - array of_trait traits] - - -let to_bytes { cpool=cpool; - method_info=info; - metadata=metadata; - classes=classes; - instances=instances; - scripts=scripts; - method_bodies=bodies; } = - List.concat [ - [ u16 16; u16 46; ]; - of_cpool cpool; - array of_method_info info; - dummy metadata; - array of_instance instances; - HList.concat_map of_class classes; - array of_script scripts; - array of_method_body bodies - ] +let write ch insts = + insts + +> A.to_bytes + +> Bytes.output_bytes ch diff --git a/swflib/abc.mli b/swflib/abcType.ml similarity index 51% rename from swflib/abc.mli rename to swflib/abcType.ml index 74fd80f..1a0f2d9 100644 --- a/swflib/abc.mli +++ b/swflib/abcType.ml @@ -1,11 +1,5 @@ -(** - ABC(Action Script Bytecode) format. - - Provide the type of ABC and encoding function. - - @author mzp - @see AVM2 Overview(pdf) 4.2 abcFile - 4.10 Script -*) +open Base +open Bytes type namespace = { kind:int; namespace_name:int @@ -18,20 +12,20 @@ type multiname = | Multiname of int * int type cpool = { - int: int list; - uint: int list; - double: float list; - string: string list; - namespace: namespace list; + int: int list; + uint: int list; + double: float list; + string: string list; + namespace: namespace list; namespace_set: namespace_set list; - multiname: multiname list; + multiname: multiname list; } type method_info = { - params: int list; - return: int; + params: int list; + return: int; method_name: int; - method_flags:int; + method_flags: int; } type trait_attr = @@ -73,42 +67,23 @@ type instance_info={ instance_traits:trait list } -type method_body = { +type 'a method_body = { method_sig: int; max_stack: int; local_count: int; init_scope_depth: int; max_scope_depth: int; - code: Bytes.t list; + code: 'a list; exceptions: int list; method_traits: trait list } -type abc = { - cpool: cpool; - method_info: method_info list; - metadata: int list; - classes: class_info list; - instances: instance_info list; - scripts: script list; - method_bodies: method_body list +type 'a t = { + cpool: cpool; + method_info: method_info list; + metadata: int list; + classes: class_info list; + instances: instance_info list; + scripts: script list; + method_bodies: 'a method_body list } - -(* cpool *) -val empty_cpool : cpool - -(** - Byte serializer for {!Abc}. -*) -val to_bytes : abc -> Bytes.t list - -(**{6 Debug only}*) - -val of_cpool : cpool -> Bytes.t list -val of_method_info : method_info -> Bytes.t list -val of_script : script -> Bytes.t list -val of_trait : trait -> Bytes.t list -val of_method_body : method_body -> Bytes.t list - -val of_class : class_info -> Bytes.t list -val of_instance : instance_info -> Bytes.t list diff --git a/swflib/abcWriter.ml b/swflib/abcWriter.ml new file mode 100644 index 0000000..3b2454b --- /dev/null +++ b/swflib/abcWriter.ml @@ -0,0 +1,177 @@ +open Base + +module type Writer = sig + type t + val write : t -> Bytes.t list +end + +module Make(Writer : Writer) = struct + open Bytes + open AbcType + + let dummy _ = [u30 0] + + let array f xs = + let ys = + HList.concat_map f xs in + (u30 (List.length xs))::ys + + (* Constant Pool *) + let empty_cpool = + { int=[]; uint=[]; double=[]; string=[]; namespace=[]; namespace_set=[]; multiname=[]} + + let cpool_map f xs = + let ys = + HList.concat_map f xs in + let size = + 1+ List.length xs in + (u30 size)::ys + + let of_string str = + array (fun c -> [u8 (Char.code c)]) @@ ExtString.String.explode str + + let of_ns {kind=kind;namespace_name=name} = + [u8 kind; u30 name] + + let of_ns_set = + array (fun ns->[u30 ns]) + + let of_multiname = + function + QName (ns,name) -> + [u8 0x07;u30 ns; u30 name] + | Multiname (name,ns_set) -> + [u8 0x09;u30 name; u30 ns_set] + + let of_cpool cpool = + List.concat [ + cpool_map (fun x->[s32 x]) cpool.int; + cpool_map (fun x->[u32 x]) cpool.uint; + cpool_map (fun x->[d64 x]) cpool.double; + cpool_map of_string cpool.string; + cpool_map of_ns cpool.namespace; + cpool_map of_ns_set cpool.namespace_set; + cpool_map of_multiname cpool.multiname; + ] + + (* Trait *) + let of_trait_attrs attrs = + let of_attr attr = List.assoc attr [ATTR_Final ,0x01; + ATTR_Override,0x02; + ATTR_Medadata,0x04] in + List.fold_left (lor) 0 @@ List.map of_attr attrs + + (* kind field contains two four-bit fields. The lower four bits determine the kind of this trait. + The upper four bits comprise a bit vector providing attributes of the trait. *) + let kind attr kind = + u8 @@ ((of_trait_attrs attr) lsl 4) lor kind + + let of_trait_body = + function + SlotTrait (slot_id,type_name,vindex,vkind) -> + if vindex = 0 then + [u8 0;u30 slot_id; u30 type_name;u30 0] + else + [u8 0;u30 slot_id; u30 type_name;u30 vindex;u8 vkind] + | MethodTrait (disp_id,meth,attrs) -> + [kind attrs 1;u30 disp_id; u30 meth] + | GetterTrait (disp_id,meth,attrs) -> + [kind attrs 2;u30 disp_id; u30 meth] + | SetterTrait (disp_id,meth,attrs) -> + [kind attrs 3;u30 disp_id; u30 meth] + | ClassTrait (slot_id,classi) -> + [u8 4; u30 slot_id; u30 classi] + | FunctionTrait (slot_id,func) -> + [u8 5;u30 slot_id; u30 func] + | ConstTrait (slot_id,type_name,vindex,vkind) -> + if vindex = 0 then + [u8 6;u30 slot_id; u30 type_name;u30 0] + else + [u8 6;u30 slot_id; u30 type_name;u30 vindex;u8 vkind] + + let of_trait {trait_name=name; data=data} = + List.concat [[u30 name]; + of_trait_body data] + + (* ---------------------------------------- + Other + ---------------------------------------- *) + let of_method_info info = + List.concat [[u30 (List.length info.params); + u30 info.return]; + List.map u30 info.params; + [u30 info.method_name; + u8 info.method_flags]] + + let of_script {init=init; script_traits=traits} = + (u30 init)::array of_trait traits + + let of_method_body body = + let t = + Label.make () in + List.concat [ + [ u30 body.method_sig; + u30 body.max_stack; + u30 body.local_count; + u30 body.init_scope_depth; + u30 body.max_scope_depth]; + [backpatch 0 (fun addr map -> to_int_list [u30 (find map t - addr)])]; + body.code; + [label t]; + dummy body.exceptions; + array of_trait body.method_traits] + + let of_class {cinit=init; class_traits=traits} = + List.concat [ + [u30 init]; + array of_trait traits] + + let of_instance {instance_name = name; + super_name = sname; + instance_flags = flags; + interface = inf; + iinit = init; + instance_traits = traits} = + let flag = + function + Sealed -> 0x01 + | Final -> 0x02 + | Interface -> 0x04 + | ProtectedNs _ -> 0x08 in + let flags' = + List.fold_left (fun x y -> x lor (flag y)) 0 flags in + let ns = + flags + +> HList.concat_map begin function + ProtectedNs ns -> [u30 ns] + | Sealed | Final | Interface -> [] + end + +> function [] -> [] | x::_ -> [x] in + List.concat [ + [u30 name; + u30 sname; + u8 flags']; + ns; + array (fun x -> [u30 x]) inf; + [u30 init]; + array of_trait traits] + + + let to_bytes { cpool=cpool; + method_info=info; + metadata=metadata; + classes=classes; + instances=instances; + scripts=scripts; + method_bodies=bodies; } = + List.concat [ + [ u16 16; u16 46; ]; + of_cpool cpool; + array of_method_info info; + dummy metadata; + array of_instance instances; + HList.concat_map of_class classes; + array of_script scripts; + array of_method_body bodies + ] +end diff --git a/swflib/asm.ml b/swflib/asm.ml index e5f1be7..dd3e139 100644 --- a/swflib/asm.ml +++ b/swflib/asm.ml @@ -1,369 +1,176 @@ open Base -open Bytes -(* data flow *) -let fork2 f g x = (f x, g x) -let fork3 f g h x = (f x, g x, h x) -let fork4 f g h i x = (f x, g x, h x, i x) - -let with2 f g (a,b) = (f a, g b) -let with3 f g h (a,b,c) = (f a, g b, h c) -let with4 f g h i (a,b,c,d) = (f a, g b, h c, i d) - -let join2 f (a,b) = f a b -let join3 f (a,b,c) = f a b c -let join4 f (a,b,c,d) = f a b c d - -module type Spec = sig +module type Inst = sig type t - val spec : t -> t ISpec.t + val to_bytes : t -> Bytes.t list end -type t = { - cpool: Cpool.t; - method_info: Abc.method_info list; - method_body: Abc.method_body list; - class_info: Abc.class_info list; - instance_info: Abc.instance_info list -} - -module Make(Spec:Spec) = struct - (* type *) - type method_ = Spec.t ISpec.method_ - type class_ = Spec.t ISpec.class_ - type context = Spec.t ISpec.context - type instruction = Spec.t +module Make(Inst : Inst) = struct + open Bytes + open AbcType - (* fold *) - type ghost = [ - `Script of method_ - | `InstanceMethod of method_ - | `StaticMethod of method_ - | `InstanceInit of method_ - | `ClassInit of method_ - ] + let dummy _ = [u30 0] - (* help me : - I want to write: - type inst [ ghost | Spec.t] - - But compiler says: "Spec.t is not poly variants" - *) - type inst = [ - ghost - | `Inst of Spec.t ] - - let method_ : inst -> method_ option = - function - `InstanceMethod m - | `StaticMethod m - | `Script m - | `InstanceInit m - | `ClassInit m -> - Some m - | `Inst inst -> - ((Spec.spec inst).ISpec.method_) + let array f xs = + let ys = + HList.concat_map f xs in + (u30 (List.length xs))::ys - let class_ : inst -> class_ option = - function - `InstanceMethod _ | `StaticMethod _ | `Script _ | `InstanceInit _ | `ClassInit _ -> - None - | `Inst inst -> - ((Spec.spec inst).ISpec.class_) + (* Constant Pool *) + let empty_cpool = + { int=[]; uint=[]; double=[]; string=[]; namespace=[]; namespace_set=[]; multiname=[]} - let fold f init inst = - let rec loop ctx inst = - let method_ctx = - match method_ inst with - Some {ISpec.instructions=instructions} -> - let instructions' = - instructions - +> List.map (fun i -> `Inst i) in - let ctx' = - List.fold_left loop (ctx#current_method <- init#current_method) - (instructions' :> inst list) in - (ctx'#sub_method <- ctx'#current_method)#current_method <- - ctx#current_method - | None -> - ctx in - let class_ctx = - match class_ inst with - Some { ISpec.iinit=iinit; - cinit=cinit; - instance_methods = im; - static_methods = sm } -> - let ctx' = - loop method_ctx (`InstanceInit iinit) in - let ctx'' = - loop ctx' (`ClassInit cinit) in - let ctx''' = - List.fold_left (fun ctx m -> loop ctx (`InstanceMethod m)) ctx'' im in - List.fold_left (fun ctx m -> loop ctx (`StaticMethod m)) ctx''' sm - | None -> - method_ctx in - f class_ctx inst in - loop init inst + let cpool_map f xs = + let ys = + HList.concat_map f xs in + let size = + 1+ List.length xs in + (u30 size)::ys - (* dataflow block *) - let filter_const inst = - let inst_const = - match inst with - #ghost -> - [] - | `Inst i -> - (Spec.spec i).ISpec.const in - let method_const = - match method_ inst with - Some {ISpec.method_name = name } -> - [name] - | None -> - [] in - let class_const = - match class_ inst with - Some {ISpec.class_name=class_name; super=super; attributes=attributes} -> - class_name::super::attributes - | None -> - [] in - inst_const @ (method_const :> Cpool.entry list) @ (class_const :> Cpool.entry list) + let of_string str = + array (fun c -> [u8 (Char.code c)]) @@ ExtString.String.explode str - let filter_class = - function - #ghost -> - None - | `Inst inst -> - ((Spec.spec inst).ISpec.class_) (* extra paren is inserted for tuarge-mode *) + let of_ns {kind=kind;namespace_name=name} = + [u8 kind; u30 name] - let filter_method = - (method_) (* extra paren is inserted for tuarge-mode *) + let of_ns_set = + array (fun ns->[u30 ns]) - let if_some f init = + let of_multiname = function - Some x -> - f init x - | None -> - init - - let make_context ctx const (class_ : class_ option) (method_ : method_ option) = - let ctx = - ctx#cpool <- List.fold_left (flip Cpool.add) ctx#cpool const in - let ctx = - if_some (fun ctx c -> ctx#classes <- RevList.add c ctx#classes ) ctx class_ in - let ctx = - if_some (fun ctx m -> ctx#methods <- RevList.add m ctx#methods ) ctx method_ in - ctx - - (* make *) - let make_inst ctx = + QName (ns,name) -> + [u8 0x07;u30 ns; u30 name] + | Multiname (name,ns_set) -> + [u8 0x09;u30 name; u30 ns_set] + + let of_cpool cpool = + List.concat [ + cpool_map (fun x->[s32 x]) cpool.int; + cpool_map (fun x->[u32 x]) cpool.uint; + cpool_map (fun x->[d64 x]) cpool.double; + cpool_map of_string cpool.string; + cpool_map of_ns cpool.namespace; + cpool_map of_ns_set cpool.namespace_set; + cpool_map of_multiname cpool.multiname; + ] + + (* Trait *) + let of_trait_attrs attrs = + let of_attr attr = List.assoc attr [ATTR_Final ,0x01; + ATTR_Override,0x02; + ATTR_Medadata,0x04] in + List.fold_left (lor) 0 @@ List.map of_attr attrs + + (* kind field contains two four-bit fields. The lower four bits determine the kind of this trait. + The upper four bits comprise a bit vector providing attributes of the trait. *) + let kind attr kind = + u8 @@ ((of_trait_attrs attr) lsl 4) lor kind + + let of_trait_body = function - #ghost -> - None - | `Inst inst -> - let {ISpec.op=op; prefix=prefix; args=args} = - Spec.spec inst in - Some (List.concat [ - prefix (ctx :> context); - [u8 op]; - args (ctx :> context)]) - - let make_class ~cpool ~classes ~methods inst = - let make c = - let flag = - function - `Sealed -> Abc.Sealed - | `Final -> Abc.Final - | `Interface -> Abc.Interface - | `ProtectedNs ns -> Abc.ProtectedNs (Cpool.index ns cpool) in - let method_attr = - function `Override -> Abc.ATTR_Override - | `Final -> Abc.ATTR_Final in - let method_trait m = { - Abc.trait_name = Cpool.index m.ISpec.method_name cpool; - data = Abc.MethodTrait (0, - RevList.index m methods, - List.map method_attr m.ISpec.method_attrs) } in - let attr_trait id attr = { - Abc.trait_name = Cpool.index attr cpool; - data = Abc.SlotTrait (id+1,0,0,0) } in - let class_info = { - Abc.cinit = RevList.index c.ISpec.cinit methods; - class_traits = List.map method_trait c.ISpec.static_methods - } in - let instance_info = { - Abc.instance_name = - Cpool.index c.ISpec.class_name cpool; - super_name = - Cpool.index c.ISpec.super cpool; - instance_flags = - List.map flag c.ISpec.class_flags; - interface = - List.map (flip RevList.index classes) c.ISpec.interface; - iinit = - RevList.index c.ISpec.iinit methods; - instance_traits = - List.concat [ - List.map method_trait c.ISpec.instance_methods; - ExtList.List.mapi attr_trait c.ISpec.attributes - ] - } in - class_info,instance_info in - sure make @@ class_ inst - - (* make method *) - let empty_usage = object - val stack = (0,0) with accessor - val scope = (0,0) with accessor - end - - let add_usage i (current,max_value)= - (current + i, max max_value (current+i)) - let filter_usage usage = - function - #ghost -> - usage - | `Inst inst -> - let {ISpec.stack=stack; scope=scope} = - Spec.spec inst in - let usage = - usage#stack <- add_usage stack usage#stack in - let usage = - usage#scope <- add_usage scope usage#scope in - usage - - let mn_name = - function - `QName (_,str) -> - str - | `Multiname (str,_) -> - str - - let make_method ~cpool ~insts ~usage inst = - let make m = - let info = - { Abc.params = m.ISpec.params; - return = m.ISpec.return; - method_name = Cpool.index (`String (mn_name m.ISpec.method_name)) cpool; - method_flags = m.ISpec.method_flags } in - let body = - { Abc.method_sig = -1; (* dummy *) - max_stack = snd usage#stack; - local_count = List.length m.ISpec.params+1; - init_scope_depth = 0; - max_scope_depth = snd usage#scope; - code = List.concat @@ List.rev insts; - exceptions = []; - method_traits = [] } in - info,body in - sure make @@ method_ inst - - let ($>) g f x = f (g x) - - (* pipeline *) - let pipeline (ctx :'a) inst : 'a = - inst - +> fork2 - (fork2 - (fork3 filter_const filter_class filter_method $> join3 (make_context ctx)) - id - $> fork4 - fst - (curry make_inst) - (fun (ctx,inst) -> - make_class - ~cpool:ctx#cpool - ~classes:ctx#classes - ~methods:ctx#methods - inst) - (fun (ctx,inst) -> - make_method - ~cpool:ctx#cpool - ~insts:ctx#sub_method#insts - ~usage:ctx#sub_method#usage - inst)) - (filter_usage ctx#current_method#usage) - +> (fun ((ctx, inst, c, m), usage) -> - let current_method = - if_some (fun c i -> c#insts <- i::c#insts) ctx#current_method inst in - let current_method = - current_method#usage <- usage in - let ctx = - ctx#current_method <- current_method in - let ctx = - if_some (fun c m -> c#abc_methods <- m::c#abc_methods) ctx m in - let ctx = - if_some (fun c m -> c#abc_classes <- m::c#abc_classes) ctx c in - ctx) - - let context = object - val cpool = Cpool.empty with accessor - val abc_methods = [] with accessor - val abc_classes = [] with accessor - - val methods = RevList.empty with accessor - val classes = RevList.empty with accessor - - val current_method = object - val insts = [] with accessor - val usage = empty_usage with accessor - end with accessor - - val sub_method = object - val insts = [] with accessor - val usage = empty_usage with accessor - end with accessor - end - - let assemble_slot_traits cpool xs = - xs - +> List.map (fun (name,id)-> { - Abc.trait_name = Cpool.index name cpool; - data = Abc.SlotTrait (id,0,0,0); - }) - - let assemble_method m = - let ctx = - fold pipeline context (`Script m) in - { - cpool = ctx#cpool; - method_info = List.rev_map fst ctx#abc_methods; - method_body = ctx#abc_methods - +> List.rev_map snd - +> ExtList.List.mapi (fun i m -> {m with Abc.method_sig=i}); - class_info = List.rev_map fst ctx#abc_classes; - instance_info = List.rev_map snd ctx#abc_classes; - } - - let assemble slots m = - let { cpool = cpool; - method_info = info; - method_body = body; - class_info = class_info; - instance_info = instance_info} = - assemble_method m in - let cpool,slots' = - map_accum_left - (fun cpool ((ns,name),i)-> - let qname = - `QName(`Namespace (String.concat "." ns), name) in - (Cpool.add qname cpool,(qname,i))) - cpool - slots in - let slot_traits = - assemble_slot_traits cpool slots' in - let class_traits = - let n = - List.length slots in - ExtList.List.mapi - (fun i {Abc.instance_name=name} -> - {Abc.trait_name=name; data=Abc.ClassTrait (i+n+1,i)}) - instance_info in - { Abc.cpool = Cpool.to_abc cpool; - method_info = info; - method_bodies = body; - metadata = []; - classes = class_info; - instances = instance_info; - scripts = [{ - Abc.init = List.length info - 1; - script_traits = slot_traits @ class_traits - }]} + SlotTrait (slot_id,type_name,vindex,vkind) -> + if vindex = 0 then + [u8 0;u30 slot_id; u30 type_name;u30 0] + else + [u8 0;u30 slot_id; u30 type_name;u30 vindex;u8 vkind] + | MethodTrait (disp_id,meth,attrs) -> + [kind attrs 1;u30 disp_id; u30 meth] + | GetterTrait (disp_id,meth,attrs) -> + [kind attrs 2;u30 disp_id; u30 meth] + | SetterTrait (disp_id,meth,attrs) -> + [kind attrs 3;u30 disp_id; u30 meth] + | ClassTrait (slot_id,classi) -> + [u8 4; u30 slot_id; u30 classi] + | FunctionTrait (slot_id,func) -> + [u8 5;u30 slot_id; u30 func] + | ConstTrait (slot_id,type_name,vindex,vkind) -> + if vindex = 0 then + [u8 6;u30 slot_id; u30 type_name;u30 0] + else + [u8 6;u30 slot_id; u30 type_name;u30 vindex;u8 vkind] + + let of_trait {trait_name=name; data=data} = + List.concat [[u30 name]; + of_trait_body data] + + (* ---------------------------------------- + Other + ---------------------------------------- *) + let of_method_info info = + List.concat [[u30 (List.length info.params); + u30 info.return]; + List.map u30 info.params; + [u30 info.method_name; + u8 info.method_flags]] + + let of_script {init=init; script_traits=traits} = + (u30 init)::array of_trait traits + + let of_method_body body = + let t = + Label.make () in + List.concat [ + [ u30 body.method_sig; + u30 body.max_stack; + u30 body.local_count; + u30 body.init_scope_depth; + u30 body.max_scope_depth]; + [backpatch 0 (fun addr map -> to_int_list [u30 (find map t - addr)])]; + HList.concat_map Inst.to_bytes body.code; + [label t]; + dummy body.exceptions; + array of_trait body.method_traits] + + let of_class {cinit=init; class_traits=traits} = + List.concat [ + [u30 init]; + array of_trait traits] + + let of_instance {instance_name = name; + super_name = sname; + instance_flags = flags; + interface = inf; + iinit = init; + instance_traits = traits} = + let flag = + function + Sealed -> 0x01 + | Final -> 0x02 + | Interface -> 0x04 + | ProtectedNs _ -> 0x08 in + let flags' = + List.fold_left (fun x y -> x lor (flag y)) 0 flags in + let ns = + flags + +> HList.concat_map begin function + ProtectedNs ns -> [u30 ns] + | Sealed | Final | Interface -> [] + end + +> function [] -> [] | x::_ -> [x] in + List.concat [ + [u30 name; + u30 sname; + u8 flags']; + ns; + array (fun x -> [u30 x]) inf; + [u30 init]; + array of_trait traits] + + let to_bytes { cpool=cpool; + method_info=info; + metadata=metadata; + classes=classes; + instances=instances; + scripts=scripts; + method_bodies=bodies; } = + List.concat [ + [ u16 16; u16 46; ]; + of_cpool cpool; + array of_method_info info; + dummy metadata; + array of_instance instances; + HList.concat_map of_class classes; + array of_script scripts; + array of_method_body bodies + ] end diff --git a/swflib/asm.mli b/swflib/asm.mli deleted file mode 100644 index 34997a0..0000000 --- a/swflib/asm.mli +++ /dev/null @@ -1,25 +0,0 @@ -module type Spec = sig - type t - val spec : t -> t ISpec.t -end - -type t = { - cpool: Cpool.t; - method_info: Abc.method_info list; - method_body: Abc.method_body list; - class_info: Abc.class_info list; - instance_info: Abc.instance_info list -} - - -module Make: functor(Spec : Spec) -> - sig - type method_ = Spec.t ISpec.method_ - type class_ = Spec.t ISpec.class_ - type instruction = Spec.t - - val assemble : ((string list * string) * int) list -> method_ -> Abc.abc - - val assemble_method : method_ -> t - val assemble_slot_traits : Cpool.t -> ([< Cpool.entry ] * int) list -> Abc.trait list - end diff --git a/swflib/gen_inst.ml b/swflib/gen_inst.ml index 98df852..c20c304 100644 --- a/swflib/gen_inst.ml +++ b/swflib/gen_inst.ml @@ -96,27 +96,19 @@ let cmds = [ else sprintf "| `%s of %s" name @@ String.concat "*" args); (* writer *) - ("-writer",fun {name=name; opcode=opcode; args=args; extra=extra} -> + ("-writer",fun {name=name; opcode=opcode; args=args} -> let pat = sprintf "`%s %s" name (match args with [] -> "" - | [_] -> "arg0" | _::_ -> - sprintf "of (%s)" @@ + sprintf "(%s)" @@ concat_mapi "," (fun _ i -> sprintf "arg%d" i) args) in let record = - sprintf "{default with op=0x%x; args=(fun _ctx -> [%s]); const=filter_map id [%s]}" + sprintf "[u8 0x%x; %s]" opcode - (concat_mapi ";" (sprintf "p_%s _ctx arg%d") args) - (concat_mapi ";" (sprintf "c_%s arg%d") args) in - let record = - if extra = "" then - record - else - sprintf "{ %s with %s}" record extra - in + (concat_mapi ";" (sprintf "write_%s arg%d") args) in sprintf "| %s -> %s" pat record) ] diff --git a/swflib/gen_typemap b/swflib/gen_typemap new file mode 120000 index 0000000..36fe935 --- /dev/null +++ b/swflib/gen_typemap @@ -0,0 +1 @@ +gen_typemap.opt \ No newline at end of file diff --git a/swflib/gen_typemap.ml b/swflib/gen_typemap.ml new file mode 100644 index 0000000..a1a5127 --- /dev/null +++ b/swflib/gen_typemap.ml @@ -0,0 +1,32 @@ +open Base +open Str +open ExtList +open Printf + +let write name ~ocaml ~byte = + printf "type %s = %s\n" name ocaml; + printf "let write_%s= %s\n" name byte + +let u30 name = + write name ~ocaml:"int" ~byte:"u30" + +let _ = + match Sys.argv.(1) with + "-writer" -> + u30 "method_"; + u30 "class_"; + u30 "c_int"; + u30 "c_uint"; + u30 "c_string"; + u30 "c_float"; + u30 "namespace"; + u30 "multiname"; + u30 "u30"; + write "u8" ~ocaml:"int" ~byte:"u8"; + write "label" + ~ocaml:"(Label.t,int) either" + ~byte:"function + Left label -> label_ref label + | Right address -> s24 address" + | _ -> + exit 1 diff --git a/swflib/inst.ml b/swflib/inst.ml new file mode 100644 index 0000000..6f0cd7f --- /dev/null +++ b/swflib/inst.ml @@ -0,0 +1,101 @@ +(* CAUTION: this is a generated file. If you edit it, all changes will be lost! *) +# 1 "inst.mlp" +# 1 "" +# 1 "" +# 1 "inst.mlp" +open Base + +type t = [ + +# 1 "type.h" 1 +| `NewFunction of method_ +| `NewClass of class_ +| `Coerce +| `Coerce_a +| `Coerce_s +| `Convert_i +| `Convert_s +| `Convert_d +| `Convert_b +| `Convert_u +| `Add_i +| `Subtract_i +| `Multiply_i +| `Add +| `Subtract +| `Multiply +| `Divide +| `Modulo +| `Equals +| `StrictEquals +| `LessThan +| `LessEquals +| `GreaterThan +| `GreaterEquals +| `Label of label +| `IfNlt of label +| `IfNle of label +| `IfNgt of label +| `IfNge of label +| `Jump of label +| `IfTrue of label +| `IfFalse of label +| `IfEq of label +| `IfNe of label +| `IfLt of label +| `IfLe of label +| `IfGt of label +| `IfGe of label +| `IfStrictEq of label +| `IfStrictNe of label +| `PushNull +| `PushUndefined +| `PushByte of u8 +| `PushShort of u30 +| `PushTrue +| `PushFalse +| `PushNaN +| `PushString of string +| `PushInt of int +| `PushUInt of uint +| `PushDouble of float +| `PushNamespace of namespace +| `PushScope +| `PushWith +| `GetGlobalScope +| `GetScopeObject of u8 +| `GetLocal_0 +| `GetLocal_1 +| `GetLocal_2 +| `GetLocal_3 +| `GetLocal of u30 +| `SetLocal_0 +| `SetLocal_1 +| `SetLocal_2 +| `SetLocal_3 +| `SetLocal of u30 +| `GetSlot of u30 +| `SetSlot of u30 +| `GetGlobalSlot of u30 +| `SetGlobalSlot of u30 +| `GetLex of multiname +| `GetProperty of multiname +| `SetProperty of multiname +| `InitProperty of multiname +| `ReturnVoid +| `ReturnValue +| `FindPropStrict of multiname +| `CallProperty of multiname*u30 +| `CallPropLex of multiname*u30 +| `Call of u30 +| `Pop +| `Swap +| `PopScope +| `NewObject of u30 +| `NewArray of u30 +| `NewActivation +| `Dup +| `ConstructSuper of u30 +| `ConstructProp of multiname*u30 +# 5 "inst.mlp" 2 +] diff --git a/swflib/inst.mlp b/swflib/inst.mlp new file mode 100644 index 0000000..f7f7a59 --- /dev/null +++ b/swflib/inst.mlp @@ -0,0 +1,5 @@ +open Base + +type t = [ +#include "type.h" +] diff --git a/swflib/instruction.ml b/swflib/instruction.ml new file mode 100644 index 0000000..79c50bb --- /dev/null +++ b/swflib/instruction.ml @@ -0,0 +1,224 @@ +(* CAUTION: this is a generated file. If you edit it, all changes will be lost! *) +# 1 "instruction.mlp" +# 1 "" +# 1 "" +# 1 "instruction.mlp" +open Base +open Bytes + + +# 1 "write_type.h" 1 +type method_ = int +let write_method_= u30 +type class_ = int +let write_class_= u30 +type c_int = int +let write_c_int= u30 +type c_uint = int +let write_c_uint= u30 +type c_string = int +let write_c_string= u30 +type c_float = int +let write_c_float= u30 +type namespace = int +let write_namespace= u30 +type multiname = int +let write_multiname= u30 +type u30 = int +let write_u30= u30 +type u8 = int +let write_u8= u8 +type label = (Label.t,int) either +let write_label= function + Left label -> label_ref label + | Right address -> s24 address +# 5 "instruction.mlp" 2 +type t = [ + +# 1 "type.h" 1 +| `NewFunction of method_ +| `NewClass of class_ +| `Coerce +| `Coerce_a +| `Coerce_s +| `Convert_i +| `Convert_s +| `Convert_d +| `Convert_b +| `Convert_u +| `Add_i +| `Subtract_i +| `Multiply_i +| `Add +| `Subtract +| `Multiply +| `Divide +| `Modulo +| `Equals +| `StrictEquals +| `LessThan +| `LessEquals +| `GreaterThan +| `GreaterEquals +| `Label of label +| `IfNlt of label +| `IfNle of label +| `IfNgt of label +| `IfNge of label +| `Jump of label +| `IfTrue of label +| `IfFalse of label +| `IfEq of label +| `IfNe of label +| `IfLt of label +| `IfLe of label +| `IfGt of label +| `IfGe of label +| `IfStrictEq of label +| `IfStrictNe of label +| `PushNull +| `PushUndefined +| `PushByte of u8 +| `PushShort of u30 +| `PushTrue +| `PushFalse +| `PushNaN +| `PushString of c_string +| `PushInt of c_int +| `PushUInt of c_uint +| `PushDouble of c_float +| `PushNamespace of namespace +| `PushScope +| `PushWith +| `GetGlobalScope +| `GetScopeObject of u8 +| `GetLocal_0 +| `GetLocal_1 +| `GetLocal_2 +| `GetLocal_3 +| `GetLocal of u30 +| `SetLocal_0 +| `SetLocal_1 +| `SetLocal_2 +| `SetLocal_3 +| `SetLocal of u30 +| `GetSlot of u30 +| `SetSlot of u30 +| `GetGlobalSlot of u30 +| `SetGlobalSlot of u30 +| `GetLex of multiname +| `GetProperty of multiname +| `SetProperty of multiname +| `InitProperty of multiname +| `ReturnVoid +| `ReturnValue +| `FindPropStrict of multiname +| `CallProperty of multiname*u30 +| `CallPropLex of multiname*u30 +| `Call of u30 +| `Pop +| `Swap +| `PopScope +| `NewObject of u30 +| `NewArray of u30 +| `NewActivation +| `Dup +| `ConstructSuper of u30 +| `ConstructProp of multiname*u30 +# 7 "instruction.mlp" 2 +] + +let to_bytes = + function + +# 1 "write.h" 1 +| `NewFunction (arg0) -> [u8 0x40; write_method_ arg0] +| `NewClass (arg0) -> [u8 0x58; write_class_ arg0] +| `Coerce -> [u8 0x80; ] +| `Coerce_a -> [u8 0x82; ] +| `Coerce_s -> [u8 0x85; ] +| `Convert_i -> [u8 0x73; ] +| `Convert_s -> [u8 0x74; ] +| `Convert_d -> [u8 0x75; ] +| `Convert_b -> [u8 0x76; ] +| `Convert_u -> [u8 0x77; ] +| `Add_i -> [u8 0xc5; ] +| `Subtract_i -> [u8 0xc6; ] +| `Multiply_i -> [u8 0xc7; ] +| `Add -> [u8 0xa0; ] +| `Subtract -> [u8 0xa1; ] +| `Multiply -> [u8 0xa2; ] +| `Divide -> [u8 0xa3; ] +| `Modulo -> [u8 0xa4; ] +| `Equals -> [u8 0xab; ] +| `StrictEquals -> [u8 0xac; ] +| `LessThan -> [u8 0xad; ] +| `LessEquals -> [u8 0xae; ] +| `GreaterThan -> [u8 0xaf; ] +| `GreaterEquals -> [u8 0xb0; ] +| `Label (arg0) -> [u8 0x9; write_label arg0] +| `IfNlt (arg0) -> [u8 0xc; write_label arg0] +| `IfNle (arg0) -> [u8 0xd; write_label arg0] +| `IfNgt (arg0) -> [u8 0xe; write_label arg0] +| `IfNge (arg0) -> [u8 0xf; write_label arg0] +| `Jump (arg0) -> [u8 0x10; write_label arg0] +| `IfTrue (arg0) -> [u8 0x11; write_label arg0] +| `IfFalse (arg0) -> [u8 0x12; write_label arg0] +| `IfEq (arg0) -> [u8 0x13; write_label arg0] +| `IfNe (arg0) -> [u8 0x14; write_label arg0] +| `IfLt (arg0) -> [u8 0x15; write_label arg0] +| `IfLe (arg0) -> [u8 0x16; write_label arg0] +| `IfGt (arg0) -> [u8 0x17; write_label arg0] +| `IfGe (arg0) -> [u8 0x18; write_label arg0] +| `IfStrictEq (arg0) -> [u8 0x19; write_label arg0] +| `IfStrictNe (arg0) -> [u8 0x1a; write_label arg0] +| `PushNull -> [u8 0x20; ] +| `PushUndefined -> [u8 0x21; ] +| `PushByte (arg0) -> [u8 0x24; write_u8 arg0] +| `PushShort (arg0) -> [u8 0x25; write_u30 arg0] +| `PushTrue -> [u8 0x26; ] +| `PushFalse -> [u8 0x27; ] +| `PushNaN -> [u8 0x28; ] +| `PushString (arg0) -> [u8 0x2c; write_c_string arg0] +| `PushInt (arg0) -> [u8 0x2d; write_c_int arg0] +| `PushUInt (arg0) -> [u8 0x2e; write_c_uint arg0] +| `PushDouble (arg0) -> [u8 0x2f; write_c_float arg0] +| `PushNamespace (arg0) -> [u8 0x31; write_namespace arg0] +| `PushScope -> [u8 0x30; ] +| `PushWith -> [u8 0x1c; ] +| `GetGlobalScope -> [u8 0x64; ] +| `GetScopeObject (arg0) -> [u8 0x65; write_u8 arg0] +| `GetLocal_0 -> [u8 0xd0; ] +| `GetLocal_1 -> [u8 0xd1; ] +| `GetLocal_2 -> [u8 0xd2; ] +| `GetLocal_3 -> [u8 0xd3; ] +| `GetLocal (arg0) -> [u8 0x62; write_u30 arg0] +| `SetLocal_0 -> [u8 0xd4; ] +| `SetLocal_1 -> [u8 0xd5; ] +| `SetLocal_2 -> [u8 0xd6; ] +| `SetLocal_3 -> [u8 0xd7; ] +| `SetLocal (arg0) -> [u8 0x63; write_u30 arg0] +| `GetSlot (arg0) -> [u8 0x6c; write_u30 arg0] +| `SetSlot (arg0) -> [u8 0x6d; write_u30 arg0] +| `GetGlobalSlot (arg0) -> [u8 0x6e; write_u30 arg0] +| `SetGlobalSlot (arg0) -> [u8 0x6f; write_u30 arg0] +| `GetLex (arg0) -> [u8 0x60; write_multiname arg0] +| `GetProperty (arg0) -> [u8 0x66; write_multiname arg0] +| `SetProperty (arg0) -> [u8 0x61; write_multiname arg0] +| `InitProperty (arg0) -> [u8 0x68; write_multiname arg0] +| `ReturnVoid -> [u8 0x47; ] +| `ReturnValue -> [u8 0x48; ] +| `FindPropStrict (arg0) -> [u8 0x5d; write_multiname arg0] +| `CallProperty (arg0,arg1) -> [u8 0x46; write_multiname arg0;write_u30 arg1] +| `CallPropLex (arg0,arg1) -> [u8 0x4c; write_multiname arg0;write_u30 arg1] +| `Call (arg0) -> [u8 0x41; write_u30 arg0] +| `Pop -> [u8 0x29; ] +| `Swap -> [u8 0x2b; ] +| `PopScope -> [u8 0x1d; ] +| `NewObject (arg0) -> [u8 0x55; write_u30 arg0] +| `NewArray (arg0) -> [u8 0x56; write_u30 arg0] +| `NewActivation -> [u8 0x57; ] +| `Dup -> [u8 0x2a; ] +| `ConstructSuper (arg0) -> [u8 0x49; write_u30 arg0] +| `ConstructProp (arg0,arg1) -> [u8 0x4a; write_multiname arg0;write_u30 arg1] +# 12 "instruction.mlp" 2 diff --git a/swflib/instruction.mlp b/swflib/instruction.mlp index c81718e..014c67c 100644 --- a/swflib/instruction.mlp +++ b/swflib/instruction.mlp @@ -1,66 +1,11 @@ open Base open Bytes -open ISpec - -type label = Label.t -type u8 = int -type u30 = int -type uint = int -type namespace = Cpool.namespace +#include "write_type.h" type t = [ -#include "opcode.h" +#include "type.h" ] -and class_ = t ISpec.class_ -and method_ = t ISpec.method_ - - -let default : t ISpec.t = { - op=0; - args=const []; - prefix=const []; - const=[]; - method_ = None; - class_ = None; - stack=0; - scope=0; - count=0; -} - -let cindex entry ctx = - u30 (Cpool.index entry ctx#cpool) - -let entry name = - (name :> Cpool.entry) - -#define EMBED_TYPE(PARSE,CONST,X) \ -let PARSE _ctx _x = \ - X \ -let CONST _ = \ - None -#define CPOOL_TYPE(PARSE,CONST,FIELD) \ -let PARSE ctx x = \ - cindex (`FIELD x) ctx \ -let CONST x = \ - Some (`FIELD x) - -EMBED_TYPE(p_method_,c_method_,u30 @@ RevList.index _x _ctx#methods) -EMBED_TYPE(p_class_ ,c_class_ ,u30 @@ RevList.index _x _ctx#classes) -EMBED_TYPE(p_u8,c_u8,u8 _x) -EMBED_TYPE(p_u30,c_u30,u30 _x) -EMBED_TYPE(p_label,c_label,label_ref _x) - -CPOOL_TYPE(p_string,c_string,String) -CPOOL_TYPE(p_int,c_int,Int) -CPOOL_TYPE(p_uint,c_uint,UInt) -CPOOL_TYPE(p_float,c_float,Double) -CPOOL_TYPE(p_namespace,c_namespace,Namespace) - -let f _x = () - -let spec = +let to_bytes = function -#include "match_body.h" - - +#include "write.h" diff --git a/swflib/instruction.txt b/swflib/instruction.txt index d93c9d8..ade7a7b 100644 --- a/swflib/instruction.txt +++ b/swflib/instruction.txt @@ -49,66 +49,64 @@ IfStrictEq of label(0x19) -> stack= ~-1 IfStrictNe of label(0x1a) -> stack= ~-1 # Literal -PushNull(0x20) -> stack=1 -PushUndefined(0x21) -> stack=1 -PushByte of u8(0x24) -> stack=1 -PushShort of u30(0x25) -> stack=1 -PushTrue(0x26) -> stack=1 -PushFalse(0x27) -> stack=1 -PushNaN(0x28) -> stack=1 -PushString of string(0x2C) -> stack=1 -PushInt of int(0x2D) -> stack=1 -PushUInt of uint(0x2E) -> stack=1 -PushDouble of float(0x2F) -> stack=1 +PushNull(0x20) -> stack=1 +PushUndefined(0x21) -> stack=1 +PushByte of u8(0x24) -> stack=1 +PushShort of u30(0x25) -> stack=1 +PushTrue(0x26) -> stack=1 +PushFalse(0x27) -> stack=1 +PushNaN(0x28) -> stack=1 +PushString of c_string(0x2C) -> stack=1 +PushInt of c_int(0x2D) -> stack=1 +PushUInt of c_uint(0x2E) -> stack=1 +PushDouble of c_float(0x2F) -> stack=1 PushNamespace of namespace(0x31) -> stack=1 -# # Scope -# PushScope: op=0x30; stack= ~-1; scope=1 -# PushWith: op=0x1c; stack= ~-1; scope=1 -# GetGlobalScope:op=0x64; stack=1 -# GetScopeObject of int:op=0x65; stack=1; args=const[u8 arg0] - -# # Register -# GetLocal_0(0xD0; stack=1;count=1 -# GetLocal_1(0xD1; stack=1;count=2 -# GetLocal_2(0xD2; stack=1;count=3 -# GetLocal_3(0xD3; stack=1;count=4 -# GetLocal of int(0x62; stack=1; args=const [u30 arg0];count=(arg0+1) -# SetLocal_0(0xD4; stack=1 -# SetLocal_1(0xD5; stack=1 -# SetLocal_2(0xD6; stack=1 -# SetLocal_3(0xD7; stack=1 -# SetLocal of int(0x63; stack=1; args=const [u30 arg0] - -# GetSlot of int(0x6c; args=const [u30 arg0] -# SetSlot of int(0x6d; args=const [u30 arg0]; stack= ~-2 -# GetGlobalSlot of int(0x6e; stack=1; args=const [u30 arg0] -# SetGlobalSlot of int(0x6f; stack= ~-1; args=const [u30 arg0] - -# GetLex of Cpool.multiname(0x60; stack=1; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx] -# GetProperty of Cpool.multiname(0x66; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx] -# SetProperty of Cpool.multiname(0x61; stack= ~-2; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx] -# InitProperty of Cpool.multiname(0x68; stack= ~-2; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx] - -# # FunctionCall -# ReturnVoid: op=0x47 -# ReturnValue(0x48; stack= ~-1 -# FindPropStrict of Cpool.multiname(0x5D; stack=1; const=[entry arg0]; args=fun ctx -> [cindex arg0 ctx] -# CallProperty of Cpool.multiname * int(0x46; stack= 1-arg1; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx; u30 arg1] -# CallPropLex of Cpool.multiname * int(0x4c; stack= 1-arg1; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx; u30 arg1] -# Call of int(0x41; stack= 1-(2+arg0); args=const [u30 arg0]; -# Pop(0x29; stack= ~-1 -# Swap:op=0x2b -# PopScope:op=0x1d; scope= ~-1 - -# NewObject of int:op=0x55; args=const [u30 arg0]; stack=1-arg0 -# NewArray of int:op=0x56; args=const [u30 arg0] -# NewActivation:op=0x57; stack=1 - - -# Dup(0x2a; stack= 2 - -# # Class - -# ConstructSuper of int(0x49; args=const [u30 arg0]; stack= ~-(arg0+1) -# ConstructProp of Cpool.multiname*int(0x4a; stack= ~-arg1; args=(fun ctx -> [u30 @@ Cpool.index arg0 ctx#cpool;u30 arg1]); +# Scope +PushScope(0x30) -> stack= ~-1; scope=1 +PushWith(0x1c) -> stack= ~-1; scope=1 +GetGlobalScope(0x64) -> stack=1 +GetScopeObject of u8(0x65) -> stack=1 + +# Register +GetLocal_0(0xD0) -> stack=1;count=1 +GetLocal_1(0xD1) -> stack=1;count=2 +GetLocal_2(0xD2) -> stack=1;count=3 +GetLocal_3(0xD3) -> stack=1;count=4 +GetLocal of u30(0x62) -> stack=1;count=(arg0+1) +SetLocal_0(0xD4) -> stack=1 +SetLocal_1(0xD5) -> stack=1 +SetLocal_2(0xD6) -> stack=1 +SetLocal_3(0xD7) -> stack=1 +SetLocal of u30(0x63) -> stack=1 + +# Slot +GetSlot of u30(0x6c) +SetSlot of u30(0x6d) ->stack= ~-2 +GetGlobalSlot of u30(0x6e) -> stack=1 +SetGlobalSlot of u30(0x6f) -> stack= ~-1 + +GetLex of multiname(0x60) -> stack=1 +GetProperty of multiname(0x66) +SetProperty of multiname(0x61) -> stack= ~-2 +InitProperty of multiname(0x68) -> stack= ~-2 + +# FunctionCall +ReturnVoid(0x47) +ReturnValue(0x48) -> stack= ~-1 +FindPropStrict of multiname(0x5D) -> stack=1 +CallProperty of multiname * u30(0x46) -> stack= 1-arg1 +CallPropLex of multiname * u30(0x4c) -> stack= 1-arg1 +Call of u30(0x41) -> stack= 1-(2+arg0) +Pop(0x29) -> stack= ~-1 +Swap(0x2b) +PopScope(0x1d) -> scope= ~-1 + +NewObject of u30(0x55) -> stack=1-arg0 +NewArray of u30(0x56) +NewActivation(0x57) -> stack=1 +Dup(0x2a) -> stack= 2 + +# Class +ConstructSuper of u30(0x49) -> stack= ~-(arg0+1) +ConstructProp of multiname*u30(0x4a) -> stack= ~-arg1 diff --git a/swflib/match_body.h b/swflib/match_body.h new file mode 100644 index 0000000..c496068 --- /dev/null +++ b/swflib/match_body.h @@ -0,0 +1,89 @@ +| `NewFunction (arg0) -> { {default with op=0x40; args=(fun _ctx -> [p_method_ _ctx arg0]); const=filter_map id [c_method_ arg0]} with stack=1; method_=Some arg0} +| `NewClass (arg0) -> {default with op=0x58; args=(fun _ctx -> [p_class_ _ctx arg0]); const=filter_map id [c_class_ arg0]} +| `Coerce -> {default with op=0x80; args=(fun _ctx -> []); const=filter_map id []} +| `Coerce_a -> {default with op=0x82; args=(fun _ctx -> []); const=filter_map id []} +| `Coerce_s -> {default with op=0x85; args=(fun _ctx -> []); const=filter_map id []} +| `Convert_i -> {default with op=0x73; args=(fun _ctx -> []); const=filter_map id []} +| `Convert_s -> {default with op=0x74; args=(fun _ctx -> []); const=filter_map id []} +| `Convert_d -> {default with op=0x75; args=(fun _ctx -> []); const=filter_map id []} +| `Convert_b -> {default with op=0x76; args=(fun _ctx -> []); const=filter_map id []} +| `Convert_u -> {default with op=0x77; args=(fun _ctx -> []); const=filter_map id []} +| `Add_i -> { {default with op=0xc5; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `Subtract_i -> { {default with op=0xc6; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `Multiply_i -> { {default with op=0xc7; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `Add -> { {default with op=0xa0; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `Subtract -> { {default with op=0xa1; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `Multiply -> { {default with op=0xa2; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `Divide -> { {default with op=0xa3; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `Modulo -> { {default with op=0xa4; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `Equals -> { {default with op=0xab; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `StrictEquals -> { {default with op=0xac; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `LessThan -> { {default with op=0xad; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `LessEquals -> { {default with op=0xae; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `GreaterThan -> { {default with op=0xaf; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `GreaterEquals -> { {default with op=0xb0; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `Label (arg0) -> { {default with op=0x9; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with prefix=const [label arg0];args=const []} +| `IfNlt (arg0) -> { {default with op=0xc; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfNle (arg0) -> { {default with op=0xd; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfNgt (arg0) -> { {default with op=0xe; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfNge (arg0) -> { {default with op=0xf; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `Jump (arg0) -> {default with op=0x10; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} +| `IfTrue (arg0) -> { {default with op=0x11; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfFalse (arg0) -> { {default with op=0x12; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfEq (arg0) -> { {default with op=0x13; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfNe (arg0) -> { {default with op=0x14; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfLt (arg0) -> { {default with op=0x15; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfLe (arg0) -> { {default with op=0x16; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfGt (arg0) -> { {default with op=0x17; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfGe (arg0) -> { {default with op=0x18; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfStrictEq (arg0) -> { {default with op=0x19; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `IfStrictNe (arg0) -> { {default with op=0x1a; args=(fun _ctx -> [p_label _ctx arg0]); const=filter_map id [c_label arg0]} with stack= ~-1} +| `PushNull -> { {default with op=0x20; args=(fun _ctx -> []); const=filter_map id []} with stack=1} +| `PushUndefined -> { {default with op=0x21; args=(fun _ctx -> []); const=filter_map id []} with stack=1} +| `PushByte (arg0) -> { {default with op=0x24; args=(fun _ctx -> [p_u8 _ctx arg0]); const=filter_map id [c_u8 arg0]} with stack=1} +| `PushShort (arg0) -> { {default with op=0x25; args=(fun _ctx -> [p_u30 _ctx arg0]); const=filter_map id [c_u30 arg0]} with stack=1} +| `PushTrue -> { {default with op=0x26; args=(fun _ctx -> []); const=filter_map id []} with stack=1} +| `PushFalse -> { {default with op=0x27; args=(fun _ctx -> []); const=filter_map id []} with stack=1} +| `PushNaN -> { {default with op=0x28; args=(fun _ctx -> []); const=filter_map id []} with stack=1} +| `PushString (arg0) -> { {default with op=0x2c; args=(fun _ctx -> [p_string _ctx arg0]); const=filter_map id [c_string arg0]} with stack=1} +| `PushInt (arg0) -> { {default with op=0x2d; args=(fun _ctx -> [p_int _ctx arg0]); const=filter_map id [c_int arg0]} with stack=1} +| `PushUInt (arg0) -> { {default with op=0x2e; args=(fun _ctx -> [p_uint _ctx arg0]); const=filter_map id [c_uint arg0]} with stack=1} +| `PushDouble (arg0) -> { {default with op=0x2f; args=(fun _ctx -> [p_float _ctx arg0]); const=filter_map id [c_float arg0]} with stack=1} +| `PushNamespace (arg0) -> { {default with op=0x31; args=(fun _ctx -> [p_namespace _ctx arg0]); const=filter_map id [c_namespace arg0]} with stack=1} +| `PushScope -> { {default with op=0x30; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1; scope=1} +| `PushWith -> { {default with op=0x1c; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1; scope=1} +| `GetGlobalScope -> { {default with op=0x64; args=(fun _ctx -> []); const=filter_map id []} with stack=1} +| `GetScopeObject (arg0) -> { {default with op=0x65; args=(fun _ctx -> [p_u8 _ctx arg0]); const=filter_map id [c_u8 arg0]} with stack=1} +| `GetLocal_0 -> { {default with op=0xd0; args=(fun _ctx -> []); const=filter_map id []} with stack=1;count=1} +| `GetLocal_1 -> { {default with op=0xd1; args=(fun _ctx -> []); const=filter_map id []} with stack=1;count=2} +| `GetLocal_2 -> { {default with op=0xd2; args=(fun _ctx -> []); const=filter_map id []} with stack=1;count=3} +| `GetLocal_3 -> { {default with op=0xd3; args=(fun _ctx -> []); const=filter_map id []} with stack=1;count=4} +| `GetLocal (arg0) -> { {default with op=0x62; args=(fun _ctx -> [p_u30 _ctx arg0]); const=filter_map id [c_u30 arg0]} with stack=1;count=(arg0+1)} +| `SetLocal_0 -> { {default with op=0xd4; args=(fun _ctx -> []); const=filter_map id []} with stack=1} +| `SetLocal_1 -> { {default with op=0xd5; args=(fun _ctx -> []); const=filter_map id []} with stack=1} +| `SetLocal_2 -> { {default with op=0xd6; args=(fun _ctx -> []); const=filter_map id []} with stack=1} +| `SetLocal_3 -> { {default with op=0xd7; args=(fun _ctx -> []); const=filter_map id []} with stack=1} +| `SetLocal (arg0) -> { {default with op=0x63; args=(fun _ctx -> [p_u30 _ctx arg0]); const=filter_map id [c_u30 arg0]} with stack=1} +| `GetSlot (arg0) -> {default with op=0x6c; args=(fun _ctx -> [p_u30 _ctx arg0]); const=filter_map id [c_u30 arg0]} +| `SetSlot (arg0) -> { {default with op=0x6d; args=(fun _ctx -> [p_u30 _ctx arg0]); const=filter_map id [c_u30 arg0]} with stack= ~-2} +| `GetGlobalSlot (arg0) -> { {default with op=0x6e; args=(fun _ctx -> [p_u30 _ctx arg0]); const=filter_map id [c_u30 arg0]} with stack=1} +| `SetGlobalSlot (arg0) -> { {default with op=0x6f; args=(fun _ctx -> [p_u30 _ctx arg0]); const=filter_map id [c_u30 arg0]} with stack= ~-1} +| `GetLex (arg0) -> { {default with op=0x60; args=(fun _ctx -> [p_multiname _ctx arg0]); const=filter_map id [c_multiname arg0]} with stack=1} +| `GetProperty (arg0) -> {default with op=0x66; args=(fun _ctx -> [p_multiname _ctx arg0]); const=filter_map id [c_multiname arg0]} +| `SetProperty (arg0) -> { {default with op=0x61; args=(fun _ctx -> [p_multiname _ctx arg0]); const=filter_map id [c_multiname arg0]} with stack= ~-2} +| `InitProperty (arg0) -> { {default with op=0x68; args=(fun _ctx -> [p_multiname _ctx arg0]); const=filter_map id [c_multiname arg0]} with stack= ~-2} +| `ReturnVoid -> {default with op=0x47; args=(fun _ctx -> []); const=filter_map id []} +| `ReturnValue -> { {default with op=0x48; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `FindPropStrict (arg0) -> { {default with op=0x5d; args=(fun _ctx -> [p_multiname _ctx arg0]); const=filter_map id [c_multiname arg0]} with stack=1} +| `CallProperty (arg0,arg1) -> { {default with op=0x46; args=(fun _ctx -> [p_multiname _ctx arg0;p_u30 _ctx arg1]); const=filter_map id [c_multiname arg0;c_u30 arg1]} with stack= 1-arg1} +| `CallPropLex (arg0,arg1) -> { {default with op=0x4c; args=(fun _ctx -> [p_multiname _ctx arg0;p_u30 _ctx arg1]); const=filter_map id [c_multiname arg0;c_u30 arg1]} with stack= 1-arg1} +| `Call (arg0) -> { {default with op=0x41; args=(fun _ctx -> [p_u30 _ctx arg0]); const=filter_map id [c_u30 arg0]} with stack= 1-(2+arg0)} +| `Pop -> { {default with op=0x29; args=(fun _ctx -> []); const=filter_map id []} with stack= ~-1} +| `Swap -> {default with op=0x2b; args=(fun _ctx -> []); const=filter_map id []} +| `PopScope -> { {default with op=0x1d; args=(fun _ctx -> []); const=filter_map id []} with scope= ~-1} +| `NewObject (arg0) -> { {default with op=0x55; args=(fun _ctx -> [p_u30 _ctx arg0]); const=filter_map id [c_u30 arg0]} with stack=1-arg0} +| `NewArray (arg0) -> {default with op=0x56; args=(fun _ctx -> [p_u30 _ctx arg0]); const=filter_map id [c_u30 arg0]} +| `NewActivation -> { {default with op=0x57; args=(fun _ctx -> []); const=filter_map id []} with stack=1} +| `Dup -> { {default with op=0x2a; args=(fun _ctx -> []); const=filter_map id []} with stack= 2} +| `ConstructSuper (arg0) -> { {default with op=0x49; args=(fun _ctx -> [p_u30 _ctx arg0]); const=filter_map id [c_u30 arg0]} with stack= ~-(arg0+1)} +| `ConstructProp (arg0,arg1) -> { {default with op=0x4a; args=(fun _ctx -> [p_multiname _ctx arg0;p_u30 _ctx arg1]); const=filter_map id [c_multiname arg0;c_u30 arg1]} with stack= ~-arg1} diff --git a/swflib/opcode.h b/swflib/opcode.h new file mode 100644 index 0000000..2ea5609 --- /dev/null +++ b/swflib/opcode.h @@ -0,0 +1,89 @@ +| `NewFunction of method_ +| `NewClass of class_ +| `Coerce +| `Coerce_a +| `Coerce_s +| `Convert_i +| `Convert_s +| `Convert_d +| `Convert_b +| `Convert_u +| `Add_i +| `Subtract_i +| `Multiply_i +| `Add +| `Subtract +| `Multiply +| `Divide +| `Modulo +| `Equals +| `StrictEquals +| `LessThan +| `LessEquals +| `GreaterThan +| `GreaterEquals +| `Label of label +| `IfNlt of label +| `IfNle of label +| `IfNgt of label +| `IfNge of label +| `Jump of label +| `IfTrue of label +| `IfFalse of label +| `IfEq of label +| `IfNe of label +| `IfLt of label +| `IfLe of label +| `IfGt of label +| `IfGe of label +| `IfStrictEq of label +| `IfStrictNe of label +| `PushNull +| `PushUndefined +| `PushByte of u8 +| `PushShort of u30 +| `PushTrue +| `PushFalse +| `PushNaN +| `PushString of string +| `PushInt of int +| `PushUInt of uint +| `PushDouble of float +| `PushNamespace of namespace +| `PushScope +| `PushWith +| `GetGlobalScope +| `GetScopeObject of u8 +| `GetLocal_0 +| `GetLocal_1 +| `GetLocal_2 +| `GetLocal_3 +| `GetLocal of u30 +| `SetLocal_0 +| `SetLocal_1 +| `SetLocal_2 +| `SetLocal_3 +| `SetLocal of u30 +| `GetSlot of u30 +| `SetSlot of u30 +| `GetGlobalSlot of u30 +| `SetGlobalSlot of u30 +| `GetLex of multiname +| `GetProperty of multiname +| `SetProperty of multiname +| `InitProperty of multiname +| `ReturnVoid +| `ReturnValue +| `FindPropStrict of multiname +| `CallProperty of multiname*u30 +| `CallPropLex of multiname*u30 +| `Call of u30 +| `Pop +| `Swap +| `PopScope +| `NewObject of u30 +| `NewArray of u30 +| `NewActivation +| `Dup +| `ConstructSuper of u30 +| `ConstructProp of multiname*u30 diff --git a/swflib/type.h b/swflib/type.h new file mode 100644 index 0000000..db9469f --- /dev/null +++ b/swflib/type.h @@ -0,0 +1,89 @@ +| `NewFunction of method_ +| `NewClass of class_ +| `Coerce +| `Coerce_a +| `Coerce_s +| `Convert_i +| `Convert_s +| `Convert_d +| `Convert_b +| `Convert_u +| `Add_i +| `Subtract_i +| `Multiply_i +| `Add +| `Subtract +| `Multiply +| `Divide +| `Modulo +| `Equals +| `StrictEquals +| `LessThan +| `LessEquals +| `GreaterThan +| `GreaterEquals +| `Label of label +| `IfNlt of label +| `IfNle of label +| `IfNgt of label +| `IfNge of label +| `Jump of label +| `IfTrue of label +| `IfFalse of label +| `IfEq of label +| `IfNe of label +| `IfLt of label +| `IfLe of label +| `IfGt of label +| `IfGe of label +| `IfStrictEq of label +| `IfStrictNe of label +| `PushNull +| `PushUndefined +| `PushByte of u8 +| `PushShort of u30 +| `PushTrue +| `PushFalse +| `PushNaN +| `PushString of c_string +| `PushInt of c_int +| `PushUInt of c_uint +| `PushDouble of c_float +| `PushNamespace of namespace +| `PushScope +| `PushWith +| `GetGlobalScope +| `GetScopeObject of u8 +| `GetLocal_0 +| `GetLocal_1 +| `GetLocal_2 +| `GetLocal_3 +| `GetLocal of u30 +| `SetLocal_0 +| `SetLocal_1 +| `SetLocal_2 +| `SetLocal_3 +| `SetLocal of u30 +| `GetSlot of u30 +| `SetSlot of u30 +| `GetGlobalSlot of u30 +| `SetGlobalSlot of u30 +| `GetLex of multiname +| `GetProperty of multiname +| `SetProperty of multiname +| `InitProperty of multiname +| `ReturnVoid +| `ReturnValue +| `FindPropStrict of multiname +| `CallProperty of multiname*u30 +| `CallPropLex of multiname*u30 +| `Call of u30 +| `Pop +| `Swap +| `PopScope +| `NewObject of u30 +| `NewArray of u30 +| `NewActivation +| `Dup +| `ConstructSuper of u30 +| `ConstructProp of multiname*u30 diff --git a/swflib/typemap.h b/swflib/typemap.h new file mode 100644 index 0000000..c91aeaf --- /dev/null +++ b/swflib/typemap.h @@ -0,0 +1,28 @@ +type label = Label.t +let p_label _ctx _x = label_ref _x +let c_label _ = None +type u8 = int +let p_u8 _ctx _x = u8 _x +let c_u8 _ = None +type u30 = int +let p_u30 _ctx _x = u30 _x +let c_u30 _ = None +let p_method_ _ctx _x = u30 @@ RevList.index _x _ctx#methods +let c_method_ _ = None +let p_class_ _ctx _x = u30 @@ RevList.index _x _ctx#classes +let c_class_ _ = None +type uint = int +let p_uint _ctx _x = u30 @@ Cpool.index (`UInt _x) _ctx#cpool +let c_uint _x = Some(`UInt _x) +type namespace = Cpool.namespace +let p_namespace _ctx _x = u30 @@ Cpool.index (`Namespace _x) _ctx#cpool +let c_namespace _x = Some(`Namespace _x) +type multiname = Cpool.multiname +let p_multiname _ctx _x = u30 @@ Cpool.index (`Multiname _x) _ctx#cpool +let c_multiname _x = Some(`Multiname _x) +let p_string _ctx _x = u30 @@ Cpool.index (`String _x) _ctx#cpool +let c_string _x = Some(`String _x) +let p_int _ctx _x = u30 @@ Cpool.index (`Int _x) _ctx#cpool +let c_int _x = Some(`Int _x) +let p_float _ctx _x = u30 @@ Cpool.index (`Double _x) _ctx#cpool +let c_float _x = Some(`Double _x) diff --git a/swflib/write.h b/swflib/write.h new file mode 100644 index 0000000..cd81ffb --- /dev/null +++ b/swflib/write.h @@ -0,0 +1,89 @@ +| `NewFunction (arg0) -> [u8 0x40; write_method_ arg0] +| `NewClass (arg0) -> [u8 0x58; write_class_ arg0] +| `Coerce -> [u8 0x80; ] +| `Coerce_a -> [u8 0x82; ] +| `Coerce_s -> [u8 0x85; ] +| `Convert_i -> [u8 0x73; ] +| `Convert_s -> [u8 0x74; ] +| `Convert_d -> [u8 0x75; ] +| `Convert_b -> [u8 0x76; ] +| `Convert_u -> [u8 0x77; ] +| `Add_i -> [u8 0xc5; ] +| `Subtract_i -> [u8 0xc6; ] +| `Multiply_i -> [u8 0xc7; ] +| `Add -> [u8 0xa0; ] +| `Subtract -> [u8 0xa1; ] +| `Multiply -> [u8 0xa2; ] +| `Divide -> [u8 0xa3; ] +| `Modulo -> [u8 0xa4; ] +| `Equals -> [u8 0xab; ] +| `StrictEquals -> [u8 0xac; ] +| `LessThan -> [u8 0xad; ] +| `LessEquals -> [u8 0xae; ] +| `GreaterThan -> [u8 0xaf; ] +| `GreaterEquals -> [u8 0xb0; ] +| `Label (arg0) -> [u8 0x9; write_label arg0] +| `IfNlt (arg0) -> [u8 0xc; write_label arg0] +| `IfNle (arg0) -> [u8 0xd; write_label arg0] +| `IfNgt (arg0) -> [u8 0xe; write_label arg0] +| `IfNge (arg0) -> [u8 0xf; write_label arg0] +| `Jump (arg0) -> [u8 0x10; write_label arg0] +| `IfTrue (arg0) -> [u8 0x11; write_label arg0] +| `IfFalse (arg0) -> [u8 0x12; write_label arg0] +| `IfEq (arg0) -> [u8 0x13; write_label arg0] +| `IfNe (arg0) -> [u8 0x14; write_label arg0] +| `IfLt (arg0) -> [u8 0x15; write_label arg0] +| `IfLe (arg0) -> [u8 0x16; write_label arg0] +| `IfGt (arg0) -> [u8 0x17; write_label arg0] +| `IfGe (arg0) -> [u8 0x18; write_label arg0] +| `IfStrictEq (arg0) -> [u8 0x19; write_label arg0] +| `IfStrictNe (arg0) -> [u8 0x1a; write_label arg0] +| `PushNull -> [u8 0x20; ] +| `PushUndefined -> [u8 0x21; ] +| `PushByte (arg0) -> [u8 0x24; write_u8 arg0] +| `PushShort (arg0) -> [u8 0x25; write_u30 arg0] +| `PushTrue -> [u8 0x26; ] +| `PushFalse -> [u8 0x27; ] +| `PushNaN -> [u8 0x28; ] +| `PushString (arg0) -> [u8 0x2c; write_c_string arg0] +| `PushInt (arg0) -> [u8 0x2d; write_c_int arg0] +| `PushUInt (arg0) -> [u8 0x2e; write_c_uint arg0] +| `PushDouble (arg0) -> [u8 0x2f; write_c_float arg0] +| `PushNamespace (arg0) -> [u8 0x31; write_namespace arg0] +| `PushScope -> [u8 0x30; ] +| `PushWith -> [u8 0x1c; ] +| `GetGlobalScope -> [u8 0x64; ] +| `GetScopeObject (arg0) -> [u8 0x65; write_u8 arg0] +| `GetLocal_0 -> [u8 0xd0; ] +| `GetLocal_1 -> [u8 0xd1; ] +| `GetLocal_2 -> [u8 0xd2; ] +| `GetLocal_3 -> [u8 0xd3; ] +| `GetLocal (arg0) -> [u8 0x62; write_u30 arg0] +| `SetLocal_0 -> [u8 0xd4; ] +| `SetLocal_1 -> [u8 0xd5; ] +| `SetLocal_2 -> [u8 0xd6; ] +| `SetLocal_3 -> [u8 0xd7; ] +| `SetLocal (arg0) -> [u8 0x63; write_u30 arg0] +| `GetSlot (arg0) -> [u8 0x6c; write_u30 arg0] +| `SetSlot (arg0) -> [u8 0x6d; write_u30 arg0] +| `GetGlobalSlot (arg0) -> [u8 0x6e; write_u30 arg0] +| `SetGlobalSlot (arg0) -> [u8 0x6f; write_u30 arg0] +| `GetLex (arg0) -> [u8 0x60; write_multiname arg0] +| `GetProperty (arg0) -> [u8 0x66; write_multiname arg0] +| `SetProperty (arg0) -> [u8 0x61; write_multiname arg0] +| `InitProperty (arg0) -> [u8 0x68; write_multiname arg0] +| `ReturnVoid -> [u8 0x47; ] +| `ReturnValue -> [u8 0x48; ] +| `FindPropStrict (arg0) -> [u8 0x5d; write_multiname arg0] +| `CallProperty (arg0,arg1) -> [u8 0x46; write_multiname arg0;write_u30 arg1] +| `CallPropLex (arg0,arg1) -> [u8 0x4c; write_multiname arg0;write_u30 arg1] +| `Call (arg0) -> [u8 0x41; write_u30 arg0] +| `Pop -> [u8 0x29; ] +| `Swap -> [u8 0x2b; ] +| `PopScope -> [u8 0x1d; ] +| `NewObject (arg0) -> [u8 0x55; write_u30 arg0] +| `NewArray (arg0) -> [u8 0x56; write_u30 arg0] +| `NewActivation -> [u8 0x57; ] +| `Dup -> [u8 0x2a; ] +| `ConstructSuper (arg0) -> [u8 0x49; write_u30 arg0] +| `ConstructProp (arg0,arg1) -> [u8 0x4a; write_multiname arg0;write_u30 arg1] diff --git a/swflib/write_type.h b/swflib/write_type.h new file mode 100644 index 0000000..ab91c34 --- /dev/null +++ b/swflib/write_type.h @@ -0,0 +1,24 @@ +type method_ = int +let write_method_= u30 +type class_ = int +let write_class_= u30 +type c_int = int +let write_c_int= u30 +type c_uint = int +let write_c_uint= u30 +type c_string = int +let write_c_string= u30 +type c_float = int +let write_c_float= u30 +type namespace = int +let write_namespace= u30 +type multiname = int +let write_multiname= u30 +type u30 = int +let write_u30= u30 +type u8 = int +let write_u8= u8 +type label = (Label.t,int) either +let write_label= function + Left label -> label_ref label + | Right address -> s24 address diff --git a/swflib/writer.h b/swflib/writer.h new file mode 100644 index 0000000..ab91c34 --- /dev/null +++ b/swflib/writer.h @@ -0,0 +1,24 @@ +type method_ = int +let write_method_= u30 +type class_ = int +let write_class_= u30 +type c_int = int +let write_c_int= u30 +type c_uint = int +let write_c_uint= u30 +type c_string = int +let write_c_string= u30 +type c_float = int +let write_c_float= u30 +type namespace = int +let write_namespace= u30 +type multiname = int +let write_multiname= u30 +type u30 = int +let write_u30= u30 +type u8 = int +let write_u8= u8 +type label = (Label.t,int) either +let write_label= function + Left label -> label_ref label + | Right address -> s24 address -- 2.11.0