From: Kim Nguyễn Date: Fri, 20 Apr 2012 13:41:17 +0000 (+0200) Subject: Make constant construtors of L2JIT.opcode CACHE and RETURN be take a X-Git-Url: http://git.nguyen.vg/gitweb/?p=SXSI%2Fxpathcomp.git;a=commitdiff_plain;h=762af11c30f30845ab7cd72d640ea153ed160487 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 --- 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 --- 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 --- 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 =