From 683762965449e5e9fe66673e4d112ddd90faa40f Mon Sep 17 00:00:00 2001 From: Jules Villard Date: Wed, 19 Sep 2018 10:13:05 -0700 Subject: [PATCH] [perf] emit Trace Event json Summary: This adds an option `--trace-events` that generates a Chrome trace event[1] to quickly visualise the performance of infer. Reviewed By: mbouaziz Differential Revision: D9831599 fbshipit-source-id: 96a33c627 --- infer/src/backend/Tasks.ml | 14 +- infer/src/backend/mergeCapture.ml | 7 + infer/src/backend/ondemand.ml | 13 ++ infer/src/base/Config.ml | 9 + infer/src/base/Config.mli | 4 + infer/src/base/PerfEvent.ml | 285 ++++++++++++++++++++++++++++ infer/src/base/PerfEvent.mli | 44 +++++ infer/src/base/ProcessPool.ml | 7 + infer/src/base/ProcessPoolState.ml | 6 + infer/src/base/ProcessPoolState.mli | 4 + infer/src/base/ResultsDatabase.ml | 2 + infer/src/base/SqliteUtils.ml | 6 +- infer/src/biabduction/Prop.ml | 4 +- infer/src/integration/Driver.ml | 21 ++ infer/src/istd/Escape.ml | 2 + infer/src/istd/Escape.mli | 3 + 16 files changed, 424 insertions(+), 7 deletions(-) create mode 100644 infer/src/base/PerfEvent.ml create mode 100644 infer/src/base/PerfEvent.mli diff --git a/infer/src/backend/Tasks.ml b/infer/src/backend/Tasks.ml index 22804aeac..ef4c833c0 100644 --- a/infer/src/backend/Tasks.ml +++ b/infer/src/backend/Tasks.ml @@ -40,10 +40,16 @@ module Runner = struct type 'a t = 'a ProcessPool.t let create ~jobs ~f = - ProcessPool.create ~jobs ~f - ~child_prelude: - ((* hack: run post-fork bookkeeping stuff by passing a dummy function to [fork_protect] *) - fork_protect ~f:(fun () -> () )) + PerfEvent.( + log (fun logger -> log_begin_event logger ~categories:["sys"] ~name:"fork prepare" ())) ; + let pool = + ProcessPool.create ~jobs ~f + ~child_prelude: + ((* hack: run post-fork bookkeeping stuff by passing a dummy function to [fork_protect] *) + fork_protect ~f:(fun () -> () )) + in + PerfEvent.(log (fun logger -> log_end_event logger ())) ; + pool let run runner ~tasks = diff --git a/infer/src/backend/mergeCapture.ml b/infer/src/backend/mergeCapture.ml index 458db6244..a60f4a43d 100644 --- a/infer/src/backend/mergeCapture.ml +++ b/infer/src/backend/mergeCapture.ml @@ -153,3 +153,10 @@ let merge_captured_targets () = MergeResults.merge_buck_flavors_results infer_deps_file ; process_merge_file infer_deps_file ; L.progress "Merging captured Buck targets took %a@\n%!" Mtime.Span.pp (Mtime_clock.count time0) + + +(* shadowed for tracing *) +let merge_captured_targets () = + PerfEvent.(log (fun logger -> log_begin_event logger ~name:"merge buck targets" ())) ; + merge_captured_targets () ; + PerfEvent.(log (fun logger -> log_end_event logger ())) diff --git a/infer/src/backend/ondemand.ml b/infer/src/backend/ondemand.ml index a0dca52cd..c1ae47ad6 100644 --- a/infer/src/backend/ondemand.ml +++ b/infer/src/backend/ondemand.ml @@ -192,6 +192,19 @@ let run_proc_analysis analyze_proc ~caller_pdesc callee_pdesc = log_error_and_continue exn initial_summary (FKcrash (Exn.to_string exn)) ) +(* shadowed for tracing *) +let run_proc_analysis analyze_proc ~caller_pdesc callee_pdesc = + PerfEvent.( + log (fun logger -> + let callee_pname = Procdesc.get_proc_name callee_pdesc in + log_begin_event logger ~name:"ondemand" ~categories:["backend"] + ~arguments:[("proc", `String (Typ.Procname.to_string callee_pname))] + () )) ; + let summary = run_proc_analysis analyze_proc ~caller_pdesc callee_pdesc in + PerfEvent.(log (fun logger -> log_end_event logger ())) ; + summary + + let analyze_proc ?caller_pdesc callee_pdesc = let callbacks = Option.value_exn !callbacks_ref in (* wrap [callbacks.analyze_ondemand] to update the status bar *) diff --git a/infer/src/base/Config.ml b/infer/src/base/Config.ml index 587f3149b..0a8267a76 100644 --- a/infer/src/base/Config.ml +++ b/infer/src/base/Config.ml @@ -181,6 +181,8 @@ let duplicates_filename = "duplicates.txt" let events_dir_name = "events" +let trace_events_file = "perf_events.json" + (** exit code to use for the --fail-on-issue option *) let fail_on_issue_exit_code = 2 @@ -2145,6 +2147,11 @@ and threadsafe_aliases = "Specify custom annotations that should be considered aliases of @ThreadSafe" +and trace_events = + CLOpt.mk_bool ~long:"trace-events" + (Printf.sprintf "Emit Chrome performance trace events in infer-out/%s" trace_events_file) + + and trace_join = CLOpt.mk_bool ~deprecated:["trace_join"] ~long:"trace-join" "Detailed tracing information during prop join operations" @@ -2961,6 +2968,8 @@ and threadsafe_aliases = !threadsafe_aliases and trace_error = !trace_error +and trace_events = !trace_events + and trace_ondemand = !trace_ondemand and trace_join = !trace_join diff --git a/infer/src/base/Config.mli b/infer/src/base/Config.mli index 564eb93bf..704512d6d 100644 --- a/infer/src/base/Config.mli +++ b/infer/src/base/Config.mli @@ -195,6 +195,8 @@ val starvation_issues_dir_name : string val trace_absarray : bool +val trace_events_file : string + val undo_join : bool val unsafe_unret : string @@ -647,6 +649,8 @@ val threadsafe_aliases : Yojson.Basic.json val trace_error : bool +val trace_events : bool + val trace_ondemand : bool val trace_join : bool diff --git a/infer/src/base/PerfEvent.ml b/infer/src/base/PerfEvent.ml new file mode 100644 index 000000000..60a657a1f --- /dev/null +++ b/infer/src/base/PerfEvent.ml @@ -0,0 +1,285 @@ +(* + * Copyright (c) 2018-present, Facebook, Inc. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open! IStd +module F = Format +module L = Logging + +module Json = struct + (** do not break lines *) + let pp_seq pp f l = Pp.seq ~sep:"," pp f l + + let pp_string f s = F.fprintf f "\"%s\"" (Escape.escape_json s) + + let pp_field pp_value f field_name field_value = + Format.fprintf f "%a:%a" pp_string field_name pp_value field_value + + + (** only what we need for now *) + type t = [`Int of int | `String of string | `Assoc of (string * t) list | `List of t list] + + let rec pp_assoc_field f (key, value) = pp_field pp f key value + + and pp f = function + | `Int i -> + F.pp_print_int f i + | `String s -> + pp_string f s + | `Assoc fields -> + F.fprintf f "{%a}" (pp_seq pp_assoc_field) fields + | `List items -> + F.fprintf f "[%a]" (pp_seq pp) items +end + +module JsonFragment = struct + type t = AssocBegin | AssocEnd | ListBegin | ListItemSeparator | ListEnd + + let to_string = function + | AssocBegin -> + "AssocBegin" + | AssocEnd -> + "AssocEnd" + | ListBegin -> + "ListBegin" + | ListItemSeparator -> + "ListItemSeparator" + | ListEnd -> + "ListEnd" + + + type pp_state = Outside | InAssocFirst | InAssocMiddle | InList + + let string_of_state = function + | Outside -> + "Outside" + | InAssocFirst -> + "InAssocFirst" + | InAssocMiddle -> + "InAssocMiddle" + | InList -> + "InList" + + + (** for some limited (not thread-safe) form of safety, and to know when we need to print separators + *) + let pp_state = ref [Outside] + + let pp f json_fragment = + match (json_fragment, !pp_state) with + | AssocBegin, ((Outside | InList) :: _ as state) -> + pp_state := InAssocFirst :: state + | AssocEnd, (InAssocFirst | InAssocMiddle) :: state' -> + F.pp_print_string f "}" ; + pp_state := state' + | ListBegin, ((Outside | InList) :: _ as state) -> + F.pp_print_string f "[" ; + pp_state := InList :: state + | ListItemSeparator, InList :: _ -> + F.pp_print_string f "," + | ListEnd, InList :: state0 -> + F.pp_print_string f "]" ; + pp_state := state0 + | _ -> + L.die InternalError "Unexpected json fragment \"%s\" in state [%a]" + (to_string json_fragment) + (Pp.seq (Pp.to_string ~f:string_of_state)) + !pp_state + + + let pp_assoc_field pp_value f key value = + match !pp_state with + | InAssocFirst :: state0 -> + F.pp_print_string f "{" ; + Json.pp_field pp_value f key value ; + pp_state := InAssocMiddle :: state0 + | InAssocMiddle :: _ -> + F.pp_print_string f "," ; + Json.pp_field pp_value f key value + | _ -> + L.die InternalError "Unexpected assoc field \"%t\" in state [%a]" + (fun f -> Json.pp_field pp_value f key value) + (Pp.seq (Pp.to_string ~f:string_of_state)) + !pp_state +end + +type event_type = Begin | Complete | End | Instant + +(* TODO(2018): add [Thread] when we have multicore OCaml :) *) +type scope = Global | Process + +(* initialised at the start of the program *) +let t0 = Mtime_clock.now () + +let pp_arguments_field f arguments = + match arguments with + | [] -> + () + | _ :: _ -> + JsonFragment.pp_assoc_field Json.pp f "args" (`Assoc arguments) + + +let pp_categories_field f categories = + match categories with + | [] -> + () + | _ :: _ -> + let pp_categories f categories = + Format.fprintf f "\"%a\"" (Json.pp_seq F.pp_print_string) categories + in + JsonFragment.pp_assoc_field pp_categories f "cat" categories + + +let pp_duration_field f duration = + JsonFragment.pp_assoc_field Json.pp f "dur" (`Int (Mtime.Span.to_us duration |> Float.to_int)) + + +let pp_event_type_field f event_type = + let pp_event_type f event_type = + match event_type with + | Begin -> + Json.pp_string f "B" + | Complete -> + Json.pp_string f "X" + | End -> + Json.pp_string f "E" + | Instant -> + Json.pp_string f "i" + in + JsonFragment.pp_assoc_field pp_event_type f "ph" event_type + + +let pp_process_id_field f pid = JsonFragment.pp_assoc_field Pid.pp f "pid" pid + +let pp_name_field f name = JsonFragment.pp_assoc_field Json.pp f "name" (`String name) + +let pp_scope_field f scope = + let pp_scope f = function Global -> Json.pp_string f "g" | Process -> Json.pp_string f "p" in + JsonFragment.pp_assoc_field pp_scope f "s" scope + + +let pp_timestamp_field f ts_opt = + let ts = match ts_opt with None -> Mtime_clock.elapsed () | Some t -> Mtime.span t0 t in + JsonFragment.pp_assoc_field Json.pp f "ts" (`Int (Mtime.Span.to_us ts |> Float.to_int)) + + +let log_begin_event f ?timestamp ?categories ?arguments ~name () = + JsonFragment.pp f AssocBegin ; + pp_event_type_field f Begin ; + pp_name_field f name ; + pp_timestamp_field f timestamp ; + pp_process_id_field f (ProcessPoolState.get_pid ()) ; + Option.iter categories ~f:(pp_categories_field f) ; + Option.iter arguments ~f:(pp_arguments_field f) ; + JsonFragment.pp f AssocEnd + + +let log_end_event f ?timestamp ?arguments () = + JsonFragment.pp f AssocBegin ; + pp_event_type_field f End ; + pp_timestamp_field f timestamp ; + Option.iter arguments ~f:(pp_arguments_field f) ; + pp_process_id_field f (ProcessPoolState.get_pid ()) ; + JsonFragment.pp f AssocEnd + + +let log_complete_event f ~timestamp ?duration ?categories ?arguments ~name () = + JsonFragment.pp f AssocBegin ; + pp_event_type_field f Complete ; + pp_name_field f name ; + pp_timestamp_field f (Some timestamp) ; + pp_process_id_field f (ProcessPoolState.get_pid ()) ; + Option.iter duration ~f:(pp_duration_field f) ; + Option.iter categories ~f:(pp_categories_field f) ; + Option.iter arguments ~f:(pp_arguments_field f) ; + JsonFragment.pp f AssocEnd + + +let log_instant_event f ?timestamp ~name scope = + JsonFragment.pp f AssocBegin ; + pp_event_type_field f Instant ; + pp_name_field f name ; + pp_timestamp_field f timestamp ; + pp_process_id_field f (ProcessPoolState.get_pid ()) ; + pp_scope_field f scope ; + JsonFragment.pp f AssocEnd + + +type logger = F.formatter + +let register_gc_stats logger = + let alarms = ref [] in + let gc_alarm = Gc.Expert.Alarm.create (fun () -> alarms := Mtime_clock.now () :: !alarms) in + Epilogues.register ~description:"recording gc alarms" ~f:(fun () -> + Gc.Expert.Alarm.delete gc_alarm ; + List.iter !alarms ~f:(fun timestamp -> + log_instant_event logger ~timestamp ~name:"gc_major" Process ; + JsonFragment.pp logger ListItemSeparator ; + F.fprintf logger "%!" ) ) + + +let logger = + lazy + (let log_file = + let results_dir = + (* if invoked in a sub-dir (e.g., in Buck integrations), log inside the original log + file *) + Sys.getenv Config.infer_top_results_dir_env_var + |> Option.value ~default:Config.results_dir + in + results_dir ^/ Config.trace_events_file + in + let is_toplevel_process = CommandLineOption.is_originator && not !ProcessPoolState.in_child in + ( if is_toplevel_process then + let preexisting_logfile = PolyVariantEqual.( = ) (Sys.file_exists log_file) `Yes in + if preexisting_logfile then Unix.unlink log_file ) ; + let out_channel = Pervasives.open_out_gen [Open_append; Open_creat] 0o666 log_file in + let logger = F.formatter_of_out_channel out_channel in + register_gc_stats logger ; + if is_toplevel_process then ( + JsonFragment.pp logger ListBegin ; + F.fprintf logger "%!" ; + Epilogues.register_late ~description:"closing perf trace json" ~f:(fun () -> + log_instant_event logger ~name:"end" Global ; + JsonFragment.pp logger ListEnd ; + F.fprintf logger "@." ; + Out_channel.close out_channel ) ) ; + logger) + + +(* export logging functions that output a list element at a time and flushes so that multiple + processes can write to the same file and not garble each other's output. This should mostly work + as appending to a file is atomic as long as the write is not too big. *) + +let log_begin_event f ?timestamp ?categories ?arguments ~name () = + log_begin_event f ?timestamp ?categories ?arguments ~name () ; + JsonFragment.pp f ListItemSeparator ; + F.fprintf f "%!" + + +let log_end_event f ?timestamp ?arguments () = + log_end_event f ?timestamp ?arguments () ; + JsonFragment.pp f ListItemSeparator ; + F.fprintf f "%!" + + +let log_complete_event f ~timestamp ?duration ?categories ?arguments ~name () = + log_complete_event f ~timestamp ?duration ?categories ?arguments ~name () ; + JsonFragment.pp f ListItemSeparator ; + F.fprintf f "%!" + + +let log_instant_event f ?timestamp ~name scope = + log_instant_event f ?timestamp ~name scope ; + JsonFragment.pp f ListItemSeparator ; + F.fprintf f "%!" + + +let log = + if Config.trace_events then fun f_log -> + let logger = Lazy.force logger in + f_log logger + else fun _ -> () diff --git a/infer/src/base/PerfEvent.mli b/infer/src/base/PerfEvent.mli new file mode 100644 index 000000000..0d1598123 --- /dev/null +++ b/infer/src/base/PerfEvent.mli @@ -0,0 +1,44 @@ +(* + * Copyright (c) 2018-present, Facebook, Inc. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open! IStd + +module Json : sig + (** only what we need for now *) + type t = [`Int of int | `String of string | `Assoc of (string * t) list | `List of t list] +end + +type scope = Global | Process + +type logger + +val log_begin_event : + logger + -> ?timestamp:Mtime.t + -> ?categories:string list + -> ?arguments:(string * Json.t) list + -> name:string + -> unit + -> unit + +val log_end_event : + logger -> ?timestamp:Mtime.t -> ?arguments:(string * Json.t) list -> unit -> unit + +val log_complete_event : + logger + -> timestamp:Mtime.t + -> ?duration:Mtime.Span.t + -> ?categories:string list + -> ?arguments:(string * Json.t) list + -> name:string + -> unit + -> unit + [@@warning "-32"] + +val log_instant_event : logger -> ?timestamp:Mtime.t -> name:string -> scope -> unit + +val log : (logger -> unit) -> unit diff --git a/infer/src/base/ProcessPool.ml b/infer/src/base/ProcessPool.ml index 0069a1a5f..0ed323394 100644 --- a/infer/src/base/ProcessPool.ml +++ b/infer/src/base/ProcessPool.ml @@ -202,6 +202,7 @@ let fork_child ~child_prelude ~slot (updates_r, updates_w) ~f = (* Pin to a core. [setcore] does the modulo for us. *) Setcore.setcore slot ; ProcessPoolState.in_child := true ; + ProcessPoolState.reset_pid () ; child_prelude () ; let updates_oc = Unix.out_channel_of_descr updates_w in let send_to_parent (message : worker_message) = marshal_to_pipe updates_oc message in @@ -261,3 +262,9 @@ let run pool tasks = done ; wait_all pool ; TaskBar.finish pool.task_bar + + +let run pool tasks = + PerfEvent.(log (fun logger -> log_instant_event logger ~name:"start process pool" Global)) ; + run pool tasks ; + PerfEvent.(log (fun logger -> log_instant_event logger ~name:"end process pool" Global)) diff --git a/infer/src/base/ProcessPoolState.ml b/infer/src/base/ProcessPoolState.ml index 8ccc81ddf..8166e6cf9 100644 --- a/infer/src/base/ProcessPoolState.ml +++ b/infer/src/base/ProcessPoolState.ml @@ -11,3 +11,9 @@ open! IStd let in_child = ref false let update_status = ref (fun _ _ -> ()) + +let pid = ref (lazy (Unix.getpid ())) + +let reset_pid () = pid := lazy (Unix.getpid ()) + +let get_pid () = Lazy.force !pid diff --git a/infer/src/base/ProcessPoolState.mli b/infer/src/base/ProcessPoolState.mli index e60a43150..f9700a7f3 100644 --- a/infer/src/base/ProcessPoolState.mli +++ b/infer/src/base/ProcessPoolState.mli @@ -13,3 +13,7 @@ val in_child : bool ref val update_status : (Mtime.t -> string -> unit) ref (** Ping the task bar whenever a new task is started with the start time and a description for the task *) + +val get_pid : unit -> Pid.t + +val reset_pid : unit -> unit diff --git a/infer/src/base/ResultsDatabase.ml b/infer/src/base/ResultsDatabase.ml index ffd7e5005..787aa6621 100644 --- a/infer/src/base/ResultsDatabase.ml +++ b/infer/src/base/ResultsDatabase.ml @@ -97,9 +97,11 @@ let register_statement = let with_registered_statement get_stmt ~f = + PerfEvent.(log (fun logger -> log_begin_event logger ~name:"sql op" ())) ; let stmt, db = get_stmt () in let result = f db stmt in Sqlite3.reset stmt |> SqliteUtils.check_result_code db ~log:"reset prepared statement" ; + PerfEvent.(log (fun logger -> log_end_event logger ())) ; result diff --git a/infer/src/base/SqliteUtils.ml b/infer/src/base/SqliteUtils.ml index 37df4e2cb..2d0aa090f 100644 --- a/infer/src/base/SqliteUtils.ml +++ b/infer/src/base/SqliteUtils.ml @@ -23,7 +23,11 @@ let check_result_code ?(fatal = false) db ~log rc = let exec db ~log ~stmt = (* Call [check_result_code] with [fatal:true] and catch exceptions to rewrite the error message. This avoids allocating the error string when not needed. *) - try check_result_code ~fatal:true db ~log (Sqlite3.exec db stmt) with Error err -> + PerfEvent.log (fun logger -> + PerfEvent.log_begin_event logger ~name:"sql exec" ~arguments:[("stmt", `String log)] () ) ; + let rc = Sqlite3.exec db stmt in + PerfEvent.(log (fun logger -> log_end_event logger ())) ; + try check_result_code ~fatal:true db ~log rc with Error err -> error ~fatal:true "exec: %s (%s)" err (Sqlite3.errmsg db) diff --git a/infer/src/biabduction/Prop.ml b/infer/src/biabduction/Prop.ml index 3c9f228bc..8fe6c7980 100644 --- a/infer/src/biabduction/Prop.ml +++ b/infer/src/biabduction/Prop.ml @@ -2648,6 +2648,6 @@ let mk_ptsto_exp = Normalize.mk_ptsto_exp let mk_ptsto = Normalize.mk_ptsto -let normalize = Normalize.normalize +let normalize tenv prop = Normalize.normalize tenv prop -let prop_atom_and = Normalize.prop_atom_and +let prop_atom_and tenv ?footprint prop atom = Normalize.prop_atom_and tenv ?footprint prop atom diff --git a/infer/src/integration/Driver.ml b/infer/src/integration/Driver.ml index 3e81efc48..203f06154 100644 --- a/infer/src/integration/Driver.ml +++ b/infer/src/integration/Driver.ml @@ -298,12 +298,26 @@ let capture ~changed_files = function capture_with_compilation_database ~changed_files json_cdb +(* shadowed for tracing *) +let capture ~changed_files mode = + PerfEvent.(log (fun logger -> log_begin_event logger ~name:"capture" ())) ; + capture ~changed_files mode ; + PerfEvent.(log (fun logger -> log_end_event logger ())) + + let execute_analyze ~changed_files = register_perf_stats_report PerfStats.TotalBackend ; InferAnalyze.main ~changed_files ; PerfStats.get_reporter PerfStats.TotalBackend () +(* shadowed for tracing *) +let execute_analyze ~changed_files = + PerfEvent.(log (fun logger -> log_begin_event logger ~name:"analyze" ())) ; + execute_analyze ~changed_files ; + PerfEvent.(log (fun logger -> log_end_event logger ())) + + let report ?(suppress_console = false) () = let report_json = Config.(results_dir ^/ report_json) in InferPrint.main ~report_json:(Some report_json) ; @@ -336,6 +350,13 @@ let report ?(suppress_console = false) () = (String.concat ~sep:" " args) +(* shadowed for tracing *) +let report ?suppress_console () = + PerfEvent.(log (fun logger -> log_begin_event logger ~name:"report" ())) ; + report ?suppress_console () ; + PerfEvent.(log (fun logger -> log_end_event logger ())) + + let error_nothing_to_analyze mode = let clean_command_opt = clean_compilation_command mode in let nothing_to_compile_msg = "Nothing to compile." in diff --git a/infer/src/istd/Escape.ml b/infer/src/istd/Escape.ml index 07b001d5f..2312dbea5 100644 --- a/infer/src/istd/Escape.ml +++ b/infer/src/istd/Escape.ml @@ -130,6 +130,8 @@ let escape_filename s = escape_map map s +let escape_json s = escape_map (function '"' -> Some "\\\"" | '\\' -> Some "\\\\" | _ -> None) s + let escape_double_quotes s = escape_map (function '"' -> Some "\\\"" | _ -> None) s let escape_in_single_quotes s = diff --git a/infer/src/istd/Escape.mli b/infer/src/istd/Escape.mli index 1450c77f6..85472d3e8 100644 --- a/infer/src/istd/Escape.mli +++ b/infer/src/istd/Escape.mli @@ -27,6 +27,9 @@ val escape_url : string -> string val escape_filename : string -> string (** escape a string to be used as a file name *) +val escape_json : string -> string +(** escape characters in the string so it becomes a valid JSON string *) + val escape_double_quotes : string -> string (** replaces double-quote with backslash double-quote *)