From da3561a53355a138e953acf92ec00338c1da64f0 Mon Sep 17 00:00:00 2001 From: Jules Villard Date: Thu, 2 Jul 2020 04:38:32 -0700 Subject: [PATCH] [log] fix gc stats merging Summary: Messed up the aggregation of GC stats in the previous commit. It's cleaner to have GC stats (and analysis time) outside of BackendStats as the rules for computing them is different than the rest, eg notice how "analysis time" needed to be corrected at the end of the run, and similarly for GC stats. Thus, refactor this part. Also output different aggregations of GC stats: +/max/average. Reviewed By: skcho Differential Revision: D22332496 fbshipit-source-id: eefd9dd72 --- infer/src/backend/BackendStats.ml | 72 +++++------------ infer/src/backend/BackendStats.mli | 13 +--- infer/src/backend/ExecutionDuration.ml | 20 ++++- infer/src/backend/ExecutionDuration.mli | 11 +-- infer/src/backend/GCStats.ml | 77 +++++++++++++------ infer/src/backend/GCStats.mli | 21 ++--- infer/src/backend/InferAnalyze.ml | 41 +++++++--- infer/src/backend/Tasks.ml | 13 +--- infer/src/backend/Tasks.mli | 4 +- infer/src/base/ForkUtils.mli | 11 +++ infer/src/base/ProcessPool.ml | 10 +-- infer/src/base/ProcessPool.mli | 2 +- infer/src/inferunit.ml | 2 +- .../integration/CaptureCompilationDatabase.ml | 6 +- 14 files changed, 165 insertions(+), 138 deletions(-) create mode 100644 infer/src/base/ForkUtils.mli diff --git a/infer/src/backend/BackendStats.ml b/infer/src/backend/BackendStats.ml index fd5c8b29b..224f9ae1c 100644 --- a/infer/src/backend/BackendStats.ml +++ b/infer/src/backend/BackendStats.ml @@ -23,12 +23,7 @@ include struct ; mutable proc_locker_lock_time: ExecutionDuration.t ; mutable proc_locker_unlock_time: ExecutionDuration.t ; mutable restart_scheduler_useful_time: ExecutionDuration.t - ; mutable restart_scheduler_total_time: ExecutionDuration.t - ; mutable scheduler_process_analysis_time: ExecutionDuration.t - (** - [scheduler_process_analysis_time.wall] counts the wall time of the analysis phase - - [scheduler_process_analysis_time.(user|sys)] counts the [(user|sys)] time only of - the scheduler_process *) - ; mutable gc_stats: GCStats.t option } + ; mutable restart_scheduler_total_time: ExecutionDuration.t } [@@deriving fields] end @@ -43,9 +38,7 @@ let global_stats = ; proc_locker_lock_time= ExecutionDuration.zero ; proc_locker_unlock_time= ExecutionDuration.zero ; restart_scheduler_useful_time= ExecutionDuration.zero - ; restart_scheduler_total_time= ExecutionDuration.zero - ; scheduler_process_analysis_time= ExecutionDuration.zero - ; gc_stats= None } + ; restart_scheduler_total_time= ExecutionDuration.zero } let get () = global_stats @@ -92,11 +85,6 @@ let add_to_restart_scheduler_total_time execution_duration = add Fields.restart_scheduler_total_time execution_duration -let set_analysis_time stats execution_duration = - let set_opt = Field.setter Fields.scheduler_process_analysis_time in - Option.iter set_opt ~f:(fun set -> set stats execution_duration) - - let copy from ~into : unit = let { summary_file_try_load ; summary_read_from_disk @@ -108,16 +96,13 @@ let copy from ~into : unit = ; proc_locker_lock_time ; proc_locker_unlock_time ; restart_scheduler_useful_time - ; restart_scheduler_total_time - ; scheduler_process_analysis_time - ; gc_stats } = + ; restart_scheduler_total_time } = from in Fields.Direct.set_all_mutable_fields into ~summary_file_try_load ~summary_read_from_disk ~summary_cache_hits ~summary_cache_misses ~ondemand_procs_analyzed ~ondemand_local_cache_hits ~ondemand_local_cache_misses ~proc_locker_lock_time ~proc_locker_unlock_time - ~restart_scheduler_useful_time ~restart_scheduler_total_time ~scheduler_process_analysis_time - ~gc_stats + ~restart_scheduler_useful_time ~restart_scheduler_total_time let merge stats1 stats2 = @@ -138,8 +123,7 @@ let merge stats1 stats2 = stats2.restart_scheduler_useful_time ; restart_scheduler_total_time= ExecutionDuration.add stats1.restart_scheduler_total_time stats2.restart_scheduler_total_time - ; scheduler_process_analysis_time= ExecutionDuration.zero - ; gc_stats= Option.merge stats1.gc_stats stats2.gc_stats ~f:GCStats.merge } + } let initial = @@ -153,22 +137,12 @@ let initial = ; proc_locker_lock_time= ExecutionDuration.zero ; proc_locker_unlock_time= ExecutionDuration.zero ; restart_scheduler_useful_time= ExecutionDuration.zero - ; restart_scheduler_total_time= ExecutionDuration.zero - ; scheduler_process_analysis_time= ExecutionDuration.zero - ; gc_stats= None } - + ; restart_scheduler_total_time= ExecutionDuration.zero } -let reset () = - copy initial ~into:global_stats ; - global_stats.gc_stats <- Some (GCStats.get ~since:ProgramStart) +let reset () = copy initial ~into:global_stats let pp f stats = - let pp_field pp_value stats f field = - let field_value = Field.get field stats in - let field_name = Field.name field in - F.fprintf f "%s = %a@;" field_name pp_value field_value - in let pp_hit_percent hit miss f = let total = hit + miss in if Int.equal total 0 then F.pp_print_string f "N/A%%" else F.fprintf f "%d%%" (hit * 100 / total) @@ -179,7 +153,7 @@ let pp f stats = let pp_execution_duration_field stats f field = let field_value = Field.get field stats in let field_name = Field.name field in - F.fprintf f "%a@;" (ExecutionDuration.pp ~field:field_name) field_value + F.fprintf f "%a@;" (ExecutionDuration.pp ~prefix:field_name) field_value in let pp_cache_hits stats cache_misses f cache_hits_field = let cache_hits = Field.get cache_hits_field stats in @@ -197,8 +171,6 @@ let pp f stats = ~proc_locker_unlock_time:(pp_execution_duration_field stats f) ~restart_scheduler_useful_time:(pp_execution_duration_field stats f) ~restart_scheduler_total_time:(pp_execution_duration_field stats f) - ~scheduler_process_analysis_time:(pp_execution_duration_field stats f) - ~gc_stats:(pp_field (Pp.option GCStats.pp) stats f) in F.fprintf f "@[Backend stats:@\n@[ %t@]@]@." (pp_stats stats) @@ -207,21 +179,9 @@ let log_to_scuba stats = let create_counter field = [LogEntry.mk_count ~label:("backend_stats." ^ Field.name field) ~value:(Field.get field stats)] in - let secs_to_ms s = s *. 1000. |> Float.to_int in let create_time_entry field = - let field_value = Field.get field stats in - [ LogEntry.mk_time - ~label:("backend_stats." ^ Field.name field ^ "_sys") - ~duration_ms:(ExecutionDuration.sys_time field_value |> secs_to_ms) - ; LogEntry.mk_time - ~label:("backend_stats." ^ Field.name field ^ "_user") - ~duration_ms:(ExecutionDuration.user_time field_value |> secs_to_ms) - ; LogEntry.mk_time - ~label:("backend_stats." ^ Field.name field ^ "_wall") - ~duration_ms:(ExecutionDuration.wall_time field_value |> secs_to_ms) ] - in - let create_scuba_option scuba_creator field = - match Field.get field stats with None -> [] | Some value -> scuba_creator value + Field.get field stats + |> ExecutionDuration.to_scuba_entries ~prefix:("backend_stats." ^ Field.name field) in let entries = Fields.to_list ~summary_file_try_load:create_counter ~summary_read_from_disk:create_counter @@ -230,8 +190,16 @@ let log_to_scuba stats = ~ondemand_local_cache_misses:create_counter ~proc_locker_lock_time:create_time_entry ~proc_locker_unlock_time:create_time_entry ~restart_scheduler_useful_time:create_time_entry ~restart_scheduler_total_time:create_time_entry - ~scheduler_process_analysis_time:create_time_entry - ~gc_stats:(create_scuba_option (GCStats.to_scuba_entries ~prefix:"backend")) |> List.concat in ScubaLogging.log_many entries + + +let log_aggregate stats_list = + match stats_list with + | [] -> + L.internal_error "Empty list of backend stats to aggregate, weird!@\n" + | one :: rest -> + let stats = List.fold rest ~init:one ~f:(fun aggregate one -> merge aggregate one) in + L.debug Analysis Quiet "%a" pp stats ; + log_to_scuba stats diff --git a/infer/src/backend/BackendStats.mli b/infer/src/backend/BackendStats.mli index 2d2cb4b53..1141fd5bd 100644 --- a/infer/src/backend/BackendStats.mli +++ b/infer/src/backend/BackendStats.mli @@ -10,8 +10,6 @@ open! IStd type t -val initial : t - val incr_summary_file_try_load : unit -> unit (** a query to the filesystem attempting to load a summary file *) @@ -36,18 +34,11 @@ val add_to_restart_scheduler_total_time : ExecutionDuration.t -> unit val add_to_restart_scheduler_useful_time : ExecutionDuration.t -> unit -val set_analysis_time : t -> ExecutionDuration.t -> unit - val reset : unit -> unit (** reset all stats *) val get : unit -> t (** get the stats so far *) -val pp : Format.formatter -> t -> unit - -val merge : t -> t -> t -(** return a new value that adds up the stats in both arguments *) - -val log_to_scuba : t -> unit -(** Log aggregated backend stats to Scuba. Use after the stats have been fully calculated *) +val log_aggregate : t list -> unit +(** log aggregated stats to infer's log file and to Scuba *) diff --git a/infer/src/backend/ExecutionDuration.ml b/infer/src/backend/ExecutionDuration.ml index 0e9944cd9..11e601a9a 100644 --- a/infer/src/backend/ExecutionDuration.ml +++ b/infer/src/backend/ExecutionDuration.ml @@ -7,6 +7,7 @@ open! IStd module F = Format +module L = Logging module Duration = struct type t = {time: float; comp: float} @@ -59,9 +60,9 @@ let sys_time exe_duration = Duration.secs exe_duration.sys let wall_time exe_duration = Mtime.Span.to_s exe_duration.wall -let pp ~field fmt exe_duration = - F.fprintf fmt "%s_user= %.8f@;%s_sys= %.8f@;%s_wall= %.8f" field (user_time exe_duration) field - (sys_time exe_duration) field (wall_time exe_duration) +let pp ~prefix fmt exe_duration = + F.fprintf fmt "%s_user= %.8f@;%s_sys= %.8f@;%s_wall= %.8f" prefix (user_time exe_duration) prefix + (sys_time exe_duration) prefix (wall_time exe_duration) let counter () = {process_times= Unix.times (); wall_time= Mtime_clock.counter ()} @@ -70,3 +71,16 @@ let timed_evaluate ~f = let start = counter () in let result = f () in {result; execution_duration= since start} + + +let to_scuba_entries ~prefix exe_duration = + let secs_to_ms s = s *. 1000. |> Float.to_int in + [ LogEntry.mk_time ~label:(prefix ^ "_sys") ~duration_ms:(sys_time exe_duration |> secs_to_ms) + ; LogEntry.mk_time ~label:(prefix ^ "_user") ~duration_ms:(user_time exe_duration |> secs_to_ms) + ; LogEntry.mk_time ~label:(prefix ^ "_wall") ~duration_ms:(wall_time exe_duration |> secs_to_ms) + ] + + +let log ~prefix debug_kind exe_duration = + L.debug debug_kind Quiet "%a@\n" (pp ~prefix) exe_duration ; + ScubaLogging.log_many (to_scuba_entries ~prefix exe_duration) diff --git a/infer/src/backend/ExecutionDuration.mli b/infer/src/backend/ExecutionDuration.mli index 5a9467cd7..6dad02b01 100644 --- a/infer/src/backend/ExecutionDuration.mli +++ b/infer/src/backend/ExecutionDuration.mli @@ -23,12 +23,13 @@ val add_duration_since : t -> counter -> t val add : t -> t -> t -val user_time : t -> float - -val sys_time : t -> float - val wall_time : t -> float -val pp : field:string -> Format.formatter -> t -> unit +val pp : prefix:string -> Format.formatter -> t -> unit val timed_evaluate : f:(unit -> 'a) -> 'a evaluation_result + +val log : prefix:string -> Logging.debug_kind -> t -> unit +(** log to debug logs and to Scuba *) + +val to_scuba_entries : prefix:string -> t -> LogEntry.t list diff --git a/infer/src/backend/GCStats.ml b/infer/src/backend/GCStats.ml index bb360f50d..f43c4413c 100644 --- a/infer/src/backend/GCStats.ml +++ b/infer/src/backend/GCStats.ml @@ -18,8 +18,7 @@ type t = ; minor_collections: int ; major_collections: int ; compactions: int - ; max_top_heap_words: int (** like [Gc.top_heap_words], aggregated with [max] *) - ; added_top_heap_words: int (** like [Gc.top_heap_words], aggregated with [(+)] *) } + ; top_heap_words: int } type since = ProgramStart | PreviousStats of t @@ -33,8 +32,7 @@ let get ~since = ; minor_collections= stats.minor_collections ; major_collections= stats.major_collections ; compactions= stats.compactions - ; max_top_heap_words= stats.top_heap_words - ; added_top_heap_words= stats.top_heap_words } + ; top_heap_words= stats.top_heap_words } | PreviousStats stats_prev -> (* [top_heap_words] is going to be inaccurate if it was reached in the previous time period *) { minor_words= stats.minor_words -. stats_prev.minor_words @@ -43,19 +41,7 @@ let get ~since = ; minor_collections= stats.minor_collections - stats_prev.minor_collections ; major_collections= stats.major_collections - stats_prev.major_collections ; compactions= stats.compactions - stats_prev.compactions - ; max_top_heap_words= stats.top_heap_words - ; added_top_heap_words= stats.top_heap_words } - - -let merge stats1 stats2 = - { minor_words= stats1.minor_words +. stats2.minor_words - ; promoted_words= stats1.promoted_words +. stats2.promoted_words - ; major_words= stats1.major_words +. stats2.major_words - ; minor_collections= stats1.minor_collections + stats2.minor_collections - ; major_collections= stats1.major_collections + stats2.major_collections - ; compactions= stats1.compactions + stats2.compactions - ; max_top_heap_words= max stats1.max_top_heap_words stats2.max_top_heap_words - ; added_top_heap_words= stats1.added_top_heap_words + stats2.added_top_heap_words } + ; top_heap_words= stats.top_heap_words } let pp f @@ -65,8 +51,7 @@ let pp f ; minor_collections ; major_collections ; compactions - ; max_top_heap_words - ; added_top_heap_words }[@warning "+9"]) = + ; top_heap_words }[@warning "+9"]) = F.fprintf f "@[ minor_words: %g@;\ promoted_words: %g@;\ @@ -74,11 +59,10 @@ let pp f minor_collections: %d@;\ major_collections: %d@;\ compactions: %d@;\ - max top_heap_words: %d@;\ - cumulative top_heap_words: %d@;\ + top_heap_words: %d@;\ @]" minor_words promoted_words major_words minor_collections major_collections compactions - max_top_heap_words added_top_heap_words + top_heap_words let to_scuba_entries ~prefix (stats : t) = @@ -91,8 +75,7 @@ let to_scuba_entries ~prefix (stats : t) = ; create_counter "minor_collections" stats.minor_collections ; create_counter "major_collections" stats.major_collections ; create_counter "compactions" stats.compactions - ; create_counter "max_top_heap_words" stats.max_top_heap_words - ; create_counter "added_top_heap_words" stats.added_top_heap_words ] + ; create_counter "top_heap_words" stats.top_heap_words ] let log_to_scuba ~prefix stats = ScubaLogging.log_many (to_scuba_entries ~prefix stats) @@ -108,3 +91,49 @@ let log_f ~name debug_kind f = let stats_f = get ~since:(PreviousStats stats_before_f) in log ~name debug_kind stats_f ; r + + +let merge_add stats1 stats2 = + { minor_words= stats1.minor_words +. stats2.minor_words + ; promoted_words= stats1.promoted_words +. stats2.promoted_words + ; major_words= stats1.major_words +. stats2.major_words + ; minor_collections= stats1.minor_collections + stats2.minor_collections + ; major_collections= stats1.major_collections + stats2.major_collections + ; compactions= stats1.compactions + stats2.compactions + ; top_heap_words= stats1.top_heap_words + stats2.top_heap_words } + + +let merge_max stats1 stats2 = + { minor_words= Float.max stats1.minor_words stats2.minor_words + ; promoted_words= Float.max stats1.promoted_words stats2.promoted_words + ; major_words= Float.max stats1.major_words stats2.major_words + ; minor_collections= max stats1.minor_collections stats2.minor_collections + ; major_collections= max stats1.major_collections stats2.major_collections + ; compactions= max stats1.compactions stats2.compactions + ; top_heap_words= max stats1.top_heap_words stats2.top_heap_words } + + +let log_aggregate ~prefix debug_kind stats_list = + match stats_list with + | [] -> + () + | [stats] -> + log ~name:prefix debug_kind stats + | stats_one :: stats_rest -> + let stats_add = List.fold ~init:stats_one stats_rest ~f:merge_add in + let stats_max = List.fold ~init:stats_one stats_rest ~f:merge_max in + let n = List.length stats_list in + let stats_average = + let n_f = Float.of_int n in + { minor_words= stats_add.minor_words /. n_f + ; promoted_words= stats_add.promoted_words /. n_f + ; major_words= stats_add.major_words /. n_f + ; minor_collections= stats_add.minor_collections / n + ; major_collections= stats_add.major_collections / n + ; compactions= stats_add.compactions / n + ; top_heap_words= stats_add.top_heap_words / n } + in + log ~name:(prefix ^ "gc_stats_add.") debug_kind stats_add ; + log ~name:(prefix ^ "gc_stats_max.") debug_kind stats_max ; + L.debug debug_kind Quiet "Average over %d processes@\n" n ; + log ~name:(prefix ^ "gc_stats_average.") debug_kind stats_average diff --git a/infer/src/backend/GCStats.mli b/infer/src/backend/GCStats.mli index 15f269882..4be437fb9 100644 --- a/infer/src/backend/GCStats.mli +++ b/infer/src/backend/GCStats.mli @@ -6,20 +6,10 @@ *) open! IStd -module F = Format module L = Logging type t -val pp : F.formatter -> t -> unit - -val log : name:string -> L.debug_kind -> t -> unit -(** log to infer's log file and to Scuba *) - -val log_f : name:string -> L.debug_kind -> (unit -> 'a) -> 'a -(** log GC stats for the duration of the function passed as argument to infer's log file and to - Scuba *) - type since = | ProgramStart (** get GC stats from the beginning of the program *) | PreviousStats of t @@ -28,7 +18,12 @@ type since = val get : since:since -> t -val merge : t -> t -> t -(** combine statistics from two processes *) +val log : name:string -> L.debug_kind -> t -> unit +(** log to infer's log file and to Scuba *) + +val log_aggregate : prefix:string -> L.debug_kind -> t list -> unit +(** log aggregate to infer's log file and to Scuba *) -val to_scuba_entries : prefix:string -> t -> LogEntry.t list +val log_f : name:string -> L.debug_kind -> (unit -> 'a) -> 'a +(** log GC stats for the duration of the function passed as argument to infer's log file and to + Scuba *) diff --git a/infer/src/backend/InferAnalyze.ml b/infer/src/backend/InferAnalyze.ml index eeec1c278..f5ad78f01 100644 --- a/infer/src/backend/InferAnalyze.ml +++ b/infer/src/backend/InferAnalyze.ml @@ -132,8 +132,9 @@ let analyze source_files_to_analyze = let target_files = List.rev_map (Lazy.force source_files_to_analyze) ~f:(fun sf -> TaskSchedulerTypes.File sf) in + let pre_analysis_gc_stats = GCStats.get ~since:ProgramStart in Tasks.run_sequentially ~f:analyze_target target_files ; - BackendStats.get () ) + ([BackendStats.get ()], [GCStats.get ~since:(PreviousStats pre_analysis_gc_stats)]) ) else ( L.environment_info "Parallel jobs: %d@." Config.jobs ; let build_tasks_generator () = @@ -142,18 +143,37 @@ let analyze source_files_to_analyze = (* Prepare tasks one file at a time while executing in parallel *) RestartScheduler.setup () ; let runner = - Tasks.Runner.create ~jobs:Config.jobs ~f:analyze_target ~child_epilogue:BackendStats.get + (* use a ref to pass data from prologue to epilogue without too much machinery *) + let gc_stats_pre_fork = ref None in + let child_prologue () = + BackendStats.reset () ; + gc_stats_pre_fork := Some (GCStats.get ~since:ProgramStart) + in + let child_epilogue () = + let gc_stats_in_fork = + match !gc_stats_pre_fork with + | Some stats -> + Some (GCStats.get ~since:(PreviousStats stats)) + | None -> + L.internal_error "child did not store GC stats in its prologue, what happened?" ; + None + in + (BackendStats.get (), gc_stats_in_fork) + in + Tasks.Runner.create ~jobs:Config.jobs ~f:analyze_target ~child_prologue ~child_epilogue ~tasks:build_tasks_generator in let workers_stats = Tasks.Runner.run runner in RestartScheduler.clean () ; let collected_stats = - Array.fold workers_stats ~init:BackendStats.initial ~f:(fun collated_stats stats_opt -> + Array.fold workers_stats ~init:([], []) + ~f:(fun ((backend_stats_list, gc_stats_list) as stats_list) stats_opt -> match stats_opt with | None -> - collated_stats - | Some stats -> - BackendStats.merge stats collated_stats ) + stats_list + | Some (backend_stats, gc_stats_opt) -> + ( backend_stats :: backend_stats_list + , Option.fold ~init:gc_stats_list ~f:(fun l x -> x :: l) gc_stats_opt ) ) in collected_stats ) @@ -208,11 +228,12 @@ let main ~changed_files = let source_files = lazy (get_source_files_to_analyze ~changed_files) in (* empty all caches to minimize the process heap to have less work to do when forking *) clear_caches () ; - let stats = analyze source_files in + let backend_stats_list, gc_stats_list = analyze source_files in + BackendStats.log_aggregate backend_stats_list ; + GCStats.log_aggregate ~prefix:"backend_stats." Analysis gc_stats_list ; let analysis_duration = ExecutionDuration.since start in - BackendStats.set_analysis_time stats analysis_duration ; L.debug Analysis Quiet "Analysis phase finished in %a@\n" Mtime.Span.pp_float_s (ExecutionDuration.wall_time analysis_duration) ; - L.debug Analysis Quiet "Collected stats:@\n%a@." BackendStats.pp stats ; - BackendStats.log_to_scuba stats ; + ExecutionDuration.log ~prefix:"backend_stats.scheduler_process_analysis_time" Analysis + analysis_duration ; () diff --git a/infer/src/backend/Tasks.ml b/infer/src/backend/Tasks.ml index 461412792..e099b67c9 100644 --- a/infer/src/backend/Tasks.ml +++ b/infer/src/backend/Tasks.ml @@ -9,11 +9,6 @@ open! IStd type ('a, 'b) doer = 'a -> 'b option -let fork_protect ~f x = - BackendStats.reset () ; - ForkUtils.protect ~f x - - let with_new_db_connection ~f () = ResultsDatabase.new_database_connection () ; f () @@ -22,15 +17,15 @@ let with_new_db_connection ~f () = module Runner = struct type ('work, 'final, 'result) t = ('work, 'final, 'result) ProcessPool.t - let create ~jobs ~f ~child_epilogue ~tasks = + let create ~jobs ~child_prologue ~f ~child_epilogue ~tasks = PerfEvent.( log (fun logger -> log_begin_event logger ~categories:["sys"] ~name:"fork prepare" ())) ; ResultsDatabase.db_close () ; let pool = ProcessPool.create ~jobs ~f ~child_epilogue ~tasks:(with_new_db_connection ~f:tasks) - ~child_prelude: - ((* hack: run post-fork bookkeeping stuff by passing a dummy function to [fork_protect] *) - fork_protect ~f:(fun () -> ())) + ~child_prologue: + ((* hack: we'll continue executing after the function passed to [protect], despite what he name might suggest *) + ForkUtils.protect ~f:child_prologue) in PerfEvent.(log (fun logger -> log_end_event logger ())) ; pool diff --git a/infer/src/backend/Tasks.mli b/infer/src/backend/Tasks.mli index c66b7c164..df6cf12e0 100644 --- a/infer/src/backend/Tasks.mli +++ b/infer/src/backend/Tasks.mli @@ -12,15 +12,13 @@ type ('a, 'b) doer = 'a -> 'b option val run_sequentially : f:('a, 'b) doer -> 'a list -> unit (** Run the tasks sequentially *) -val fork_protect : f:('a -> 'b) -> 'a -> 'b -(** does the bookkeeping necessary to safely execute an infer function [f] after a call to fork(2) *) - (** A runner accepts new tasks repeatedly for parallel execution *) module Runner : sig type ('work, 'final, 'result) t val create : jobs:int + -> child_prologue:(unit -> unit) -> f:('work, 'result) doer -> child_epilogue:(unit -> 'final) -> tasks:(unit -> ('work, 'result) ProcessPool.TaskGenerator.t) diff --git a/infer/src/base/ForkUtils.mli b/infer/src/base/ForkUtils.mli new file mode 100644 index 000000000..98128b140 --- /dev/null +++ b/infer/src/base/ForkUtils.mli @@ -0,0 +1,11 @@ +(* + * Copyright (c) Facebook, Inc. and its affiliates. + * + * This source code is licensed under the MIT license found in the + * LICENSE file in the root directory of this source tree. + *) + +open! IStd + +val protect : f:('a -> 'b) -> 'a -> 'b +(** does the bookkeeping necessary to safely execute an infer function [f] after a call to fork(2) *) diff --git a/infer/src/base/ProcessPool.ml b/infer/src/base/ProcessPool.ml index e41ea2890..1e6dcefc6 100644 --- a/infer/src/base/ProcessPool.ml +++ b/infer/src/base/ProcessPool.ml @@ -374,7 +374,7 @@ let rec child_loop ~slot send_to_parent send_final receive_from_parent ~f ~epilo The child inherits [updates_w] to send updates up to the parent, and a new pipe is set up for the parent to send instructions down to the child. *) -let fork_child ~file_lock ~child_prelude ~slot (updates_r, updates_w) ~f ~epilogue = +let fork_child ~file_lock ~child_prologue ~slot (updates_r, updates_w) ~f ~epilogue = let to_child_r, to_child_w = Unix.pipe () in match Unix.fork () with | `In_the_child -> @@ -384,7 +384,7 @@ let fork_child ~file_lock ~child_prelude ~slot (updates_r, updates_w) ~f ~epilog Utils.set_best_cpu_for slot ; ProcessPoolState.in_child := true ; ProcessPoolState.reset_pid () ; - child_prelude () ; + child_prologue () ; let updates_oc = Unix.out_channel_of_descr updates_w in let send_to_parent (message : 'b worker_message) = marshal_to_pipe ~file_lock updates_oc message @@ -432,19 +432,19 @@ let rec create_pipes n = if Int.equal n 0 then [] else Unix.pipe () :: create_pi let create : jobs:int - -> child_prelude:(unit -> unit) + -> child_prologue:(unit -> unit) -> f:('work -> 'result option) -> child_epilogue:(unit -> 'final) -> tasks:(unit -> ('work, 'result) TaskGenerator.t) -> ('work, 'final, 'result) t = - fun ~jobs ~child_prelude ~f ~child_epilogue ~tasks -> + fun ~jobs ~child_prologue ~f ~child_epilogue ~tasks -> let file_lock = Utils.create_file_lock () in let task_bar = TaskBar.create ~jobs in let children_pipes = create_pipes jobs in let slots = Array.init jobs ~f:(fun slot -> let child_pipe = List.nth_exn children_pipes slot in - fork_child ~file_lock ~child_prelude ~slot child_pipe ~f ~epilogue:child_epilogue ) + fork_child ~file_lock ~child_prologue ~slot child_pipe ~f ~epilogue:child_epilogue ) in ProcessPoolState.has_running_children := true ; Epilogues.register ~description:"Wait children processes exit" ~f:(fun () -> diff --git a/infer/src/base/ProcessPool.mli b/infer/src/base/ProcessPool.mli index 1fd976c46..5c4d594f4 100644 --- a/infer/src/base/ProcessPool.mli +++ b/infer/src/base/ProcessPool.mli @@ -55,7 +55,7 @@ type (_, _, _) t val create : jobs:int - -> child_prelude:(unit -> unit) + -> child_prologue:(unit -> unit) -> f:('work -> 'result option) -> child_epilogue:(unit -> 'final) -> tasks:(unit -> ('work, 'result) TaskGenerator.t) diff --git a/infer/src/inferunit.ml b/infer/src/inferunit.ml index 21541a107..be6c7247d 100644 --- a/infer/src/inferunit.ml +++ b/infer/src/inferunit.ml @@ -13,7 +13,7 @@ let rec mk_test_fork_proof test = let open OUnitTest in match test with | TestCase (length, f) -> - TestCase (length, Tasks.fork_protect ~f) + TestCase (length, ForkUtils.protect ~f) | TestList l -> TestList (List.map ~f:mk_test_fork_proof l) | TestLabel (label, test) -> diff --git a/infer/src/integration/CaptureCompilationDatabase.ml b/infer/src/integration/CaptureCompilationDatabase.ml index f995b3091..461f7d3d7 100644 --- a/infer/src/integration/CaptureCompilationDatabase.ml +++ b/infer/src/integration/CaptureCompilationDatabase.ml @@ -60,7 +60,11 @@ let run_compilation_database compilation_database should_capture_file = (* no stats to record so [child_epilogue] does nothing and we ignore the return {!Tasks.Runner.run} *) let runner = - Tasks.Runner.create ~jobs:Config.jobs ~f:invoke_cmd ~child_epilogue:(fun () -> ()) ~tasks + Tasks.Runner.create ~jobs:Config.jobs + ~child_prologue:(fun () -> ()) + ~f:invoke_cmd + ~child_epilogue:(fun () -> ()) + ~tasks in Tasks.Runner.run runner |> ignore ; L.progress "@." ;