diff --git a/infer/src/backend/TaskScheduler.ml b/infer/src/backend/TaskScheduler.ml index c63535263..6e2c157ab 100644 --- a/infer/src/backend/TaskScheduler.ml +++ b/infer/src/backend/TaskScheduler.ml @@ -12,7 +12,7 @@ type target = Procname of Typ.Procname.t | File of SourceFile.t type 'a task_generator = 'a Tasks.task_generator let chain (gen1 : 'a task_generator) (gen2 : 'a task_generator) : 'a task_generator = - let n_tasks = gen1.n_tasks + gen2.n_tasks in + let remaining_tasks () = gen1.remaining_tasks () + gen2.remaining_tasks () in let gen1_returned_empty = ref false in let gen1_is_empty () = gen1_returned_empty := !gen1_returned_empty || gen1.is_empty () ; @@ -21,7 +21,7 @@ let chain (gen1 : 'a task_generator) (gen2 : 'a task_generator) : 'a task_genera let is_empty () = gen1_is_empty () && gen2.is_empty () in let finished x = if gen1_is_empty () then gen2.finished x else gen1.finished x in let next x = if gen1_is_empty () then gen2.next x else gen1.next x in - {n_tasks; is_empty; finished; next} + {remaining_tasks; is_empty; finished; next} let count_procedures () = @@ -43,7 +43,8 @@ let initial_call_graph_capacity = 1009 let bottom_up sources : target task_generator = (* this will potentially grossly overapproximate the tasks *) - let n_tasks = count_procedures () in + let remaining = ref (count_procedures ()) in + let remaining_tasks () = !remaining in let g = CallGraph.create initial_call_graph_capacity in let initialized = ref false in let pending : CallGraph.Node.t list ref = ref [] in @@ -51,6 +52,7 @@ let bottom_up sources : target task_generator = let is_empty () = let empty = !initialized && List.is_empty !pending && Typ.Procname.Set.is_empty !scheduled in if empty then ( + remaining := 0 ; L.progress "Finished call graph scheduling, %d procs remaining (in cycles).@." (CallGraph.n_procs g) ; if Config.debug_level_analysis > 0 then CallGraph.to_dotty g "cycles.dot" ; @@ -76,6 +78,7 @@ let bottom_up sources : target task_generator = | File _ -> assert false | Procname pname -> + decr remaining ; scheduled := Typ.Procname.Set.remove pname !scheduled ; CallGraph.remove_reachable g pname in @@ -86,7 +89,7 @@ let bottom_up sources : target task_generator = initialized := true ) ; next_aux () in - {n_tasks; is_empty; finished; next} + {remaining_tasks; is_empty; finished; next} let of_sources sources = diff --git a/infer/src/backend/Tasks.ml b/infer/src/backend/Tasks.ml index 73b095438..d7b6b0954 100644 --- a/infer/src/backend/Tasks.ml +++ b/infer/src/backend/Tasks.ml @@ -12,20 +12,6 @@ type 'a doer = 'a -> unit type 'a task_generator = 'a ProcessPool.task_generator -let run_sequentially ~(f : 'a doer) (tasks : 'a list) : unit = - let task_bar = TaskBar.create ~jobs:1 in - (ProcessPoolState.update_status := - fun t status -> - TaskBar.update_status task_bar ~slot:0 t status ; - TaskBar.refresh task_bar) ; - TaskBar.set_tasks_total task_bar (List.length tasks) ; - TaskBar.tasks_done_reset task_bar ; - List.iter - ~f:(fun task -> f task ; TaskBar.tasks_done_add task_bar 1 ; TaskBar.refresh task_bar) - tasks ; - TaskBar.finish task_bar - - let fork_protect ~f x = (* this is needed whenever a new process is started *) Epilogues.reset () ; @@ -66,9 +52,10 @@ end let gen_of_list (lst : 'a list) : 'a task_generator = let content = ref lst in - let n_tasks = List.length lst in + let length = ref (List.length lst) in + let remaining_tasks () = !length in let is_empty () = List.is_empty !content in - let finished _finished_item = () in + let finished _finished_item = decr length in let next () = match !content with | [] -> @@ -77,4 +64,23 @@ let gen_of_list (lst : 'a list) : 'a task_generator = content := xs ; Some x in - {n_tasks; is_empty; finished; next} + {remaining_tasks; is_empty; finished; next} + + +let run_sequentially ~(f : 'a doer) (tasks : 'a list) : unit = + let task_generator = gen_of_list tasks in + let task_bar = TaskBar.create ~jobs:1 in + (ProcessPoolState.update_status := + fun t status -> + TaskBar.update_status task_bar ~slot:0 t status ; + TaskBar.refresh task_bar) ; + TaskBar.set_tasks_total task_bar (task_generator.remaining_tasks ()) ; + TaskBar.tasks_done_reset task_bar ; + let rec run_tasks () = + if not (task_generator.is_empty ()) then ( + Option.iter (task_generator.next ()) ~f:(fun t -> f t ; task_generator.finished t) ; + TaskBar.set_remaining_tasks task_bar (task_generator.remaining_tasks ()) ; + TaskBar.refresh task_bar ; + run_tasks () ) + in + run_tasks () ; TaskBar.finish task_bar diff --git a/infer/src/base/ProcessPool.ml b/infer/src/base/ProcessPool.ml index 36afe99d3..48f174056 100644 --- a/infer/src/base/ProcessPool.ml +++ b/infer/src/base/ProcessPool.ml @@ -20,7 +20,10 @@ type child_info = {pid: Pid.t; down_pipe: Out_channel.t} type 'a child_state = Initializing | Idle | Processing of 'a type 'a task_generator = - {n_tasks: int; is_empty: unit -> bool; finished: 'a -> unit; next: unit -> 'a option} + { remaining_tasks: unit -> int + ; is_empty: unit -> bool + ; finished: 'a -> unit + ; next: unit -> 'a option } (** the state of the pool *) type 'a t = @@ -234,7 +237,7 @@ let process_updates pool buffer = Unix.wait (`Pid pid) |> ignore ; killall pool ~slot "see backtrace above" | Ready slot -> - TaskBar.tasks_done_add pool.task_bar 1 ; + TaskBar.set_remaining_tasks pool.task_bar (pool.tasks.remaining_tasks ()) ; TaskBar.update_status pool.task_bar ~slot (Mtime_clock.now ()) "idle" ; ( match pool.children_states.(slot) with | Processing work -> @@ -361,13 +364,9 @@ let create : let run pool = - TaskBar.set_tasks_total pool.task_bar pool.tasks.n_tasks ; + let total_tasks = pool.tasks.remaining_tasks () in + TaskBar.set_tasks_total pool.task_bar total_tasks ; TaskBar.tasks_done_reset pool.task_bar ; - (* Start with a negative number of completed tasks to account for the initial [Ready] - messages. All the children start by sending [Ready], which is interpreted by the parent process - as "one task has been completed". Starting with a negative number is a simple if hacky way to - account for these spurious "done" tasks. *) - TaskBar.tasks_done_add pool.task_bar (-pool.jobs) ; (* allocate a buffer for reading children updates once for the whole run *) let buffer = Bytes.create buffer_size in (* wait for all children to run out of tasks *) diff --git a/infer/src/base/ProcessPool.mli b/infer/src/base/ProcessPool.mli index 9c9df2c18..884834a65 100644 --- a/infer/src/base/ProcessPool.mli +++ b/infer/src/base/ProcessPool.mli @@ -28,8 +28,8 @@ type _ t (** abstraction for generating jobs *) type 'a task_generator = - { n_tasks: int - (** total number of tasks -- only used for reporting, so imprecision is not a bug *) + { remaining_tasks: unit -> int + (** number of tasks remaining to complete -- only used for reporting, so imprecision is not a bug *) ; is_empty: unit -> bool (** when should the main loop of the task manager stop expecting new tasks *) ; finished: 'a -> unit diff --git a/infer/src/base/TaskBar.ml b/infer/src/base/TaskBar.ml index d7b9a80e5..c3bf31225 100644 --- a/infer/src/base/TaskBar.ml +++ b/infer/src/base/TaskBar.ml @@ -168,10 +168,10 @@ let set_tasks_total task_bar n = () -let tasks_done_add task_bar n = +let set_remaining_tasks task_bar n = match task_bar with | MultiLine multiline -> - multiline.tasks_done <- multiline.tasks_done + n + multiline.tasks_done <- multiline.tasks_total - n | NonInteractive | Quiet -> () diff --git a/infer/src/base/TaskBar.mli b/infer/src/base/TaskBar.mli index c07a3b8b1..75fcaa3f2 100644 --- a/infer/src/base/TaskBar.mli +++ b/infer/src/base/TaskBar.mli @@ -25,8 +25,8 @@ val set_tasks_total : t -> int -> unit val tasks_done_reset : t -> unit (** record that 0 tasks have been completed so far *) -val tasks_done_add : t -> int -> unit -(** record that a number of tasks have been completed *) +val set_remaining_tasks : t -> int -> unit +(** set the number of tasks remaining to complete *) val finish : t -> unit (** tear down the task bar and ready the terminal for more output *)