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]"
-
# build
OCAMLPACKS[] =
extlib
FILES[] =
bytes
label
- abc
- cpool
- revList
instruction
- iSpec
+ abcType
asm
+ abc
UseCamlp4(pa_openin pa_oo)
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)
# 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)
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
-(**
- ABC(Action Script Bytecode) format.
-
- Provide the type of ABC and encoding function.
-
- @author mzp
- @see <http://www.adobe.com/devnet/actionscript/articles/avm2overview.pdf> AVM2 Overview(pdf) 4.2 abcFile - 4.10 Script
-*)
+open Base
+open Bytes
type namespace = {
kind:int; namespace_name:int
| 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 =
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
--- /dev/null
+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
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
+++ /dev/null
-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
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)
]
--- /dev/null
+gen_typemap.opt
\ No newline at end of file
--- /dev/null
+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
--- /dev/null
+(* CAUTION: this is a generated file. If you edit it, all changes will be lost! *)
+# 1 "inst.mlp"
+# 1 "<built-in>"
+# 1 "<command line>"
+# 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
+]
--- /dev/null
+open Base
+
+type t = [
+#include "type.h"
+]
--- /dev/null
+(* CAUTION: this is a generated file. If you edit it, all changes will be lost! *)
+# 1 "instruction.mlp"
+# 1 "<built-in>"
+# 1 "<command line>"
+# 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
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"
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
--- /dev/null
+| `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}
--- /dev/null
+| `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
--- /dev/null
+| `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
--- /dev/null
+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)
--- /dev/null
+| `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]
--- /dev/null
+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
--- /dev/null
+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
OSDN Git Service
