Make constant construtors of L2JIT.opcode CACHE and RETURN be take a

[SXSI/xpathcomp.git] / src / runtime.ml

diff --git a/src/runtime.ml b/src/runtime.ml
index 2285116..3299675 100644 (file)
--- a/src/runtime.ml
+++ b/src/runtime.ml
@@ -221,22 +221,26 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
 
       in
       let cache2 = L2JIT.create () in
-
-      let rec l2jit_dispatch t tag states ctx opcode =
+      let rec loop t states ctx =
+       if t == Tree.nil then nil_res
+       else
+         let tag = Tree.tag tree t in
+         l2jit_dispatch
+            t tag (states) (ctx) (L2JIT.find cache2 tag (states))
+      and loop_tag t states ctx tag =
+       if t == Tree.nil then nil_res
+       else
+         l2jit_dispatch
+           t (tag) (states) (ctx) (L2JIT.find cache2 (tag) (states))
+
+      and l2jit_dispatch t tag states ctx opcode =
         match opcode with
-          | L2JIT.RETURN -> nil_res
-          | L2JIT.CACHE ->
-            LOG(__ "top-down-run" 3
-                "Top-down cache miss for configuration %s %a"
-                  (Tag.to_string tag) StateSet.print states);
-            let opcode = L2JIT.compile cache2 auto tree tag states in
-            l2jit_dispatch t tag states ctx opcode
-
+          | L2JIT.RETURN _ -> nil_res
           | L2JIT.LEFT (tr_list, instr) ->
               let res1, slot1 =
                 l2jit_dispatch_instr t (Tree.closing tree t) instr
               in
-                l3jit_dispatch tr_list res1 auto.bottom_states t slot1 empty_slot
+              l3jit_dispatch tr_list res1 auto.bottom_states t slot1 empty_slot
 
           | L2JIT.RIGHT (tr_list, instr) ->
             let res2, slot2 =
@@ -245,49 +249,54 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
             l3jit_dispatch tr_list auto.bottom_states res2 t empty_slot slot2
 
           | L2JIT.BOTH (tr_list, instr1, instr2) ->
-              let res2, slot2 =
-                l2jit_dispatch_instr t ctx instr2
-              in
               let res1, slot1 =
                 l2jit_dispatch_instr t (Tree.closing tree t) instr1
+              in
+              let res2, slot2 =
+                l2jit_dispatch_instr t ctx instr2
               in
                 l3jit_dispatch tr_list res1 res2 t slot1 slot2
+          | L2JIT.CACHE _ ->
+            LOG(__ "top-down-run" 3
+                  "Top-down cache miss for configuration %s %a"
+                  (Tag.to_string tag) StateSet.print states);
+            l2jit_dispatch t tag states ctx
+             (L2JIT.compile cache2 auto tree tag states)
 
     and l2jit_dispatch_instr t ctx instr =
-        let () = LOG(__ "top-down-run" 3 "Dispatching instr: %a on node %i (context=%i)"
-              L2JIT.print_jump instr (Node.to_int t) (Node.to_int ctx))
-        in
+       LOG(__ "top-down-run" 3 "Dispatching instr: %a on node %i (context=%i)"
+              L2JIT.print_jump instr (Node.to_int t) (Node.to_int ctx));
         match instr with
-        | L2JIT.NOP () -> nil_res
-        | L2JIT.FIRST_CHILD s -> LOOP ((Tree.first_child tree t), s, ctx)
-        | L2JIT.NEXT_SIBLING s -> LOOP ((Tree.next_sibling tree t), s, ctx)
+        | L2JIT.NOP _ -> nil_res
+        | L2JIT.FIRST_CHILD s -> loop (Tree.first_child tree t) s ctx
+        | L2JIT.NEXT_SIBLING s -> loop (Tree.next_sibling tree t) s ctx
 
-        | L2JIT.FIRST_ELEMENT s -> LOOP ((Tree.first_element tree t), s, ctx)
-        | L2JIT.NEXT_ELEMENT s -> LOOP ((Tree.next_element tree t), s, ctx)
+        | L2JIT.FIRST_ELEMENT s -> loop (Tree.first_element tree t) s ctx
+        | L2JIT.NEXT_ELEMENT s -> loop (Tree.next_element tree t) s ctx
 
         | L2JIT.TAGGED_DESCENDANT (s, tag) ->
-          LOOP_TAG ((Tree.tagged_descendant tree t tag), s, tag, ctx)
+          loop_tag (Tree.tagged_descendant tree t tag) s ctx tag
 
         | L2JIT.TAGGED_FOLLOWING (s, tag) ->
-          LOOP_TAG((Tree.tagged_following_before tree t tag ctx), s, tag, ctx)
+          loop_tag (Tree.tagged_following_before tree t tag ctx) s ctx  tag
 
         | L2JIT.SELECT_DESCENDANT (s, _, us) ->
-          LOOP((Tree.select_descendant tree t us), s, ctx)
+          loop (Tree.select_descendant tree t us) s ctx
 
         | L2JIT.SELECT_FOLLOWING (s, pt, us) ->
-          LOOP ((Tree.select_following_before tree t us ctx), s, ctx)
+          loop (Tree.select_following_before tree t us ctx) s ctx
 
         | L2JIT.TAGGED_CHILD (s, tag) ->
-          LOOP_TAG((Tree.tagged_child tree t tag), s, tag, ctx)
+          loop_tag (Tree.tagged_child tree t tag) s ctx tag
 
         | L2JIT.TAGGED_SIBLING (s, tag) ->
-          LOOP_TAG((Tree.tagged_sibling tree t tag), s, tag, ctx)
+          loop_tag (Tree.tagged_sibling tree t tag) s ctx tag
 
         | L2JIT.SELECT_CHILD (s, _, us) ->
-          LOOP ((Tree.select_child tree t us), s, ctx)
+          loop (Tree.select_child tree t us) s ctx
 
         | L2JIT.SELECT_SIBLING (s, _, us) ->
-          LOOP ((Tree.select_sibling tree t us), s, ctx)
+          loop (Tree.select_sibling tree t us) s ctx
 
         | L2JIT.TAGGED_SUBTREE(s, tag) ->
           mark_subtree s (U.NS.subtree_tags tree t tag)
@@ -295,8 +304,7 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
         | L2JIT.ELEMENT_SUBTREE(s) ->
           mark_subtree s (U.NS.subtree_elements tree t)
       in
-      let r = LOOP (root, states, ctx) in
-      (*L3JIT.stats err_formatter cache3; *)
+      let r = loop root states ctx in
       r
 
     let full_top_down_run auto states tree root =