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

dummy unit argument. This improves the code generated for the pattern
matching in l2jit_dispatch (in runtime.ml).
Replaces inline macros LOOP and LOOP_TAG with function calls.

diff --git a/src/l2JIT.ml b/src/l2JIT.ml
index d01d480..c15d236 100644 (file)
--- a/src/l2JIT.ml
+++ b/src/l2JIT.ml
@@ -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
@@ -212,7 +213,7 @@ let compile cache2 auto tree tag states =
   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)
@@ -235,7 +236,7 @@ let compile cache2 auto tree tag states =
   op
 
 let get_transitions = function
-  | CACHE  | RETURN  -> failwith "get_transitions"
+  | CACHE _ | RETURN _ -> failwith "get_transitions"
   | LEFT (tr, _)
   | RIGHT (tr, _)
   | BOTH (tr, _, _) -> tr

diff --git a/src/l2JIT.mli b/src/l2JIT.mli
index 9d97d4a..c4a7578 100644 (file)
--- a/src/l2JIT.mli
+++ b/src/l2JIT.mli
@@ -23,11 +23,11 @@ val print_jump : Format.formatter -> jump -> unit
 val jump_stat_summary : Format.formatter -> unit
 
 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
 

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 =