+open Base
open Str
+open Printf
+(* util *)
+let rec filter_map f =
+ function
+ x::xs ->
+ begin match f x with
+ Some y -> y::filter_map f xs
+ | None -> filter_map f xs
+ end
+ | [] ->
+ []
+
+(* type *)
type decl = {
- name:string;
- args:string list;
- body:string
+ name : string;
+ opcode : int;
+ args : string list;
+ extra : string
}
-let mapi f xs =
- let rec sub f n =
- function
- [] -> []
- | x::xs -> (f n x)::sub f (n+1) xs in
- sub f 0 xs
-
-(* parsing *)
-let parse s =
- if string_match (regexp "^#\\|^$") s 0 then
- None
- else
- match bounded_split (regexp " *: *") s 2 with
- [decl;body] ->
- begin match bounded_split (regexp " *of *") decl 2 with
- [name] -> Some {name=name;args=[]; body=body}
- | [name;args] -> Some {name=name;args=split (regexp " *\\* *") args; body=body}
- | _ -> failwith ("invalid decl format:"^decl)
- end
- | _ ->
- failwith ("invalid file format: "^s)
-
(*
- output type decl
-
- Example:
- | `PushInt of int
- | `Pop
- ...
-*)
-let type_of_decl {name=name;args=args} =
- if args = [] then
- Printf.sprintf "| `%s" name
- else
- Printf.sprintf "| `%s of %s" name (String.concat "*" args)
-
-let output_types decls =
- print_endline (String.concat "\n" (List.map type_of_decl decls))
-
-(*
- output match clause
+ Parsing
Example:
- let get_config = function
- | `Dup -> {default with op=0x2a; stack= 2}
- | `NewActivation -> {default with op=0x57; stack=1}
- | `NewArray (arg0) -> {default with op=0x56; args=const [Bytes.u30 arg0]}
- ...
-*)
-let clause_of_decl {name=name;args=args;body=body} =
- let args' =
- if args = [] then
- ""
- else
- Printf.sprintf "(%s)" (String.concat "," (mapi (fun n _ -> Printf.sprintf "arg%d" n) args)) in
- Printf.sprintf "| `%s %s -> {default with %s}" name args' body
-
-let output_match decls =
- let func =
- (String.concat "\n" (List.map clause_of_decl decls)) in
- Printf.printf "function%s\n" func
-
-(* output string function
-let string_of_instruction = function
- | Dup -> "Dup(" ^ ")"
- | NewActivation -> "NewActivation(" ^ ")"
- | NewArray (arg0) -> "NewArray(" ^ (Std.dump arg0) ^ ")"
+ PushBytes of int(1F) : stack=1; scope=1
*)
-let clause_of_output {name=name;args=args} =
- let args' =
- if args = [] then
- ""
- else
- Printf.sprintf "(%s)" (String.concat "," (mapi (fun n _ -> Printf.sprintf "arg%d" n) args)) in
- let prefix =
- Printf.sprintf "| %s %s -> \"%s(\"" name args' name in
- let mid =
- mapi (fun i _ -> Printf.sprintf "(Std.dump arg%d)" i) args in
- let postfix =
- "\")\"" in
- String.concat " ^ " ([prefix]@mid@[postfix])
+let of_hex s =
+ Scanf.sscanf s "%x" id
-let output_string decls =
- let func =
- (String.concat "\n" (List.map clause_of_output decls)) in
- Printf.printf "let string_of_instruction = function%s\n" func
+let parse_entry entry =
+ let no_args =
+ regexp "\\([A-Z][_a-zA-Z0-9]*\\) *(0x\\([0-9A-F][0-9A-F]\\))" in
+ let args =
+ regexp "\\([A-Z][_a-zA-Z0-9]*\\) *of *\\([^(]*\\) *(0x\\([0-9A-F][0-9A-F]\\))" in
+ if string_match no_args entry 0 then
+ {
+ name = matched_group 1 entry;
+ args = [];
+ opcode = of_hex @@ matched_group 2 entry;
+ extra = ""
+ }
+ else if string_match args entry 0 then
+ let name,args,opcode =
+ (matched_group 1 entry,
+ matched_group 2 entry,
+ matched_group 3 entry) in
+ {
+ name = name;
+ args = split (regexp " *\\* *") args;
+ opcode = of_hex @@ opcode;
+ extra = ""
+ }
+ else
+ failwith ("Invalid entry: " ^ entry)
+let parse_line s =
+ if string_match (regexp "^#\\|^$") s 0 then
+ None
+ else
+ match bounded_split (regexp " *-> *") s 2 with
+ [entry; extra] ->
+ Some {parse_entry entry with
+ extra = extra}
+ | [entry] ->
+ Some (parse_entry entry)
+ | [] | _::_ ->
+ failwith ("Invalid format: " ^ s)
-let f _ =
+let parse ch =
let decls =
ref [] in
try
while true do
- match parse (read_line ()) with
+ match parse_line @@ input_line ch with
Some x ->
- decls := x::!decls
- | _ ->
+ decls := x :: !decls
+ | None ->
()
- done
+ done;
+ failwith "must not happen"
with End_of_file ->
- let decls' =
- !decls in
- match Sys.argv.(1) with
- "-t" ->
- output_types decls'
- | "-m" ->
- output_match decls'
- | "-s" ->
- output_string decls'
- | _ ->
- failwith "invalid option"
+ !decls
+let cmds = [
+ (* print types *)
+ ("-t",fun {name=name; args=args}->
+ if args = [] then
+ sprintf "| `%s" name
+ else
+ sprintf "| `%s of %s" name @@ String.concat "*" args)
+]
+
+
+let f _ =
+ let decls =
+ parse stdin in
+ let f =
+ List.assoc Sys.argv.(1) cmds in
+ decls
+ +> List.map f
+ +> List.iter print_endline
+
let _ = if not !Sys.interactive then
f ()
+
-NewFunction of method_: op=0x40; stack=1; method_=Some arg0; args=fun ctx->[u30 @@ RevList.index arg0 ctx#methods];
-NewClass of class_:op=0x58; class_=Some arg0; args=fun ctx -> [u30 @@ RevList.index arg0 ctx#classes];
+NewFunction of method_(0x40) -> stack=1; method_=Some arg0
+NewClass of class_(0x58)
# Conversion
-Coerce: op=0x80
-Coerce_a: op=0x82
-Coerce_s: op=0x85
-
-Convert_i: op=0x73
-Convert_s: op=0x74
-Convert_d: op=0x75
-Convert_b: op=0x76
-Convert_u: op=0x77
-
-# Arith
-Add_i: op=0xc5; stack= ~-1
-Subtract_i: op=0xc6; stack= ~-1
-Multiply_i: op=0xc7; stack= ~-1
-Add: op=0xa0; stack= ~-1
-Subtract: op=0xa1; stack= ~-1
-Multiply: op=0xa2; stack= ~-1
-Divide: op=0xa3; stack= ~-1
-Modulo: op=0xa4; stack= ~-1
-
-# Predicator
-Equals: op=0xab; stack= ~-1
-StrictEquals: op=0xac; stack= ~-1
-LessThan: op=0xad; stack= ~-1
-LessEquals: op=0xae; stack= ~-1
-GreaterThan: op=0xaf; stack= ~-1
-GreaterEquals: op=0xb0; stack= ~-1
-
-# Jump/Conditonal Jump
-Label of Label.t: op=0x09; prefix=const [label arg0]
-IfNlt of Label.t: op=0x0c; stack= ~-1; args=const [label_ref arg0]
-IfNle of Label.t: op=0x0d; stack= ~-1; args=const [label_ref arg0]
-IfNgt of Label.t: op=0x0e; stack= ~-1; args=const [label_ref arg0]
-IfNge of Label.t: op=0x0f; stack= ~-1; args=const [label_ref arg0]
-Jump of Label.t: op=0x10; args=const [label_ref arg0]
-IfTrue of Label.t: op=0x11; stack= ~-1; args=const [label_ref arg0]
-IfFalse of Label.t: op=0x12; stack= ~-1; args=const [label_ref arg0]
-IfEq of Label.t: op=0x13; stack= ~-1; args=const [label_ref arg0]
-IfNe of Label.t: op=0x14; stack= ~-1; args=const [label_ref arg0]
-IfLt of Label.t: op=0x15; stack= ~-1; args=const [label_ref arg0]
-IfLe of Label.t: op=0x16; stack= ~-1; args=const [label_ref arg0]
-IfGt of Label.t: op=0x17; stack= ~-1; args=const [label_ref arg0]
-IfGe of Label.t: op=0x18; stack= ~-1; args=const [label_ref arg0]
-IfStrictEq of Label.t: op=0x19; stack= ~-1; args=const [label_ref arg0]
-IfStrictNe of Label.t: op=0x1a; stack= ~-1; args=const [label_ref arg0]
-
-# Literal
-PushNull: op=0x20; stack=1
-PushUndefined: op=0x21; stack=1
-PushByte of int: op=0x24; stack=1; args=const [u8 arg0]
-PushShort of int: op=0x25; stack=1; args=const [u30 arg0]
-PushTrue: op=0x26; stack=1
-PushFalse: op=0x27; stack=1
-PushNaN: op=0x28; stack=1
-PushString of string: op=0x2C; stack=1; const=[`String arg0]; args=fun ctx -> [cindex (`String arg0) ctx]
-PushInt of int: op=0x2D; stack=1; const=[`Int arg0]; args=fun ctx -> [cindex (`Int arg0) ctx]
-PushUInt of int: op=0x2E; stack=1; const=[`UInt arg0]; args=fun ctx -> [cindex (`UInt arg0) ctx]
-PushDouble of float: op=0x2F; stack=1; const=[`Double arg0]; args=fun ctx -> [cindex (`Double arg0) ctx]
-PushNamespace of Cpool.namespace: op=0x31; stack=1; const=[entry arg0]; args=fun ctx -> [cindex arg0 ctx]
-
-# 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: op=0xD0; stack=1;count=1
-GetLocal_1: op=0xD1; stack=1;count=2
-GetLocal_2: op=0xD2; stack=1;count=3
-GetLocal_3: op=0xD3; stack=1;count=4
-GetLocal of int: op=0x62; stack=1; args=const [u30 arg0];count=(arg0+1)
-SetLocal_0: op=0xD4; stack=1
-SetLocal_1: op=0xD5; stack=1
-SetLocal_2: op=0xD6; stack=1
-SetLocal_3: op=0xD7; stack=1
-SetLocal of int: op=0x63; stack=1; args=const [u30 arg0]
-
-GetSlot of int: op=0x6c; args=const [u30 arg0]
-SetSlot of int: op=0x6d; args=const [u30 arg0]; stack= ~-2
-GetGlobalSlot of int: op=0x6e; stack=1; args=const [u30 arg0]
-SetGlobalSlot of int: op=0x6f; stack= ~-1; args=const [u30 arg0]
-
-GetLex of Cpool.multiname: op=0x60; stack=1; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx]
-GetProperty of Cpool.multiname: op=0x66; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx]
-SetProperty of Cpool.multiname: op=0x61; stack= ~-2; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx]
-InitProperty of Cpool.multiname: op=0x68; stack= ~-2; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx]
-
-# FunctionCall
-ReturnVoid: op=0x47
-ReturnValue: op=0x48; stack= ~-1
-FindPropStrict of Cpool.multiname: op=0x5D; stack=1; const=[entry arg0]; args=fun ctx -> [cindex arg0 ctx]
-CallProperty of Cpool.multiname * int: op=0x46; stack= 1-arg1; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx; u30 arg1]
-CallPropLex of Cpool.multiname * int: op=0x4c; stack= 1-arg1; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx; u30 arg1]
-Call of int: op=0x41; stack= 1-(2+arg0); args=const [u30 arg0];
-Pop: op=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: op=0x2a; stack= 2
-
-# Class
-
-ConstructSuper of int: op=0x49; args=const [u30 arg0]; stack= ~-(arg0+1)
-ConstructProp of Cpool.multiname*int: op=0x4a; stack= ~-arg1; args=(fun ctx -> [u30 @@ Cpool.index arg0 ctx#cpool;u30 arg1]);
+Coerce(0x80)
+Coerce_a(0x82)
+Coerce_s(0x85)
+
+# Convert_i: op=0x73
+# Convert_s: op=0x74
+# Convert_d: op=0x75
+# Convert_b: op=0x76
+# Convert_u: op=0x77
+
+# # Arith
+# Add_i: op=0xc5; stack= ~-1
+# Subtract_i: op=0xc6; stack= ~-1
+# Multiply_i: op=0xc7; stack= ~-1
+# Add: op=0xa0; stack= ~-1
+# Subtract: op=0xa1; stack= ~-1
+# Multiply: op=0xa2; stack= ~-1
+# Divide: op=0xa3; stack= ~-1
+# Modulo: op=0xa4; stack= ~-1
+
+# # Predicator
+# Equals: op=0xab; stack= ~-1
+# StrictEquals: op=0xac; stack= ~-1
+# LessThan: op=0xad; stack= ~-1
+# LessEquals: op=0xae; stack= ~-1
+# GreaterThan: op=0xaf; stack= ~-1
+# GreaterEquals: op=0xb0; stack= ~-1
+
+# # Jump/Conditonal Jump
+# Label of Label.t: op=0x09; prefix=const [label arg0]
+# IfNlt of Label.t: op=0x0c; stack= ~-1; args=const [label_ref arg0]
+# IfNle of Label.t: op=0x0d; stack= ~-1; args=const [label_ref arg0]
+# IfNgt of Label.t: op=0x0e; stack= ~-1; args=const [label_ref arg0]
+# IfNge of Label.t: op=0x0f; stack= ~-1; args=const [label_ref arg0]
+# Jump of Label.t: op=0x10; args=const [label_ref arg0]
+# IfTrue of Label.t: op=0x11; stack= ~-1; args=const [label_ref arg0]
+# IfFalse of Label.t: op=0x12; stack= ~-1; args=const [label_ref arg0]
+# IfEq of Label.t: op=0x13; stack= ~-1; args=const [label_ref arg0]
+# IfNe of Label.t: op=0x14; stack= ~-1; args=const [label_ref arg0]
+# IfLt of Label.t: op=0x15; stack= ~-1; args=const [label_ref arg0]
+# IfLe of Label.t: op=0x16; stack= ~-1; args=const [label_ref arg0]
+# IfGt of Label.t: op=0x17; stack= ~-1; args=const [label_ref arg0]
+# IfGe of Label.t: op=0x18; stack= ~-1; args=const [label_ref arg0]
+# IfStrictEq of Label.t: op=0x19; stack= ~-1; args=const [label_ref arg0]
+# IfStrictNe of Label.t: op=0x1a; stack= ~-1; args=const [label_ref arg0]
+
+# # Literal
+# PushNull: op=0x20; stack=1
+# PushUndefined: op=0x21; stack=1
+# PushByte of int: op=0x24; stack=1; args=const [u8 arg0]
+# PushShort of int: op=0x25; stack=1; args=const [u30 arg0]
+# PushTrue: op=0x26; stack=1
+# PushFalse: op=0x27; stack=1
+# PushNaN: op=0x28; stack=1
+# PushString of string: op=0x2C; stack=1; const=[`String arg0]; args=fun ctx -> [cindex (`String arg0) ctx]
+# PushInt of int: op=0x2D; stack=1; const=[`Int arg0]; args=fun ctx -> [cindex (`Int arg0) ctx]
+# PushUInt of int: op=0x2E; stack=1; const=[`UInt arg0]; args=fun ctx -> [cindex (`UInt arg0) ctx]
+# PushDouble of float: op=0x2F; stack=1; const=[`Double arg0]; args=fun ctx -> [cindex (`Double arg0) ctx]
+# PushNamespace of Cpool.namespace: op=0x31; stack=1; const=[entry arg0]; args=fun ctx -> [cindex arg0 ctx]
+
+# # 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: op=0xD0; stack=1;count=1
+# GetLocal_1: op=0xD1; stack=1;count=2
+# GetLocal_2: op=0xD2; stack=1;count=3
+# GetLocal_3: op=0xD3; stack=1;count=4
+# GetLocal of int: op=0x62; stack=1; args=const [u30 arg0];count=(arg0+1)
+# SetLocal_0: op=0xD4; stack=1
+# SetLocal_1: op=0xD5; stack=1
+# SetLocal_2: op=0xD6; stack=1
+# SetLocal_3: op=0xD7; stack=1
+# SetLocal of int: op=0x63; stack=1; args=const [u30 arg0]
+
+# GetSlot of int: op=0x6c; args=const [u30 arg0]
+# SetSlot of int: op=0x6d; args=const [u30 arg0]; stack= ~-2
+# GetGlobalSlot of int: op=0x6e; stack=1; args=const [u30 arg0]
+# SetGlobalSlot of int: op=0x6f; stack= ~-1; args=const [u30 arg0]
+
+# GetLex of Cpool.multiname: op=0x60; stack=1; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx]
+# GetProperty of Cpool.multiname: op=0x66; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx]
+# SetProperty of Cpool.multiname: op=0x61; stack= ~-2; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx]
+# InitProperty of Cpool.multiname: op=0x68; stack= ~-2; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx]
+
+# # FunctionCall
+# ReturnVoid: op=0x47
+# ReturnValue: op=0x48; stack= ~-1
+# FindPropStrict of Cpool.multiname: op=0x5D; stack=1; const=[entry arg0]; args=fun ctx -> [cindex arg0 ctx]
+# CallProperty of Cpool.multiname * int: op=0x46; stack= 1-arg1; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx; u30 arg1]
+# CallPropLex of Cpool.multiname * int: op=0x4c; stack= 1-arg1; const=[entry arg0]; args=fun ctx ->[cindex arg0 ctx; u30 arg1]
+# Call of int: op=0x41; stack= 1-(2+arg0); args=const [u30 arg0];
+# Pop: op=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: op=0x2a; stack= 2
+
+# # Class
+
+# ConstructSuper of int: op=0x49; args=const [u30 arg0]; stack= ~-(arg0+1)
+# ConstructProp of Cpool.multiname*int: op=0x4a; stack= ~-arg1; args=(fun ctx -> [u30 @@ Cpool.index arg0 ctx#cpool;u30 arg1]);