X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2FresJIT.ml;fp=src%2FresJIT.ml;h=312b4872ff5a81d4f74b8d9df547e511f85f7910;hb=4b52da1a20a4fe031930bb96d2ca46bec06dc529;hp=0000000000000000000000000000000000000000;hpb=a223af3254fb51c279cfbccdc18c59484fdca74e;p=SXSI%2Fxpathcomp.git

diff --git a/src/resJIT.ml b/src/resJIT.ml
new file mode 100644
index 0000000..312b487
--- /dev/null
+++ b/src/resJIT.ml
@@ -0,0 +1,320 @@
+INCLUDE "debug.ml"
+INCLUDE "utils.ml"
+open Format
+
+type instr =
+  | SELF of unit
+  | LEFT of State.t
+  | RIGHT of State.t
+
+type opcode =
+  | OP_NOP of unit
+  | OP_LEFT1 of State.t
+  | OP_LEFT2 of State.t * State.t
+  | OP_RIGHT1 of State.t
+  | OP_RIGHT2 of State.t * State.t
+  | OP_LEFT1_RIGHT1 of State.t * State.t
+  | OP_LEFT2_RIGHT1 of State.t * State.t * State.t
+  | OP_LEFT1_RIGHT2 of State.t * State.t * State.t
+  | OP_LEFT2_RIGHT2 of State.t * State.t * State.t * State.t
+  | OP_SELF of unit
+  | OP_SELF_LEFT1 of State.t
+  | OP_SELF_LEFT2 of State.t * State.t
+  | OP_SELF_RIGHT1 of State.t
+  | OP_SELF_RIGHT2 of State.t * State.t
+  | OP_SELF_LEFT1_RIGHT1 of State.t * State.t
+  | OP_SELF_LEFT2_RIGHT1 of State.t * State.t * State.t
+  | OP_SELF_LEFT1_RIGHT2 of State.t * State.t * State.t
+  | OP_SELF_LEFT2_RIGHT2 of State.t * State.t * State.t * State.t
+  | OP_OTHER of instr array
+
+type code = Nil | Cons of State.t * opcode * code
+
+let rec length l =
+  match l with
+      Nil -> 0
+    | Cons(_, _, t) -> 1 + length t
+let debug fmt l =
+  fprintf fmt "length of code is %i\n%!" (length l)
+
+
+let print_instr fmt i =
+  match i with
+    | SELF _ -> fprintf fmt "SELF"
+    | LEFT q -> fprintf fmt "LEFT{%a}" State.print q
+    | RIGHT q -> fprintf fmt "RIGHT{%a}" State.print q
+
+let print_opcode fmt code =
+  match code with
+    | OP_NOP _ -> fprintf fmt "OP_NOP"
+
+    | OP_LEFT1 src ->
+	fprintf fmt "OP_LEFT1{%a}" State.print src
+
+    | OP_LEFT2 (src1, src2) ->
+	fprintf fmt "OP_LEFT2{%a, %a}" State.print src1 State.print src2
+
+    | OP_RIGHT1 src ->
+	fprintf fmt "OP_RIGHT1{%a}" State.print src
+
+    | OP_RIGHT2 (src1, src2) ->
+	fprintf fmt "OP_RIGHT2{%a, %a}" State.print src1 State.print src2
+
+    | OP_LEFT1_RIGHT1 (src1, src2) ->
+	fprintf fmt "OP_LEFT1_RIGHT1{%a}{%a}" State.print src1 State.print src2
+
+    | OP_LEFT2_RIGHT1 (src1, src2, src3) ->
+	fprintf fmt "OP_LEFT2_RIGHT1{%a, %a}{%a}"
+	  State.print src1 State.print src2 State.print src3
+
+    | OP_LEFT1_RIGHT2 (src1, src2, src3) ->
+	fprintf fmt "OP_LEFT1_RIGHT2{%a}{%a, %a}"
+	  State.print src1 State.print src2 State.print src3
+
+    | OP_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
+	fprintf fmt "OP_LEFT2_RIGHT2{%a, %a}{%a, %a}"
+	  State.print src1 State.print src2 State.print src3 State.print src4
+
+    | OP_SELF _ ->
+	fprintf fmt "OP_SELF"
+
+    | OP_SELF_LEFT1 src ->
+	fprintf fmt "OP_SELF_LEFT1{%a}" State.print src
+
+    | OP_SELF_LEFT2 (src1, src2) ->
+	fprintf fmt "OP_SELF_LEFT2{%a, %a}" State.print src1 State.print src2
+
+    | OP_SELF_RIGHT1 src ->
+	fprintf fmt "OP_SELF_RIGHT1{%a}" State.print src
+
+    | OP_SELF_RIGHT2 (src1, src2) ->
+	fprintf fmt "OP_SELF_RIGHT2{%a, %a}" State.print src1 State.print src2
+
+    | OP_SELF_LEFT1_RIGHT1 (src1, src2) ->
+	fprintf fmt "OP_SELF_LEFT1_RIGHT1{%a}{%a}" State.print src1 State.print src2
+
+    | OP_SELF_LEFT2_RIGHT1 (src1, src2, src3) ->
+	fprintf fmt "OP_SELF_LEFT2_RIGHT1{%a, %a}{%a}"
+	  State.print src1 State.print src2 State.print src3
+
+    | OP_SELF_LEFT1_RIGHT2 (src1, src2, src3) ->
+	fprintf fmt "OP_SELF_LEFT1_RIGHT2{%a}{%a, %a}"
+	  State.print src1 State.print src2 State.print src3
+
+    | OP_SELF_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
+	fprintf fmt "OP_SELF_LEFT2_RIGHT2{%a, %a}{%a, %a}"
+	  State.print src1 State.print src2 State.print src3 State.print src4
+    | OP_OTHER line ->
+	fprintf fmt "OP_OTHER: ";
+	Array.iter (fun i -> print_instr fmt i; fprintf fmt " ") line
+
+let merge_rev equal choose l =
+  match l with
+    | [] -> l
+    | x :: ll ->
+	List.fold_left
+	  (fun acc i ->
+	     let j = List.hd acc in
+	       if equal i j then (choose i j)::(List.tl acc)
+	       else i::acc) [x] ll
+
+let compile_instr_list l =
+  let linstr = merge_rev (=) (fun i _ -> i) (List.sort (fun x y -> compare y x) l) in
+    match linstr with
+	[] -> OP_NOP()
+      | [ LEFT q ] -> OP_LEFT1 q
+      | [ LEFT q1; LEFT q2 ] -> OP_LEFT2(q2, q1)
+      | [ RIGHT q ] -> OP_RIGHT1 q
+      | [ RIGHT q1; RIGHT q2 ] -> OP_RIGHT2(q2, q1)
+      | [ LEFT q1; RIGHT q2 ] -> OP_LEFT1_RIGHT1(q1, q2)
+      | [ LEFT q1; LEFT q2; RIGHT q3 ] -> OP_LEFT2_RIGHT1 (q2, q1, q3)
+      | [ LEFT q1; RIGHT q2; RIGHT q3 ] -> OP_LEFT1_RIGHT2 (q1, q3, q2)
+      | [ LEFT q1; LEFT q2; RIGHT q3; RIGHT q4 ] -> OP_LEFT2_RIGHT2 (q2, q1, q4, q3)
+      | [ SELF () ] -> OP_SELF()
+
+      | [ SELF _; LEFT q ] -> OP_SELF_LEFT1 q
+      | [ SELF _; LEFT q1; LEFT q2 ] -> OP_SELF_LEFT2(q2, q1)
+      | [ SELF _; RIGHT q ] -> OP_SELF_RIGHT1 q
+      | [ SELF _; RIGHT q1; RIGHT q2 ] -> OP_SELF_RIGHT2(q2, q1)
+      | [ SELF _; LEFT q1; RIGHT q2 ] -> OP_SELF_LEFT1_RIGHT1(q1, q2)
+      | [ SELF _; LEFT q1; LEFT q2; RIGHT q3 ] -> OP_SELF_LEFT2_RIGHT1 (q2, q1, q3)
+      | [ SELF _; LEFT q1; RIGHT q2; RIGHT q3 ] -> OP_SELF_LEFT1_RIGHT2 (q1, q3, q2)
+      | [ SELF _; LEFT q1; LEFT q2; RIGHT q3; RIGHT q4 ] ->
+	  OP_SELF_LEFT2_RIGHT2 (q2, q1, q4, q3)
+      | i -> OP_OTHER (Array.of_list i)
+
+
+let to_list l =
+  let rec loop l acc =
+    match l with
+	[] -> acc
+      | (a, b)::ll -> loop ll (Cons(a,b, acc))
+  in loop l Nil
+
+
+let rec filter_uniq statel stater l =
+  match l with
+      [] -> []
+    | (s, il)::ll ->
+	let nil, nsl, nsr =
+	  List.fold_left
+	    (fun ((a_il, al, ar)as acc) i ->
+	       match i with
+		 | LEFT q ->
+		     if List.mem q al then acc
+		     else (i :: a_il, q::al, ar)
+		 | RIGHT q ->
+		     if List.mem q ar then acc
+		     else (i :: a_il, al, q :: ar)
+		 | _ -> (i :: a_il, al, ar)) ([], statel, stater) il
+	in
+	  (s, nil) :: (filter_uniq nsl nsr ll)
+
+let compile l =
+  let l = List.sort (fun (s1, _) (s2, _) -> compare s1 s2) l in
+  let l = filter_uniq [] [] l in
+  let l = merge_rev
+    (fun (s1, _) (s2, _) -> s1 = s2)
+    (fun (s1, i1) (_, i2) -> (s1, i1@i2)) l
+  in
+ let marking =
+    List.exists
+      (fun (_, l) -> List.exists (function SELF _ -> true | _ -> false) l)
+      l
+  in
+  let l = List.map (fun (s, il) -> (s, compile_instr_list il)) l in
+  let l = List.filter (fun (_, instr) -> instr <> OP_NOP ()) l in
+    to_list l, not marking
+
+(*
+let _total = ref 0
+let _empty = ref 0
+let () = at_exit (fun () -> Printf.eprintf "Dummy affectations %i/%i\n%!" !_empty !_total)
+;;
+*)
+
+DEFINE SET(a, b) = a <- b
+
+DEFINE EXEC_INSTR_TEMPLATE(ns) = fun slot1 slot2 t inst acc ->
+   match inst with
+    | SELF _ ->  ns.snoc acc t
+    | LEFT src -> ns.concat acc slot1.(src)
+    | RIGHT src -> ns.concat acc slot2.(src)
+
+
+DEFINE EXEC_CODE_TEMPLATE(ns) = fun slot slot1 slot2 t dst code ->
+  match code with
+    | OP_NOP _ -> ()
+
+    | OP_LEFT1 src ->
+	if slot != slot1 then SET(slot.(dst), slot1.(src))
+
+    | OP_LEFT2 (src1, src2) ->
+	SET(slot.(dst) , ns.concat slot1.(src1) slot1.(src2))
+
+    | OP_RIGHT1 src -> if slot != slot2 then 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))
+
+    | OP_LEFT2_RIGHT1 (src1, src2, 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))
+
+    | OP_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
+        SET (slot.(dst) , ns.concat4 slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4))
+
+    | OP_SELF _ ->
+	slot.(dst) <- ns.singleton t
+
+    | OP_SELF_LEFT1 src -> slot.(dst) <- ns.cons t slot1.(src)
+
+    | OP_SELF_LEFT2 (src1, src2) ->
+	slot.(dst) <- ns.conscat t slot1.(src1) slot1.(src2)
+
+    | OP_SELF_RIGHT1 src -> slot.(dst) <- ns.cons t slot2.(src)
+
+    | OP_SELF_RIGHT2 (src1, src2) ->
+	slot.(dst) <- ns.conscat t slot2.(src1) slot2.(src2)
+
+    | OP_SELF_LEFT1_RIGHT1 (src1, src2) ->
+	slot.(dst) <- ns.conscat t slot1.(src1) slot2.(src2)
+
+    | OP_SELF_LEFT2_RIGHT1 (src1, src2, src3) ->
+	slot.(dst) <- ns.conscat3 t slot1.(src1) slot1.(src2) slot2.(src3)
+
+    | OP_SELF_LEFT1_RIGHT2 (src1, src2, src3) ->
+	slot.(dst) <- ns.conscat3 t slot1.(src1) slot2.(src2) slot2.(src3)
+
+    | OP_SELF_LEFT2_RIGHT2 (src1, src2, src3, src4) ->
+	slot.(dst) <-
+	  ns.conscat4 t slot1.(src1) slot1.(src2) slot2.(src3) slot2.(src4)
+    | OP_OTHER line ->
+      let acc = ref ns.empty in
+      let len = Array.length line - 1 in
+      for j = 0 to len do
+	acc := exec_instr slot1 slot2 t line.(j) !acc
+      done;
+      slot.(dst) <- !acc
+
+
+module type S =
+  sig
+    module NS : NodeSet.S
+    type t = NS.t array
+    val exec : t -> t -> t -> Tree.node -> code -> unit
+  end
+
+
+
+module Count =
+  struct
+    module NS = NodeSet.Count
+    type t = NodeSet.Count.t array
+
+    let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Count)
+    let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Count)
+      (* inline by hand for efficiency reason *)
+    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
+  end
+
+module Mat =
+  struct
+    module NS = NodeSet.Mat
+    type t = NodeSet.Mat.t array
+
+    let exec_instr = EXEC_INSTR_TEMPLATE(NodeSet.Mat)
+    let exec_code = EXEC_CODE_TEMPLATE(NodeSet.Mat)
+      (* inline by hand for efficiency reason *)
+    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
+  end
+
+
+