OSDN Git Service

update gen_inst
authormzp <mzpppp@gmail.com>
Tue, 8 Sep 2009 22:24:18 +0000 (07:24 +0900)
committermzp <mzpppp@gmail.com>
Tue, 8 Sep 2009 22:24:18 +0000 (07:24 +0900)
base/base.ml
swflib/.gitignore [new file with mode: 0644]
swflib/.ocamlinit [new file with mode: 0644]
swflib/OMakefile
swflib/gen_inst.ml
swflib/instruction.txt

index 257ad56..6efacaa 100644 (file)
@@ -62,6 +62,16 @@ let rec map_accum_right f init =
          f accum x in
          accum,y::ys
 
+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
+    | [] ->
+       []
+
 let rec group_by f =
   function
       [] ->
diff --git a/swflib/.gitignore b/swflib/.gitignore
new file mode 100644 (file)
index 0000000..e5574f7
--- /dev/null
@@ -0,0 +1 @@
+gen_inst
\ No newline at end of file
diff --git a/swflib/.ocamlinit b/swflib/.ocamlinit
new file mode 100644 (file)
index 0000000..0837cfe
--- /dev/null
@@ -0,0 +1,5 @@
+#directory "../base";;
+#load "base.cma";;
+
+#use "topfind";;
+#camlp4o;;
\ No newline at end of file
index 61fa585..4a1d309 100644 (file)
@@ -26,7 +26,7 @@ OCAML_LIBS    += $(ROOT)/base/base
 OCAMLOPT   = ocamlopt -for-pack $(capitalize $(basename $(PROGRAM)))
 OCAMLOPTLINK= ocamlopt
 
-OCamlProgram(gen_inst,gen_inst)
+OCamlProgram(gen_inst,gen_inst parsec)
 
 # test
 OUnitTest(bytes   , bytes label)
index 3b54225..4b5ed26 100644 (file)
+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 ()
+
index f974dc4..6cd8dd6 100644 (file)
-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]);