|
|
|
@ -5,25 +5,20 @@
|
|
|
|
|
* LICENSE file in the root directory of this source tree.
|
|
|
|
|
*)
|
|
|
|
|
open! IStd
|
|
|
|
|
|
|
|
|
|
[@@@warning "-60"]
|
|
|
|
|
module L = Logging
|
|
|
|
|
|
|
|
|
|
module ProcLocker : sig
|
|
|
|
|
val setup : unit -> unit
|
|
|
|
|
[@@warning "-32"]
|
|
|
|
|
(** This should be called once before trying to lock Anything. *)
|
|
|
|
|
|
|
|
|
|
val try_lock : Procname.t -> bool
|
|
|
|
|
[@@warning "-32"]
|
|
|
|
|
(** true = the lock belongs to the calling process false = the lock belongs to a different worker *)
|
|
|
|
|
(** true = the lock belongs to the calling process. false = the lock belongs to a different worker *)
|
|
|
|
|
|
|
|
|
|
val unlock : Procname.t -> unit
|
|
|
|
|
[@@warning "-32"]
|
|
|
|
|
(** This will work as a cleanup function because after calling unlock all the workers that need an
|
|
|
|
|
unlocked Proc should find it's summary already Cached. Throws if the lock had not been taken. *)
|
|
|
|
|
|
|
|
|
|
val clean : unit -> unit
|
|
|
|
|
[@@warning "-32"]
|
|
|
|
|
(** This should be called when locks will no longer be used to remove any files or state that's
|
|
|
|
|
not necessary. *)
|
|
|
|
|
end = struct
|
|
|
|
@ -41,7 +36,7 @@ let of_list (lst : 'a list) : 'a ProcessPool.TaskGenerator.t =
|
|
|
|
|
let remaining = ref (Queue.length content) in
|
|
|
|
|
let remaining_tasks () = !remaining in
|
|
|
|
|
let is_empty () = Queue.is_empty content in
|
|
|
|
|
let finished ~completed:_ _work = decr remaining in
|
|
|
|
|
let finished ~completed work = if completed then decr remaining else Queue.enqueue content work in
|
|
|
|
|
let next () = Queue.dequeue content in
|
|
|
|
|
{remaining_tasks; is_empty; finished; next}
|
|
|
|
|
|
|
|
|
@ -66,3 +61,39 @@ let make_with_procs_from sources =
|
|
|
|
|
|
|
|
|
|
let make sources =
|
|
|
|
|
ProcessPool.TaskGenerator.chain (make_with_procs_from sources) (FileScheduler.make sources)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let locked_procs = Stack.create ()
|
|
|
|
|
|
|
|
|
|
let unlock_all () = Stack.until_empty locked_procs ProcLocker.unlock
|
|
|
|
|
|
|
|
|
|
let record_locked_proc (pname : Procname.t) = Stack.push locked_procs pname
|
|
|
|
|
|
|
|
|
|
let if_restart_scheduler f =
|
|
|
|
|
match Config.scheduler with File | SyntacticCallGraph -> () | Restart -> f ()
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let lock_exn pname =
|
|
|
|
|
if_restart_scheduler (fun () ->
|
|
|
|
|
if ProcLocker.try_lock pname then record_locked_proc pname
|
|
|
|
|
else (
|
|
|
|
|
unlock_all () ;
|
|
|
|
|
raise ProcessPool.ProcnameAlreadyLocked ) )
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let unlock pname =
|
|
|
|
|
if_restart_scheduler (fun () ->
|
|
|
|
|
match Stack.pop locked_procs with
|
|
|
|
|
| None ->
|
|
|
|
|
L.die InternalError "Trying to unlock %s but it does not appear to be locked.@."
|
|
|
|
|
(Procname.to_string pname)
|
|
|
|
|
| Some stack_pname when not (Procname.equal pname stack_pname) ->
|
|
|
|
|
L.die InternalError "Trying to unlock %s but top of stack is %s.@."
|
|
|
|
|
(Procname.to_string pname) (Procname.to_string stack_pname)
|
|
|
|
|
| Some _ ->
|
|
|
|
|
ProcLocker.unlock pname )
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
let setup () = ProcLocker.setup ()
|
|
|
|
|
|
|
|
|
|
let clean () = ProcLocker.clean ()
|
|
|
|
|