[scheduler] [restart] Implement the ProcLocker

Summary:
The ProcLocker uses files as locks and relies on the guarantees of the `Unix.open_file` function when using `O_CREAT` and `O_EXCL` simultaneously.

- `setup`: creates a directory for the lock files inside `infe-out` and deletes its content if it already existed.
- `clean`: does nothing for now. Any file locks that may have been left unlocked are removed by the `setup` in the next run. This way the user can see what locks were taken if the program crashes.
- `lock_exn`: try to lock the `Procname` and if it can't releases all the locks that is currently holding.
- `unlock`: removes the corresponding file.

Reviewed By: ngorogiannis

Differential Revision: D19639402

fbshipit-source-id: e02f277ff

infer/src/absint/AbstractInterpreter.ml

@@ -162,6 +162,8 @@ module AbstractInterpreterCommon (TransferFunctions : TransferFunctions.SIL) = s
             logged_error := false ;
             Ok post
           with exn ->
+            IExn.reraise_if exn ~f:(fun () ->
+                match exn with ProcessPool.ProcnameAlreadyLocked -> true | _ -> false ) ;
             (* delay reraising to get a chance to write the debug HTML *)
             let backtrace = Caml.Printexc.get_raw_backtrace () in
             Error (exn, backtrace, instr)

infer/src/backend/InferAnalyze.ml

@@ -139,11 +139,13 @@ let analyze source_files_to_analyze =
     L.environment_info "Parallel jobs: %d@." Config.jobs ;
     let tasks = schedule source_files_to_analyze in
     (* Prepare tasks one cluster at a time while executing in parallel *)
+    RestartScheduler.setup () ;
     let runner =
       Tasks.Runner.create ~jobs:Config.jobs ~f:analyze_target ~child_epilogue:BackendStats.get
         ~tasks
     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 ->
           match stats_opt with

infer/src/backend/ProcLocker.ml

@@ -0,0 +1,29 @@
+(*
+ * 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
+
+exception UnlockNotLocked of Procname.t
+
+let locks_dir = Config.procnames_locks_dir
+
+let setup () = Utils.rmtree locks_dir ; Utils.create_dir locks_dir
+
+let clean () = ()
+
+let filename_from pname = locks_dir ^/ Procname.to_filename pname
+
+let unlock pname =
+  try Unix.unlink (filename_from pname)
+  with Unix.Unix_error (Unix.ENOENT, _, _) -> raise (UnlockNotLocked pname)
+
+
+let try_lock pname =
+  try
+    Unix.openfile ~mode:[O_CREAT; O_EXCL; O_RDONLY] (filename_from pname) |> Unix.close ;
+    true
+  with Unix.Unix_error (Unix.EEXIST, _, _) -> false

infer/src/backend/ProcLocker.mli

@@ -0,0 +1,24 @@
+(*
+ * 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
+
+exception UnlockNotLocked of Procname.t
+
+val setup : unit -> unit
+(** This should be called once before trying to lock Anything. *)
+
+val try_lock : Procname.t -> bool
+(** true = the lock belongs to the calling process. false = the lock belongs to a different worker *)
+
+val unlock : Procname.t -> unit
+(** 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
+(** This should be called when locks will no longer be used to remove any files or state that's not
+    necessary. *)

infer/src/backend/RestartScheduler.ml

@@ -7,42 +7,16 @@
 open! IStd
 module L = Logging
 
-module ProcLocker : sig
-  val setup : unit -> unit
-  (** This should be called once before trying to lock Anything. *)
-
-  val try_lock : Procname.t -> bool
-  (** true = the lock belongs to the calling process. false = the lock belongs to a different worker *)
-
-  val unlock : Procname.t -> unit
-  (** 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
-  (** This should be called when locks will no longer be used to remove any files or state that's
-      not necessary. *)
-end = struct
-  let setup () = ()
-
-  let try_lock _pname = true
-
-  let unlock _pname = ()
-
-  let clean () = ()
-end
-
 let of_list (lst : 'a list) : 'a ProcessPool.TaskGenerator.t =
   let content = Queue.of_list lst in
   let remaining = ref (Queue.length content) in
   let remaining_tasks () = !remaining in
-  let is_empty () = Queue.is_empty content in
+  let is_empty () = Int.equal !remaining 0 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}
 
 
-(** This behaves exactly the same as the FileScheduler so far. The goal is that it will use a work
-    queue and proc locking to avoid repeating work and hopefully get some in process cache hits. *)
 let make_with_procs_from sources =
   let gen =
     List.map sources ~f:SourceFiles.proc_names_of_source
@@ -63,15 +37,16 @@ let make sources =
   ProcessPool.TaskGenerator.chain (make_with_procs_from sources) (FileScheduler.make sources)
 
 
-let locked_procs = Stack.create ()
+let if_restart_scheduler f =
+  if Int.equal Config.jobs 1 then ()
+  else match Config.scheduler with File | SyntacticCallGraph -> () | Restart -> f ()
 
-let unlock_all () = Stack.until_empty locked_procs ProcLocker.unlock
 
-let record_locked_proc (pname : Procname.t) = Stack.push locked_procs pname
+let locked_procs = Stack.create ()
 
-let if_restart_scheduler f =
-  match Config.scheduler with File | SyntacticCallGraph -> () | Restart -> f ()
+let record_locked_proc (pname : Procname.t) = Stack.push locked_procs pname
 
+let unlock_all () = Stack.until_empty locked_procs ProcLocker.unlock
 
 let lock_exn pname =
   if_restart_scheduler (fun () ->
@@ -94,6 +69,6 @@ let unlock pname =
           ProcLocker.unlock pname )
 
 
-let setup () = ProcLocker.setup ()
+let setup () = if_restart_scheduler ProcLocker.setup
 
-let clean () = ProcLocker.clean ()
+let clean () = if_restart_scheduler ProcLocker.clean

infer/src/backend/Tasks.ml

@@ -34,9 +34,7 @@ module Runner = struct
     Stdlib.flush_all () ;
     (* Compact heap before forking *)
     Gc.compact () ;
-    RestartScheduler.setup () ;
-    let results = ProcessPool.run runner in
-    RestartScheduler.clean () ; results
+    ProcessPool.run runner
 end
 
 let run_sequentially ~(f : 'a doer) (tasks : 'a list) : unit =

infer/src/backend/ondemand.ml

@@ -44,14 +44,14 @@ let max_nesting_to_print = 8
    and exiting nested ondemand analyses. In particular we need to remember the original time.*)
 let current_taskbar_status : (Mtime.t * string) option ref = ref None
 
-let is_active, add_active, remove_active =
+let is_active, add_active, remove_active, clear_actives =
   let currently_analyzed = ref Procname.Set.empty in
   let is_active proc_name = Procname.Set.mem proc_name !currently_analyzed
   and add_active proc_name = currently_analyzed := Procname.Set.add proc_name !currently_analyzed
   and remove_active proc_name =
     currently_analyzed := Procname.Set.remove proc_name !currently_analyzed
-  in
-  (is_active, add_active, remove_active)
+  and clear_actives () = currently_analyzed := Procname.Set.empty in
+  (is_active, add_active, remove_active, clear_actives)
 
 
 let already_analyzed proc_name =
@@ -218,14 +218,18 @@ let run_proc_analysis ~caller_pdesc callee_pdesc =
   with exn -> (
     let backtrace = Printexc.get_backtrace () in
     IExn.reraise_if exn ~f:(fun () ->
-        if not !logged_error then (
-          let source_file = attributes.ProcAttributes.translation_unit in
-          let location = attributes.ProcAttributes.loc in
-          L.internal_error "While analysing function %a:%a at %a@\n" SourceFile.pp source_file
-            Procname.pp callee_pname Location.pp_file_pos location ;
-          logged_error := true ) ;
-        restore_global_state old_state ;
-        not Config.keep_going ) ;
+        match exn with
+        | ProcessPool.ProcnameAlreadyLocked ->
+            clear_actives () ; true
+        | _ ->
+            if not !logged_error then (
+              let source_file = attributes.ProcAttributes.translation_unit in
+              let location = attributes.ProcAttributes.loc in
+              L.internal_error "While analysing function %a:%a at %a@\n" SourceFile.pp source_file
+                Procname.pp callee_pname Location.pp_file_pos location ;
+              logged_error := true ) ;
+            restore_global_state old_state ;
+            not Config.keep_going ) ;
     L.internal_error "@\nERROR RUNNING BACKEND: %a %s@\n@\nBACK TRACE@\n%s@?" Procname.pp
       callee_pname (Exn.to_string exn) backtrace ;
     match exn with

infer/src/base/Config.ml

@@ -252,6 +252,8 @@ let perf_stats_prefix = "perf_stats"
 
 let proc_stats_filename = "proc_stats.json"
 
+let procnames_locks_dir_name = "procnames_locks"
+
 let property_attributes = "property_attributes"
 
 let racerd_issues_dir_name = "racerd"
@@ -3310,6 +3312,8 @@ let clang_frontend_action_string =
   String.concat ~sep:", " text
 
 
+let procnames_locks_dir = results_dir ^/ procnames_locks_dir_name
+
 (* Specify treatment of dynamic dispatch in Java code: false 'none' treats dynamic dispatch as
    a call to unknown code and true triggers lazy dynamic dispatch. The latter mode follows the
    JVM semantics and creates procedure descriptions during symbolic execution using the type

infer/src/base/Config.mli

@@ -135,6 +135,8 @@ val pp_version : Format.formatter -> unit -> unit
 
 val proc_stats_filename : string
 
+val procnames_locks_dir : string
+
 val property_attributes : string
 
 val racerd_issues_dir_name : string

infer/src/unit/RestartSchedulerTests.ml

@@ -0,0 +1,42 @@
+(*
+ * 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
+open OUnit2
+
+let a_pname = Procname.from_string_c_fun "a_c_fun_name"
+
+let test_try_lock_already_locked _test_ctxt =
+  ProcLocker.(
+    setup () ;
+    try_lock a_pname |> ignore ;
+    assert_bool "Should not be able to lock a Procname that's already locked."
+      (not (try_lock a_pname)))
+
+
+let test_lock_after_unlock _test_ctxt =
+  ProcLocker.(
+    setup () ;
+    try_lock a_pname |> ignore ;
+    unlock a_pname ;
+    try_lock a_pname |> ignore ;
+    unlock a_pname)
+
+
+let test_unlocking_unlocked_fails _text_ctxt =
+  ProcLocker.(
+    setup () ;
+    try_lock a_pname |> ignore ;
+    unlock a_pname ;
+    assert_raises (UnlockNotLocked a_pname) (fun () -> unlock a_pname))
+
+
+let tests =
+  "restart_scheduler_suite"
+  >::: [ "test_try_lock_already_locked" >:: test_try_lock_already_locked
+       ; "test_lock_after_unlock" >:: test_lock_after_unlock
+       ; "test_unlocking_unlocked_fails" >:: test_unlocking_unlocked_fails ]

infer/src/unit/inferunit.ml

@@ -46,6 +46,7 @@ let () =
         ; TraceTests.tests
         ; WeakTopologicalOrderTests.tests ]
       @ ClangTests.tests @ AllNullsafeTests.tests )
+    @ [RestartSchedulerTests.tests]
   in
   let test_suite = "all" >::: tests in
   OUnit2.run_test_tt_main test_suite