X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2FresJIT.ml;h=df08d9c3b2daaaefbf371ae9720d4b0ca2a19849;hb=2a7218fd2a985ed57732f9f7b9a0b62f4b2c83df;hp=312b4872ff5a81d4f74b8d9df547e511f85f7910;hpb=4b52da1a20a4fe031930bb96d2ca46bec06dc529;p=SXSI%2Fxpathcomp.git diff --git a/src/resJIT.ml b/src/resJIT.ml index 312b487..df08d9c 100644 --- a/src/resJIT.ml +++ b/src/resJIT.ml @@ -1,5 +1,7 @@ INCLUDE "debug.ml" INCLUDE "utils.ml" +INCLUDE "trace.ml" + open Format type instr = @@ -193,7 +195,7 @@ let () = at_exit (fun () -> Printf.eprintf "Dummy affectations %i/%i\n%!" !_empt ;; *) -DEFINE SET(a, b) = a <- b +DEFINE SET(a, b) = (a) <- (b) DEFINE EXEC_INSTR_TEMPLATE(ns) = fun slot1 slot2 t inst acc -> match inst with @@ -207,24 +209,24 @@ DEFINE EXEC_CODE_TEMPLATE(ns) = fun slot slot1 slot2 t dst code -> | OP_NOP _ -> () | OP_LEFT1 src -> - if slot != slot1 then SET(slot.(dst), slot1.(src)) + SET(slot.(dst), slot1.(src)) | OP_LEFT2 (src1, src2) -> - SET(slot.(dst) , ns.concat slot1.(src1) slot1.(src2)) + SET(slot.(dst) , ns.concat slot1.(src1) slot1.(src2)) - | OP_RIGHT1 src -> if slot != slot2 then SET(slot.(dst) , slot2.(src)) + | OP_RIGHT1 src -> SET(slot.(dst) , slot2.(src)) | OP_RIGHT2 (src1, src2) -> SET (slot.(dst) , ns.concat slot2.(src1) slot2.(src2) ) | OP_LEFT1_RIGHT1 (src1, src2) -> - SET (slot.(dst) , ns.concat slot1.(src1) slot2.(src2)) + SET (slot.(dst) , ns.concat slot1.(src1) slot2.(src2)) | OP_LEFT2_RIGHT1 (src1, src2, src3) -> - SET (slot.(dst) , ns.concat3 slot1.(src1) slot1.(src2) slot2.(src3)) + SET (slot.(dst) , ns.concat3 slot1.(src1) slot1.(src2) slot2.(src3)) | OP_LEFT1_RIGHT2 (src1, src2, src3) -> - SET (slot.(dst) , ns.concat3 slot1.(src1) slot2.(src2) slot2.(src3)) + SET (slot.(dst) , ns.concat3 slot1.(src1) slot2.(src2) slot2.(src3)); | OP_LEFT2_RIGHT2 (src1, src2, src3, src4) -> SET (slot.(dst) , ns.concat4 slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4)) @@ -268,6 +270,10 @@ module type S = module NS : NodeSet.S type t = NS.t array val exec : t -> t -> t -> Tree.node -> code -> unit + val print : Format.formatter -> t -> unit + val var : int -> t -> t + val close : ((int*State.t, NS.t) Hashtbl.t) -> t -> t + val is_open : t -> bool end @@ -276,6 +282,11 @@ module Count = struct module NS = NodeSet.Count type t = NodeSet.Count.t array + let print fmt s = + let pr fmt (state, count) = + fprintf fmt "%a: %i" State.print state (NS.length count) + in + Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s) let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Count) let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Count) @@ -283,21 +294,45 @@ module Count = let rec exec slot slot1 slot2 t code = match code with | Nil -> () - | Cons(dst, code, code1) -> - exec_code slot slot1 slot2 t dst code; - begin - match code1 with - | Nil -> () - | Cons(dst, code, code1) -> - exec_code slot slot1 slot2 t dst code; - exec slot slot1 slot2 t code1 - end + | Cons(dst, opcode, code1) -> + TRACE("res-jit", 3, __ " %a := %a\n%!" + State.print dst print_opcode opcode; + ); + exec_code slot slot1 slot2 t dst opcode; + begin + match code1 with + | Nil -> () + | Cons(dst, opcode, code1) -> + TRACE("res-jit", 3, __ " %a := %a\n%!" + State.print dst print_opcode opcode; + ); + exec_code slot slot1 slot2 t dst opcode; + exec slot slot1 slot2 t code1 + end + + let exec slot slot1 slot2 t code = + TRACE("res-jit", 3, __ "Node %i:\n" (Node.to_int t)); + TRACE("res-jit", 3, __ " LEFT : %a\n" pr_slot slot1); + TRACE("res-jit", 3, __ " RIGHT : %a\n" pr_slot slot2); + exec slot slot1 slot2 t code; + TRACE("res-jit", 3, __ " RES : %a\n\n%!" pr_slot slot) + + + let var _ x = x + let close _ x = x + + let is_open _ = false end module Mat = struct module NS = NodeSet.Mat type t = NodeSet.Mat.t array + let print fmt s = + let pr fmt (state, count) = + fprintf fmt "%a: %i" State.print state (NS.length count) + in + Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s) let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Mat) let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Mat) @@ -309,12 +344,64 @@ module Mat = exec_code slot slot1 slot2 t dst code; begin match code1 with - | Nil -> () - | Cons(dst, code, code1) -> - exec_code slot slot1 slot2 t dst code; - exec slot slot1 slot2 t code1 + | Nil -> () + | Cons(dst', code', code1') -> + exec_code slot slot1 slot2 t dst' code'; + exec slot slot1 slot2 t code1' end + + let var _ x = x + let close _ x = x + let is_open _ = false end +module Make(U : NodeSet.S) = + struct + module NS = U + type t = U.t array + let print fmt s = + let pr fmt (state, count) = + fprintf fmt "%a: %i" State.print state (NS.length count) + in + Pretty.print_array ~sep:", " pr fmt (Array.mapi (fun x y -> (x,y)) s) + + let exec_instr = EXEC_INSTR_TEMPLATE(U) + let exec_code = EXEC_CODE_TEMPLATE(U) + (* inline by hand for efficiency reason *) + let rec exec slot slot1 slot2 t code = + match code with + | Nil -> () + | Cons(dst, opcode, code1) -> + TRACE("res-jit", 3, __ " %a := %a\n%!" + State.print dst print_opcode opcode; + ); + exec_code slot slot1 slot2 t dst opcode; + begin + match code1 with + | Nil -> () + | Cons(dst, opcode, code1) -> + TRACE("res-jit", 3, __ " %a := %a\n%!" + State.print dst print_opcode opcode; + ); + exec_code slot slot1 slot2 t dst opcode; + exec slot slot1 slot2 t code1 + end + + let exec slot slot1 slot2 t code = + TRACE("res-jit", 3, __ "Node %i:\n" (Node.to_int t)); + TRACE("res-jit", 3, __ " LEFT : %a\n" pr_slot slot1); + TRACE("res-jit", 3, __ " RIGHT : %a\n" pr_slot slot2); + exec slot slot1 slot2 t code; + TRACE("res-jit", 3, __ " RES : %a\n\n%!" pr_slot slot) + + + let var i t = + Array.mapi (fun j _ -> NS.var (i,j)) t + let close h t = + Array.map (NS.close h) t + + let is_open t = + List.exists NS.is_open (Array.to_list t) + end