Merge branch 'master' of ssh://git.nguyen.vg/SXSI/xpathcomp

Incorporate changes needed to make the code behave on x86.

diff --git a/src/ata.ml b/src/ata.ml
index 591fab1..272e8e0 100644 (file)
--- a/src/ata.ml
+++ b/src/ata.ml
@@ -19,7 +19,7 @@ type t = {
 
 let print ppf a =
   fprintf ppf
-    "Automaton (%i) :@\n\
+    "Unique ID: %i@\n\
      States %a@\n\
      Initial states: %a@\n\
      Marking states: %a@\n\
@@ -48,7 +48,7 @@ let print ppf a =
     let sline = Pretty.line (Pretty.length line) in
     fprintf ppf "%s@\n" sline;
     List.iter (fun s -> fprintf ppf "%s@\n" s) strings;
-    fprintf ppf "%s@\n" sline
+    fprintf ppf "%s" sline
 
 
 type jump_kind =

diff --git a/src/logger.ml b/src/logger.ml
index e99fd1f..05fbc83 100644 (file)
--- a/src/logger.ml
+++ b/src/logger.ml
@@ -40,18 +40,19 @@ let log t l fmt =
     ifprintf !logger_output fmt
 
 let print ppf fmt =
-  kfprintf (fun _ ->
-    fprintf ppf "@?")
-    ppf fmt
+  fprintf ppf fmt
 
 let _verbose = ref false
 let set_verbose b = _verbose := b
-let verbose ppf fmt =
-  if !_verbose then begin
-    kfprintf (fun _ ->
-      fprintf ppf "@?")
-      ppf fmt
-  end else 
-  ikfprintf (fun _ ->
-    fprintf ppf "@?")
-    ppf fmt
+let msg ppf fmt =
+  if !_verbose
+  then fprintf ppf fmt
+  else ifprintf ppf fmt
+
+let start_msg ppf s =
+  msg ppf "@[%s" s
+
+let end_msg ppf s =
+  msg ppf "@]%s@?" s
+
+let verbose a b = msg a b

diff --git a/src/logger.mli b/src/logger.mli
index 1ee96d5..15b28e9 100644 (file)
--- a/src/logger.mli
+++ b/src/logger.mli
@@ -13,3 +13,7 @@ val available : unit -> string list
 
 val set_verbose : bool -> unit
 val verbose : Format.formatter -> ('a, Format.formatter, unit) format -> 'a
+
+val start_msg : Format.formatter -> string -> unit
+val end_msg : Format.formatter -> string -> unit
+val msg : Format.formatter -> ('a, Format.formatter, unit) format -> 'a

diff --git a/src/main.ml b/src/main.ml
index 00d5ab9..69bd091 100644 (file)
--- a/src/main.ml
+++ b/src/main.ml
@@ -24,7 +24,9 @@ let mk_runtime run auto doc arg count print outfile =
     if !Config.do_perf then start_perf ();
     let r = Utils.time ~count:!Config.repeat ~msg:"Execution time" (run auto doc) arg in
     if !Config.do_perf then stop_perf ();
-    Logger.verbose Format.err_formatter "Number of results: %i@\n" (count r);
+    Logger.start_msg Format.err_formatter "[Debug] Number of results: ";
+    Logger.msg Format.err_formatter "%i" (count r);
+    Logger.end_msg Format.err_formatter "\n";
     match outfile with
        None -> ()
       | Some file ->
@@ -37,12 +39,17 @@ let main v query_string output =
   let query =
     Utils.time ~msg:"Parsing query" XPath.parse query_string
   in
-  Logger.verbose Format.err_formatter "Parsed query:%a@\n"
-    XPath.Ast.print query;
+  Logger.start_msg Format.err_formatter "[Debug]";
+  Logger.msg Format.err_formatter " Parsed query: @\n @[<v 0> {";
+  Logger.msg Format.err_formatter " %a }@]" XPath.Ast.print query;
+  Logger.end_msg Format.err_formatter "\n\n";
   let auto, bu_info =
     Utils.time ~msg:"Compiling query" Compile.compile query
   in
-  if !Config.verbose then Ata.print Format.err_formatter auto;
+  Logger.start_msg Format.err_formatter "[Debug] Automaton: ";
+  Logger.msg Format.err_formatter "@\n     @[<v 0>";
+  Logger.msg Format.err_formatter "%a" Ata.print auto;
+  Logger.end_msg Format.err_formatter "\n\n";
   Gc.full_major();
   Gc.compact();
   Gc.set (tuned_gc);
@@ -88,7 +95,7 @@ let _ =
       if Filename.check_suffix !Config.input_file ".srx"
       then
        Utils.time
-         ~msg:"Loading file"
+         ~msg:"Loading Index file"
          (Tree.load
             ~sample:!Config.sample_factor
             ~load_text:(not !Config.disable_text_collection))
@@ -96,7 +103,7 @@ let _ =
       else
        let v =
          Utils.time
-           ~msg:"Parsing document"
+           ~msg:"Loading XML file"
            (Tree.parse_xml_uri)
            !Config.input_file
        in
@@ -111,9 +118,11 @@ let _ =
        v
     in
     main document !Config.query !Config.output_file;
-    Logger.verbose Format.err_formatter "Maximum resident set size: %s @\n" (read_procmem());
-    Gc.full_major();
+IFDEF PROFILE
+  THEN
     Profile.summary Format.err_formatter
+  ELSE ()
+END
   with
   | Ulexer.Loc.Exc_located ((x,y),e) ->
     Logger.print Format.err_formatter "character %i-%i %s@\n" x y (Printexc.to_string e);

diff --git a/src/profile.ml b/src/profile.ml
index c43dda6..a0be76b 100644 (file)
--- a/src/profile.ml
+++ b/src/profile.ml
@@ -1,11 +1,14 @@
 let table = Hashtbl.create 103
 
 let summary fmt =
+  Logger.start_msg fmt "[Stats] Function profiling:";
+  Logger.msg fmt "@\n     @[<v 0>";
   Hashtbl.iter (fun (m, f) d  ->
     let c, tl = !d in
     let tspent =
       List.fold_left (fun acc e -> e +. acc) 0. tl 
     in
-    Format.fprintf fmt "%s: %s = called %i times, total: %fms, average: %fms\n"
+    Logger.msg fmt "%s: %s = called %i times, total: %fms, average: %fms@\n"
       m f c tspent (tspent /. (float_of_int c))) table;
-  Format.fprintf fmt "%!"
+  Logger.end_msg Format.err_formatter "\n\n"
+

diff --git a/src/runtime.ml b/src/runtime.ml
index 7d1e79f..669fb4a 100644 (file)
--- a/src/runtime.ml
+++ b/src/runtime.ml
@@ -73,10 +73,17 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t =
         let show_stats a =
           let count = ref 0 in
           Cache.Lvl3.iteri (fun _ _ _ _ b -> if not b then incr count) a;
-          Logger.print err_formatter "@?L3JIT: %i used entries@\n@?" !count
+          Logger.start_msg err_formatter "[Debug] L3JIT used: ";
+          Logger.msg err_formatter "%i enttries" !count;
+          Logger.end_msg err_formatter "\n\n"
+
+        let _has_exit = ref false
         let create () =
           let v = Cache.Lvl3.create 1024 dummy in
-          if !Config.verbose then at_exit (fun () -> show_stats v);
+          if !Config.verbose && not !_has_exit then begin
+            _has_exit := true;
+            at_exit (fun () -> show_stats v);
+          end;
           v
 
         let find t tlist s1 s2 =

diff --git a/src/tree.ml b/src/tree.ml
index 0c62ec7..b7b8566 100644 (file)
--- a/src/tree.ml
+++ b/src/tree.ml
@@ -125,7 +125,8 @@ struct
       close_tag build "";
       LOG ( __ "parsing" 2 "%s\n" "Finished parsing");
       LOG ( __ "indexing" 2 "%s\n" "Starting index construction");
-      let r = close_document build in
+      let r = close_document build
+      in
       LOG ( __ "indexing" 2 "%s\n" "Finished index construction");
       r
     in
@@ -146,7 +147,7 @@ struct
     let in_chan = open_in file in
     let buffer = String.create 4096 in
     let parser_, finalizer = create_parser () in
-    let () =
+    let parse () =
       try
        while true do
          let read = input in_chan buffer 0 4096 in
@@ -158,7 +159,8 @@ struct
       | End_of_file -> close_in in_chan
       | e -> raise e
     in
-    finalizer ()
+    Utils.time ~msg:"Parsing XML file" parse ();
+    Utils.time ~msg:"Creating tree and text-collection index" finalizer ()
 
 end
 
@@ -543,7 +545,7 @@ let node_of_t t  =
   LOG ( __ "indexing" 2 "%s\n" "Initializing tag structure");
   let _ = Tag.init (mk_tag_ops t) in
   LOG ( __ "indexing" 2 "%s\n" "Starting tag table construction");
-  let f, n, c, d = time collect_labels t ~msg:"Building tag relationship table" in
+  let f, n, c, d = Utils.time ~msg:"Building tag relationship table" collect_labels t in
   let c = Array.map TagS.to_ptset c in
   let n = Array.map TagS.to_ptset n in
   let f = Array.map TagS.to_ptset f in

diff --git a/src/utils.ml b/src/utils.ml
index 8cab636..7e3bb4b 100644 (file)
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -54,27 +54,97 @@ struct
 
 end
 
+module Timing =
+  struct
+    let _timings = Hashtbl.create 43
+    let _t_queue = Queue.create ()
+
+    let get_timing s =
+      try
+        Hashtbl.find _timings s
+      with
+        Not_found -> []
+
+    let set_timing s v =
+      Hashtbl.replace _timings s v
+
+
+    let display_result fmt msg sub l =
+      let h = Hashtbl.create 0 in
+      let tmin, tmax, ttotal, len, memo, memn =
+        List.fold_left (fun
+        (atmin, atmax, attotal, alen, _, _)
+        (t, om, nm) ->
+          (min t atmin,
+           max atmax t,
+           attotal +. t,
+           alen + 1,
+           om, nm))
+          (infinity, 0., 0., 0, h, h) l
+      in
+      Logger.start_msg fmt "[Stats] ";
+      Logger.msg fmt "%s %s:@\n    @[<v 0>[" sub msg;
+      begin
+        if len <= 1 then
+        Logger.msg fmt
+          "@\n\
+| Time:           %fms@\n"
+          tmin
+      else
+        Logger.msg fmt
+          "@\n\
+| Number of runs: %i@\n\
+| Average time:   %fms@\n\
+| Minimum time:   %fms@\n\
+| Maximum time:   %fms@\n"
+          len
+          (ttotal /. (float_of_int len))
+          tmin
+          tmax
+
+      end;
+      Logger.msg fmt
+"| Memory before:  %a@\n\
+| Memory after:   %a@\n]@]"
+        System.pr_mem_status memo
+        System.pr_mem_status memn;
+      Logger.end_msg fmt "\n\n"
+
+
 let time f ?(count=1) ?(msg="") x =
   if not !Config.verbose then f x
   else
   let rec loop i =
-    Gc.compact();
     let oldmem = System.status () in
     let t1 = Unix.gettimeofday () in
+    set_timing msg ((t1, oldmem, oldmem)::(get_timing msg));
     let r = f x in
     let t2 = Unix.gettimeofday () in
     let newmem = System.status () in
+    let t1, oldmem, l =
+      match get_timing msg with
+        (a, b, _) :: l -> a,b,l
+      | _ -> assert false
+    in
     let t = (1000. *. (t2 -. t1)) in
-    Logger.verbose Format.err_formatter "@[%s: [" msg;
-    if (count != 1) then Logger.verbose Format.err_formatter "run %i/%i,  "  i count;
-    begin
-      Format.pp_open_vbox Format.err_formatter (2 + String.length msg);
-      Logger.verbose
-        Format.err_formatter
-        "@\n| Time: %fms@\n| Memory before: %a@\n| Memory after:  %a@\n]@]@]@\n" t System.pr_mem_status oldmem System.pr_mem_status newmem;
-    end;
+    set_timing msg ((t, oldmem, newmem)::l);
     if i >= count then r
     else loop (i+1)
   in
-  loop 1
-;;
+  Queue.push msg _t_queue;
+  let r = loop 1 in
+  begin
+    if (Queue.peek _t_queue) = msg then
+    let pr_stack = Queue.fold (fun a e -> e::a)  [] _t_queue in
+    Queue.clear _t_queue;
+    List.iter (fun msg' ->
+      let sub =
+        if msg' <> msg then "+" else "="
+      in
+      display_result Format.err_formatter msg' sub (get_timing msg')) pr_stack;
+  end;
+  r
+
+
+  end
+let time = Timing.time