BUG added: [59c2eb816cf4] Wrong result for jumping from root
[SXSI/xpathcomp.git] / src / runtime.ml
index 3299675..46e1b01 100644 (file)
@@ -113,55 +113,38 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t =
           let opcode = res, code, todo_notmarking, todo_code in
           opcode
 
+       let choose_slot empty sl1 sl2 =
+         if sl1 != empty then sl1
+         else if sl2 != empty then sl2
+         else Array.copy empty
+
         let gen_code auto tlist s1 s2 =
           let res, code, not_marking, todo_code = compile auto tlist s1 s2 in
           let f =
-            if todo_code == [] then
+            if todo_code == [] then begin
               if not_marking then begin fun empty_slot sl1 sl2 _ node ->
-                let slot1_empty = sl1 == empty_slot
-                and slot2_empty = sl2 == empty_slot in
-                if slot1_empty && slot2_empty then res,sl2
+                if sl1 == empty_slot && sl2 == empty_slot then res, empty_slot
                 else
-                  let sl =
-                    if slot2_empty then
-                      if slot1_empty then
-                        Array.copy empty_slot
-                      else sl1
-                    else sl2
-                  in
+                  let sl = choose_slot empty_slot sl1 sl2 in
                   U.exec sl sl1 sl2 node code;
                   res, sl
-              end
-              else (* marking *) begin fun empty_slot sl1 sl2 _ node ->
-                let sl =
-                  if sl2 == empty_slot  then
-                    if sl1 == empty_slot then
-                      Array.copy empty_slot
-                    else sl1
-                  else sl2
-                in
+              end else (* marking *) begin fun empty_slot sl1 sl2 _ node ->
+               let sl = choose_slot empty_slot sl1 sl2 in
                 U.exec sl sl1 sl2 node code;
                 res, sl
-              end
-              else (* todo != [] *)
-              begin fun empty_slot sl1 sl2 tree node ->
-                let sl =
-                  if sl2 == empty_slot  then
-                    if sl1 == empty_slot then
-                      Array.copy empty_slot
-                    else sl1
-                  else sl2
-                in
-                U.exec sl sl1 sl2 node code;
-                List.fold_left
-                  (fun ares (p, q, code) ->
-                    if !p tree node then begin
-                      if code != ResJIT.Nil then U.exec sl sl1 sl2 node code;
-                      StateSet.add q ares
-                    end
-                    else ares) res todo_code, sl
-
-              end
+             end
+           end else (* todo_code *) begin fun empty_slot sl1 sl2 tree node ->
+             let sl = choose_slot empty_slot sl1 sl2 in
+             LOG( __ "bottom-up" 3 "Has todo code\n");
+              U.exec sl sl1 sl2 node code;
+              List.fold_left
+                (fun ares (p, q, code) ->
+                  if !p tree node then begin
+                    if code != ResJIT.Nil then U.exec sl sl1 sl2 node code;
+                    StateSet.add q ares
+                  end
+                  else ares) res todo_code, sl
+            end
           in
           f
 
@@ -169,7 +152,8 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t =
           let f = gen_code auto tlist s1 s2 in
           LOG(__ "grammar" 2 "Inserting: %i, %a, %a\n%!"
             (Uid.to_int tlist.Translist.Node.id) StateSet.print s1 StateSet.print s2);
-          add cache tlist s1 s2 f; f
+          if not !Options.no_cache then add cache tlist s1 s2 f;
+         f
       end
 
 DEFINE LOOP (t, states, ctx) = (
@@ -205,20 +189,20 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
       let res_len = StateSet.max_elt auto.states + 1 in
       let empty_slot = Array.create res_len U.NS.empty in
       let nil_res = auto.bottom_states, empty_slot in
-      let cache3 = L3JIT.create () in
-      let mark_subtree  =
-        fun s subtree -> if subtree != U.NS.empty then
+
+      let mark_subtree s subtree =
+       if subtree != U.NS.empty then
           let r = Array.copy empty_slot in
           r.(auto.last) <- subtree;
-          s,r
+          s, r
         else
-          s,empty_slot
+          s, empty_slot
       in
+      let cache3 = L3JIT.create () in
       let l3jit_dispatch trl s1 s2 t sl1 sl2 =
         let f = L3JIT.find cache3 trl s1 s2 in
         if f == L3JIT.dummy then (L3JIT.cache_apply cache3 auto trl s1 s2) empty_slot sl1 sl2 tree t
         else f empty_slot sl1 sl2 tree t
-
       in
       let cache2 = L2JIT.create () in
       let rec loop t states ctx =
@@ -235,7 +219,7 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
 
       and l2jit_dispatch t tag states ctx opcode =
         match opcode with
-          | L2JIT.RETURN _ -> nil_res
+          | L2JIT.RETURN () -> nil_res
           | L2JIT.LEFT (tr_list, instr) ->
               let res1, slot1 =
                 l2jit_dispatch_instr t (Tree.closing tree t) instr
@@ -256,7 +240,7 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
                 l2jit_dispatch_instr t ctx instr2
               in
                 l3jit_dispatch tr_list res1 res2 t slot1 slot2
-          | L2JIT.CACHE _ ->
+          | L2JIT.CACHE () ->
             LOG(__ "top-down-run" 3
                   "Top-down cache miss for configuration %s %a"
                   (Tag.to_string tag) StateSet.print states);
@@ -308,13 +292,12 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
       r
 
     let full_top_down_run auto states tree root =
-      (*Ata.init (); *)
       top_down_run auto tree root states (Tree.closing tree root)
 
     let top_down_run auto tree root =
-      (*Ata.init (); *)
+      Ata.init ();
+      L2JIT.init();
       let res, slot = full_top_down_run auto auto.init tree root in
-
       slot.(StateSet.min_elt auto.topdown_marking_states)
 
 
@@ -345,6 +328,8 @@ DEFINE BOTTOM_UP_NEXT(node, rest, stop) =
       let nil_res = auto.bottom_states, empty_slot in
       let cache = Cache.Lvl3.create 0 L3JIT.dummy in
       let rec move_up node res is_left rest stop =
+       LOG(__ "bottom-up" 2 "move_up: node %i is_left %b stop %i\n"
+             (Node.to_int node) is_left (Node.to_int stop));
         if node == stop then res, rest
         else
           (*let prev_sibling = Tree.prev_sibling tree node in *)
@@ -386,6 +371,12 @@ DEFINE BOTTOM_UP_NEXT(node, rest, stop) =
                   states
                   Translist.nil
               in
+             LOG( __ "bottom-up" 3 "Transition list for %s, %a, %a is %a\n"
+                    (Tag.to_string tag)
+                    StateSet.print s1
+                    StateSet.print s2
+                    Translist.print trl
+             );
               let code = L3JIT.gen_code auto trl s1 s2 in
               Cache.Lvl3.add cache id2 id1 tag code; code
             else code
@@ -751,7 +742,7 @@ let dispatch_param1 conf id2 y0 y1 =
             else c
           in
           LOG(__ "twopass" 2 "\nTransitions are:\n%!");
-          LOG(__ "twopass" 2"\nTransitions are:\n%a\n%!" 
+          LOG(__ "twopass" 2"\nTransitions are:\n%a\n%!"
             Translist.print trans
           );
           let s1 = loop (Tree.first_child tree t) lstates ctx
@@ -788,7 +779,7 @@ let dispatch_param1 conf id2 y0 y1 =
           let trans, _, _ =
           let c = Cache.Lvl2.find cache2 (Uid.to_int states.StateSet.Node.id) tag in
             if c == dummy2 then
-              let c = Ata.get_trans  ~attributes:attributes auto states tag in 
+              let c = Ata.get_trans  ~attributes:attributes auto states tag in
               Cache.Lvl2.add cache2 (Uid.to_int states.StateSet.Node.id) tag c;
               c
             else c