X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fruntime.ml;h=46e1b01aee653a7ea65acf553ff8badd31795a30;hb=16e61f135ed3043f4c656c423c67654ceb058411;hp=22851169f8b163dfc4a9cdd7feb3968015164834;hpb=dcc638cf4072979834f404894cbedc653542374f;p=SXSI%2Fxpathcomp.git diff --git a/src/runtime.ml b/src/runtime.ml index 2285116..46e1b01 100644 --- a/src/runtime.ml +++ b/src/runtime.ml @@ -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,38 +189,42 @@ 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 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 +233,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,18 +288,16 @@ 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 = - (*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) @@ -337,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 *) @@ -378,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 @@ -743,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 @@ -780,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