From: Kim Nguyễn Date: Fri, 26 Oct 2012 12:08:14 +0000 (+0200) Subject: Merge branch 'master' of ssh://git.nguyen.vg/SXSI/xpathcomp X-Git-Url: http://git.nguyen.vg/gitweb/?a=commitdiff_plain;h=29fa227d5418c6346167f3ec46a68bff9f104392;hp=046839a3969319f5d38e8f72fe9cb640a639af6c;p=SXSI%2Fxpathcomp.git 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 --- 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 --- 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 --- 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 --- 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 @[ {"; + 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 @["; + 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 --- 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 @["; 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 --- 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 --- 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 --- 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 @[[" 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