X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fruntime.ml;h=46e1b01aee653a7ea65acf553ff8badd31795a30;hb=16e61f135ed3043f4c656c423c67654ceb058411;hp=3299675f4336e9dd33a9c2879cbf23d23c760dea;hpb=762af11c30f30845ab7cd72d640ea153ed160487;p=SXSI%2Fxpathcomp.git diff --git a/src/runtime.ml b/src/runtime.ml index 3299675..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,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