Adds new tracing points in the grammar runtime.
authorKim Nguyễn <kn@lri.fr>
Wed, 22 Feb 2012 09:16:44 +0000 (10:16 +0100)
committerKim Nguyễn <kn@lri.fr>
Wed, 22 Feb 2012 09:16:44 +0000 (10:16 +0100)
src/runtime.ml

index 0be30a7..9836952 100644 (file)
@@ -124,7 +124,7 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t =
          in
          let ns1 = StateSet.inter s1 orig_s1
          and ns2 = StateSet.inter s2 orig_s2 in
-         let res, ops, todo = eval_trans auto s1 s2 trl in
+         let res, ops, todo = eval_trans auto ns1 ns2 trl in
          let code, not_marking = ResJIT.compile ops in
          let todo_code, todo_notmarking =
            List.fold_left (fun (l, b) (p, q, o) -> let c, b' = ResJIT.compile o in
@@ -299,24 +299,24 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
        | L2JIT.TAGGED_SUBTREE(s, tag) ->
 
          let count = U.NS.subtree_tags tree t tag in
-               if count != U.NS.empty then
-                 let r = Array.copy empty_slot in
-                   r.(auto.last) <- count;
-                   s,r
-               else
-                 s,empty_slot
+         if count != U.NS.empty then
+           let r = Array.copy empty_slot in
+           r.(auto.last) <- count;
+           s,r
+         else
+           s,empty_slot
 
        | L2JIT.ELEMENT_SUBTREE(s) ->
 
-             let count = U.NS.subtree_elements tree t in
-               if count != U.NS.empty then
-                 let r = Array.copy empty_slot in
-                   r.(auto.last) <- count;
-                   s,r
-               else
-                 s,empty_slot
+         let count = U.NS.subtree_elements tree t in
+         if count != U.NS.empty then
+           let r = Array.copy empty_slot in
+           r.(auto.last) <- count;
+           s,r
+         else
+           s,empty_slot
 
-    in
+      in
       let r = LOOP (root, states, ctx) in
       (*L3JIT.stats err_formatter cache3; *)
       r
@@ -425,24 +425,30 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
 
 
 (*  Grammar run *)
-    module ArrayPool =
-    struct
-      let pool = Queue.create ()
-      let create dummy =
-       if Queue.is_empty pool then
-         Array.create 16 dummy
-       else
-         Queue.take pool
-      let create dummy = Array.create 16 dummy
-      let free p = Queue.add p pool
-    end
+    external is_young : 'a array -> bool = "caml_custom_is_young" "noalloc"
+    external blit : 'a array -> int -> 'a array -> int -> int -> unit = "caml_custom_array_blit"
+    module M = Map.Make(struct type t = Grammar.n_symbol let compare = compare end)
+    let log = ref M.empty
+    let log_symbol s =
+      let c = try M.find s !log with _ -> 0 in
+      log:= M.add s (c+1) !log
+    ;;
+    let () = at_exit (fun () -> M.iter (fun i j ->
+      if j > 0 then
+      Printf.eprintf "%i->%i\n%!"
+       (Grammar.symbol i) j) !log )
+    ;;
+    let blit a1 o1 a2 o2 l = if l != 0 then
+      for i = 0 to l - 1 do
+       a2.(o2 + i) <- a1.(o1 + i);
+      done
 
 
     let grammar_run auto g () =
 
-      let start_symbol = (Node.of_int 0) in
+      let start_symbol = Node.of_int 0 in
       let dummy_leaf = Grammar.Leaf (Node.nil) in
-
+      let nil_symbol = Grammar.nil_symbol g in
       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
@@ -450,8 +456,12 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
       let cache3 = L3JIT.create () in
       let dummy2 = (StateSet.empty, StateSet.empty, Translist.nil) in
       let cache2 = Cache.Lvl2.create 512 dummy2 in
-      let tmp1 = Array.create 16 dummy_leaf in
-      let tmp2 = Array.create 16 dummy_leaf in
+      let parameters = Array.create 2 dummy_leaf in
+      let parameters_tmp = Array.create 2 dummy_leaf in
+      let rule_counter = ref 0 in
+      let start_counter = ref 0 in
+      let () = at_exit (fun () -> Printf.eprintf "start_couter=%i, rule_counter=%i\n%!"
+       !start_counter !rule_counter) in
       let get_trans tag states =
        let c = Cache.Lvl2.find cache2 tag (Uid.to_int states.StateSet.Node.id) in
        if c == dummy2 then
@@ -476,6 +486,7 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
        else c
       in
       let rec start_loop idx states =
+       incr (start_counter);
        TRACE("grammar", 2, __ "Node %i\n%!" (Node.to_int idx));
        if idx < Node.null then nil_res
        else if StateSet.is_empty states then empty_res
@@ -483,82 +494,69 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
          let symbol = Grammar.get_symbol_at g start_symbol idx in
          if Grammar.is_terminal symbol then
            let symbol = Grammar.terminal symbol in
-           let tag = Grammar.tag symbol in
-           let lst, rst, trans = get_trans tag states in
-           let fs = Grammar.first_child g start_symbol idx in
-           let s1, slot1 = start_loop fs lst in
-           let s2, slot2 = start_loop (Grammar.next_sibling g start_symbol fs) rst in
-           let opcode = L3JIT.find cache3 trans s1 s2 in
-           if opcode == L3JIT.dummy then (L3JIT.cache_apply cache3 auto trans s1 s2) empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic ())
-           else opcode empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic())
+           if symbol == nil_symbol then nil_res else
+             let tag = Grammar.tag symbol in
+             let lst, rst, trans = get_trans tag states in
+             let fs = Grammar.start_first_child g idx in
+             let s1, slot1 = start_loop fs lst in
+             let s2, slot2 = start_loop (Grammar.start_next_sibling g fs) rst in
+             let opcode = L3JIT.find cache3 trans s1 s2 in
+             if opcode == L3JIT.dummy then
+               (L3JIT.cache_apply cache3 auto trans s1 s2) empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic ())
+             else opcode empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic())
          else
-           let tn = Grammar.non_terminal symbol in
-           let nparam = Grammar.num_params tn in
-           let a_param = tmp1 (*ArrayPool.create dummy_leaf*) in
+           let nt = Grammar.non_terminal symbol in
+           let nparam = Grammar.num_params nt in
            let child = ref (Grammar.first_child g start_symbol idx) in
            for i = 0 to nparam - 1 do
              let c = !child in
-             a_param.(i) <- Grammar.Leaf c;
+             parameters.(i) <- Grammar.Leaf c;
              child := Grammar.next_sibling g start_symbol c;
            done;
-           (*let a_param = Array.init nparam
-             (fun _ -> let c = !child in
-                       child := Grammar.next_sibling g start_symbol c;
-                       Grammar.Leaf c) 
-              in *)
-           rule_loop tn a_param states
+           rule_loop nt states parameters
 
        end
-      and counter = ref 0
-      and rule_loop (t : Grammar.n_symbol) a_param states =
-
-       incr counter;
-       if !counter land 8191 == 0 then Gc.minor();
-
+      and rule_loop (t : Grammar.n_symbol) states a_param =
+       incr rule_counter;
+(*     log_symbol (t); *)
+       if !rule_counter land (4095) == 0 then begin Gc.minor() end;
        let id1 = Grammar.get_id1 g t in
        let id2 = Grammar.get_id2 g t in
-       let param_pos = Grammar.get_param_pos t in
+       let param_pos = Grammar.get_param_pos t in
        let nparam1 = Grammar.num_children id1 in
        let nparam2 =
-         if Grammar.is_terminal id2 && Grammar.is_nil g (Grammar.terminal id2) then 0
+         if Grammar.is_terminal id2 && nil_symbol == (Grammar.terminal id2) then 0
          else Grammar.num_children id2
        in
-       let a_param1 = (*ArrayPool.create dummy_leaf*) tmp2 (* Array.create nparam1 dummy_leaf *) in
-       let a_param2 = Array.create nparam2 dummy_leaf (* Array.create nparam2 dummy_leaf *) in
+       let a_param2 = if nparam2 == 0 then [||] else Array.create nparam2 dummy_leaf in
        let i = param_pos - 2 in
-       (*Array.blit a_param 0 a_param1 0 (i+1);  (* Pass parameters before id2 *) *)
-       (* Array.blit is too slow *)
-       for k = 0 to i do
-         a_param1.(k) <- a_param.(k);
-       done;
-       a_param1.(i+1) <- Grammar.Node(id2, a_param2);  (* id2( ... ) *)
-       (*Array.blit a_param (i + nparam2 + 1) a_param1 (i+2) (nparam1 - i - 2); (* Pass parameters after id2 *) *)
-       for k = 0 to nparam1 - i -3 do
-         a_param1.(i+2+k) <- a_param.(i + nparam2 + 1 + k);
-       done;
-       (*Array.blit a_param (i + 1) a_param2 0 nparam2; (* parameters below id2 *) *)
-       for k = 0 to nparam2 - 1 do
-         a_param2.(k) <- a_param.(i+1+k)
-       done;
-       for i = 0 to nparam1 do
-         a_param.(i) <- a_param1.(i)
-       done;
+       let ip1 = i + 1 in
+       let offset2d = i+2 in
+       let offset2s = i+nparam2 + 1 in
+       blit a_param 0 parameters_tmp 0 (i+1);
+       parameters_tmp.(ip1) <- Grammar.Node(id2, a_param2);  (* id2( ... ) *)
+       blit a_param offset2s parameters_tmp offset2d (nparam1 - i - 2);
+       blit a_param ip1 a_param2 0 nparam2;
+
+       blit parameters_tmp 0 parameters 0 nparam1;
        if Grammar.is_non_terminal id1 then
          let id1 = Grammar.non_terminal id1 in
-         rule_loop id1 a_param states
+         rule_loop id1 states parameters
        else
          let id1 = Grammar.terminal id1 in
-         terminal_loop id1 a_param states
+         terminal_loop id1 states parameters
 
-      and terminal_loop (symbol : Grammar.t_symbol) a_param states =
-       if Grammar.is_nil g symbol then nil_res else begin
+      and terminal_loop (symbol : Grammar.t_symbol) states a_param =
+       if symbol == nil_symbol then nil_res else begin
          (* todo factor in from start_loop *)
          let tag = Grammar.tag symbol in
          let lst, rst, trans = get_trans tag states in
+         let next = a_param.(1) in
          let s1, slot1 = partial_loop a_param.(0) lst in
-         let s2, slot2 = partial_loop a_param.(1) rst in
+         let s2, slot2 = partial_loop next rst in
          let opcode = L3JIT.find cache3 trans s1 s2 in
-         if opcode == L3JIT.dummy then (L3JIT.cache_apply cache3 auto trans s1 s2) empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic ())
+         if opcode == L3JIT.dummy then
+           (L3JIT.cache_apply cache3 auto trans s1 s2) empty_slot slot1 slot2 (Obj.magic ()) (Obj.magic ())
          else
            opcode empty_slot slot1 slot2 (Obj.magic())  (Obj.magic())
 
@@ -570,10 +568,13 @@ DEFINE LOOP_TAG (t, states, tag, ctx) = (
        match l with
        | Grammar.Leaf id -> start_loop id states
        | Grammar.Node (id, a_param) ->
-         if Grammar.is_terminal id then terminal_loop (Grammar.terminal id) a_param states
-         else rule_loop (Grammar.non_terminal id) a_param states
+         let is_term = Grammar.is_terminal id in
+         if is_term then
+           terminal_loop (Grammar.terminal id) states a_param
+         else
+           rule_loop (Grammar.non_terminal id) states a_param
       in
-      (*L3JIT.stats err_formatter cache3; *)
+
       let _, slot = start_loop (Node.null) auto.init in
       slot.(StateSet.min_elt auto.topdown_marking_states)
     ;;