X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fl2JIT.ml;h=c3f212e6dd7d31ac318c1a2ab46512dbf6a1dc4a;hb=refs%2Fheads%2Fmaster;hp=b656fafec726ce507f8443c2d35d23bfdc5d26ca;hpb=9d19c60e10c9572885509b35c2b72f362968d6ab;p=SXSI%2Fxpathcomp.git

diff --git a/src/l2JIT.ml b/src/l2JIT.ml
index b656faf..c3f212e 100644
--- a/src/l2JIT.ml
+++ b/src/l2JIT.ml
@@ -13,12 +13,12 @@ type jump =
   | NEXT_ELEMENT of StateSet.t
   | TAGGED_DESCENDANT of StateSet.t * Tag.t
   | TAGGED_FOLLOWING of StateSet.t * Tag.t
-  | SELECT_DESCENDANT of StateSet.t * Ptset.Int.t * Tree.unordered_set
-  | SELECT_FOLLOWING of StateSet.t * Ptset.Int.t * Tree.unordered_set
+  | SELECT_DESCENDANT of StateSet.t * Ptset.Int.t * Tree.tag_list
+  | SELECT_FOLLOWING of StateSet.t * Ptset.Int.t * Tree.tag_list
   | TAGGED_CHILD of StateSet.t * Tag.t
   | TAGGED_SIBLING of StateSet.t * Tag.t
-  | SELECT_CHILD of StateSet.t * Ptset.Int.t * Tree.unordered_set
-  | SELECT_SIBLING of StateSet.t * Ptset.Int.t * Tree.unordered_set
+  | SELECT_CHILD of StateSet.t * Ptset.Int.t * Tree.tag_list
+  | SELECT_SIBLING of StateSet.t * Ptset.Int.t * Tree.tag_list
   | TAGGED_SUBTREE of StateSet.t * Tag.t
   | ELEMENT_SUBTREE of StateSet.t
 
@@ -31,12 +31,12 @@ let _first_element s = FIRST_ELEMENT s
 let _next_element s = NEXT_ELEMENT s
 let _tagged_descendant s t = TAGGED_DESCENDANT(s,t)
 let _tagged_following s t = TAGGED_FOLLOWING(s,t)
-let _select_descendant s t = SELECT_DESCENDANT(s,t, Tree.unordered_set_of_set t)
-let _select_following s t = SELECT_FOLLOWING(s,t, Tree.unordered_set_of_set t)
+let _select_descendant s t = SELECT_DESCENDANT(s,t, Tree.tag_list_of_set t)
+let _select_following s t = SELECT_FOLLOWING(s,t, Tree.tag_list_of_set t)
 let _tagged_child s t = TAGGED_CHILD(s,t)
 let _tagged_following_sibling s t = TAGGED_SIBLING(s,t)
-let _select_child s t = SELECT_CHILD(s,t, Tree.unordered_set_of_set t)
-let _select_following_sibling s t = SELECT_SIBLING(s,t, Tree.unordered_set_of_set t)
+let _select_child s t = SELECT_CHILD(s,t, Tree.tag_list_of_set t)
+let _select_following_sibling s t = SELECT_SIBLING(s,t, Tree.tag_list_of_set t)
 let _tagged_subtree s t = TAGGED_SUBTREE (s, t)
 let _element_subtree s = ELEMENT_SUBTREE s
 
@@ -86,18 +86,19 @@ let jump_stat_summary fmt =
 
 
 type opcode =
-  | CACHE
-  | RETURN
+  | RETURN of unit
   | LEFT of Translist.t * jump
   | RIGHT of Translist.t * jump
   | BOTH of Translist.t * jump * jump
+  | CACHE of unit
 
 type t = opcode Cache.Lvl2.t
 
-let dummy = CACHE
+let dummy = CACHE ()
+let return = RETURN ()
 let print_opcode fmt o = match o with
-  | CACHE  -> fprintf fmt "CACHE"
-  | RETURN  -> fprintf fmt "RETURN"
+  | CACHE _ -> fprintf fmt "CACHE"
+  | RETURN _ -> fprintf fmt "RETURN"
   | LEFT (tl, j) -> fprintf fmt "LEFT(\n[%a], %a)" Translist.print tl print_jump j
   | RIGHT (tl, j) -> fprintf fmt "RIGHT(\n[%a], %a)" Translist.print tl print_jump j
   | BOTH (tl, j1, j2) -> fprintf fmt "BOTH(\n[%a], %a, %a)" Translist.print tl print_jump j1 print_jump j2
@@ -116,7 +117,7 @@ let print_opcode fmt o = match o with
   end
   end c
 *)
-let create () = Cache.Lvl2.create 4096 dummy
+let create () = Cache.Lvl2.create 512 dummy
 (*
   let stats fmt c =
   let d = Cache.Lvl2.to_array c in
@@ -145,6 +146,12 @@ let has_text l = Ptset.Int.mem Tag.pcdata l
 
 let rec translate_jump tree tag (jkind:Ata.jump_kind) dir s =
   let child, desc, sib, fol = Tree.tags tree tag in
+  let not_elements =
+    Ptset.Int.add Tag.pcdata
+      (Ptset.Int.add Tag.attribute
+         (Ptset.Int.add Tag.attribute_data
+            (Tree.attribute_tags tree)))
+  in
   match jkind, dir with
   | NIL, _ -> _nop
   | NODE, DIR_LEFT -> FIRST_CHILD s
@@ -178,9 +185,21 @@ let rec translate_jump tree tag (jkind:Ata.jump_kind) dir s =
     let labels = Ptset.Int.inter l_many t in
     let c = Ptset.Int.cardinal labels in
     if c == 0 then _nop
-    else if c == 1 then tagged_many s (Ptset.Int.choose labels)
-    else if c > 5 then if has_text labels then any s else any_notext s
-    else select_many s labels
+    else
+      let not_t = Ptset.Int.diff l_many labels in
+      let () =
+        LOG(__ "level2-jit" 3 "Would jump for tag %s to labels %a, not relevant tags: %a"
+              (Tag.to_string tag)
+              TagSet.print (TagSet.inj_positive labels)
+              TagSet.print (TagSet.inj_positive not_t))
+      in
+      if Ptset.Int.subset not_t not_elements then
+        if has_text labels then any s else any_notext s
+      else if c == 1 then tagged_many s (Ptset.Int.choose labels)
+      else
+        if c >= 5 then
+          if has_text labels then any s else any_notext s
+        else select_many s labels
 
   | CAPTURE_MANY (t), DIR_LEFT ->
     if Ptset.Int.is_singleton t then TAGGED_SUBTREE(s, Ptset.Int.choose t)
@@ -188,30 +207,48 @@ let rec translate_jump tree tag (jkind:Ata.jump_kind) dir s =
     else assert false
   | _ -> assert false
 
+let count = ref 0
+let () = at_exit (fun () -> Logger.verbose Format.err_formatter "Compute jump called %i times\n" !count)
+module Memo = Hashtbl.Make(struct
+  type t = Tag.t * StateSet.t * dir
+  let equal (a,b,c) (d,e,f) = a == d && b == e && c == f
+  let hash (a, b, c) = HASHINT3(a, Uid.to_int b.StateSet.Node.id, (Obj.magic c))
+end)
+
+let memo = Memo.create 1024
+let init () = Memo.clear memo
+
 let compute_jump auto tree tag states dir =
-  if !Options.no_jump then
+  if !Config.no_jump then
     if dir == DIR_LEFT then FIRST_CHILD states
     else NEXT_SIBLING states
   else
-    let jkind = Ata.top_down_approx auto states tree in
-    let jump = translate_jump tree tag jkind dir states in
-    LOG(__ "level2-jit" 2
-	"Computed jumps for %s %a %s: %a\n%!"
-	  (Tag.to_string tag)
-	  StateSet.print states
-	  (if dir == DIR_LEFT then "left" else "right")
-	  print_jump jump
-    );
-    jump
+    try
+      Memo.find memo (tag, states, dir)
+    with
+      Not_found -> begin
+	incr count;
+	let jkind = Ata.top_down_approx auto states tree in
+	let jump = translate_jump tree tag jkind dir states in
+	LOG(__ "level2-jit" 2
+              "Computed jumps for %s %a %s, from %a : %a%!"
+              (Tag.to_string tag)
+              StateSet.print states
+              (if dir == DIR_LEFT then "left" else "right")
+              Ata.print_kind jkind
+              print_jump jump
+	);
+	Memo.add memo (tag, states, dir) jump; jump
+      end
 
 let compile cache2 auto tree tag states =
   let tr_list, states1, states2 =
-    Ata.get_trans ~attributes:(TagSet.inj_positive (Tree.attribute_tags tree)) auto states tag
+    Ata.get_trans (*~attributes:(TagSet.inj_positive (Tree.attribute_tags tree))*) auto states tag
   in
   let op =
     let empty_s1 = StateSet.is_empty states1 in
     let empty_s2 = StateSet.is_empty states2 in
-    if empty_s1 && empty_s2 then RETURN
+    if empty_s1 && empty_s2 then return
     else if empty_s1 then
       RIGHT (tr_list,
 	     compute_jump auto tree tag states2 DIR_RIGHT)
@@ -230,11 +267,11 @@ let compile cache2 auto tree tag states =
     | BOTH(tr, NOP _, r) -> RIGHT (tr, r)
     | _ -> op
   in
-  add cache2 tag states op;
+  if not !Config.no_cache then add cache2 tag states op;
   op
 
 let get_transitions = function
-  | CACHE  | RETURN  -> failwith "get_transitions"
+  | CACHE _ | RETURN _ -> failwith "get_transitions"
   | LEFT (tr, _)
   | RIGHT (tr, _)
   | BOTH (tr, _, _) -> tr