[multicore][4/n] domain-local analysis state

Summary:
- Dependencies (to domain-local storage for its hashtable and current procedure under analysis)
- Timer
- PerfEvent

Reviewed By: jvillard

Differential Revision:
D66806235

Privacy Context Container: L1208441

fbshipit-source-id: d1d4fe75e9770bb701989bd137087b936c4711f8

infer/src/IR/Dependencies.ml

@@ -9,7 +9,9 @@ open! IStd
 module F = Format
 module L = Logging
 
-let currently_under_analysis : Procname.t option ref = ref None
+let currently_under_analysis : Procname.t option Domain.DLS.key =
+  Domain.DLS.new_key (fun () -> None)
+
 
 type complete =
   { summary_loads: Procname.t list
@@ -25,7 +27,9 @@ type partial =
   ; partial_other_proc_names: Procname.HashSet.t
   ; partial_used_tenv_sources: SourceFile.HashSet.t }
 
-let deps_in_progress : partial Procname.Hash.t = Procname.Hash.create 0
+let deps_in_progress : partial Procname.Hash.t Domain.DLS.key =
+  Domain.DLS.new_key (fun () -> Procname.Hash.create 0)
+
 
 let reset pname =
   let partial =
@@ -34,7 +38,7 @@ let reset pname =
     ; partial_other_proc_names= Procname.HashSet.create 0
     ; partial_used_tenv_sources= SourceFile.HashSet.create 0 }
   in
-  Procname.Hash.replace deps_in_progress pname partial ;
+  Procname.Hash.replace (Domain.DLS.get deps_in_progress) pname partial ;
   Partial
 
 
@@ -45,7 +49,7 @@ let freeze pname deps =
           ; partial_recursion_edges
           ; partial_other_proc_names
           ; partial_used_tenv_sources } =
-        Procname.Hash.find deps_in_progress pname
+        Procname.Hash.find (Domain.DLS.get deps_in_progress) pname
       in
       (* make sets pairwise disjoint to save space in summaries, in case we first added a procedure
          to "other" and *then* to "summary loads", for example *)
@@ -77,39 +81,43 @@ let complete_exn = function
 type kind = SummaryLoad | RecursionEdge | Other
 
 let record_pname_dep ?caller kind callee =
-  let caller = match caller with Some _ -> caller | None -> !currently_under_analysis in
+  let caller =
+    match caller with Some _ -> caller | None -> Domain.DLS.get currently_under_analysis
+  in
   match caller with
   | Some caller when not (Procname.equal caller callee) ->
-      Option.iter (Procname.Hash.find_opt deps_in_progress caller)
-        ~f:(fun {partial_summary_loads; partial_recursion_edges; partial_other_proc_names} ->
-          match kind with
-          | SummaryLoad ->
-              Procname.HashSet.add callee partial_summary_loads
-          (* HACK: only add to the other (than "summary loads") buckets if the proc name is not
-             already accounted for in summary loads as we don't need to precisely account for
-             holding another kind of dependency as long as we know it's a dependency already. This
-             avoids double counting elsewhere and saves some space. *)
-          | RecursionEdge ->
-              if not @@ Procname.HashSet.mem partial_summary_loads callee then
-                Procname.HashSet.add callee partial_recursion_edges
-          | Other ->
-              if
-                (not @@ Procname.HashSet.mem partial_summary_loads callee)
-                && (not @@ Procname.HashSet.mem partial_recursion_edges callee)
-              then Procname.HashSet.add callee partial_other_proc_names )
+      Procname.Hash.find_opt (Domain.DLS.get deps_in_progress) caller
+      |> Option.iter
+           ~f:(fun {partial_summary_loads; partial_recursion_edges; partial_other_proc_names} ->
+             match kind with
+             | SummaryLoad ->
+                 Procname.HashSet.add callee partial_summary_loads
+             (* HACK: only add to the other (than "summary loads") buckets if the proc name is not
+                already accounted for in summary loads as we don't need to precisely account for
+                holding another kind of dependency as long as we know it's a dependency already. This
+                avoids double counting elsewhere and saves some space. *)
+             | RecursionEdge ->
+                 if not @@ Procname.HashSet.mem partial_summary_loads callee then
+                   Procname.HashSet.add callee partial_recursion_edges
+             | Other ->
+                 if
+                   (not @@ Procname.HashSet.mem partial_summary_loads callee)
+                   && (not @@ Procname.HashSet.mem partial_recursion_edges callee)
+                 then Procname.HashSet.add callee partial_other_proc_names )
   | _ ->
       ()
 
 
 let record_srcfile_dep src_file =
-  Option.bind !currently_under_analysis ~f:(Procname.Hash.find_opt deps_in_progress)
+  Domain.DLS.get currently_under_analysis
+  |> Option.bind ~f:(Procname.Hash.find_opt (Domain.DLS.get deps_in_progress))
   |> Option.iter ~f:(fun {partial_used_tenv_sources} ->
          SourceFile.HashSet.add src_file partial_used_tenv_sources )
 
 
 let clear () =
-  Procname.Hash.clear deps_in_progress ;
-  currently_under_analysis := None
+  Procname.Hash.clear (Domain.DLS.get deps_in_progress) ;
+  Domain.DLS.set currently_under_analysis None
 
 
 let pp fmt = function

infer/src/IR/Dependencies.mli

@@ -31,7 +31,7 @@ val pp : F.formatter -> t -> unit
     in the Backend module to conservatively invalidate procedure summaries that were computed using
     out-of-date type environment information. *)
 
-val currently_under_analysis : Procname.t option ref
+val currently_under_analysis : Procname.t option Domain.DLS.key
 
 val reset : Procname.t -> t
 

infer/src/backend/ondemand.ml

@@ -143,7 +143,7 @@ let () =
   AnalysisGlobalState.register ~save:Timer.suspend ~restore:Timer.resume ~init:(fun () -> ()) ;
   AnalysisGlobalState.register ~save:Ident.NameGenerator.get_current
     ~restore:Ident.NameGenerator.set_current ~init:Ident.NameGenerator.reset ;
-  AnalysisGlobalState.register_ref_with_proc_desc_and_tenv Dependencies.currently_under_analysis
+  AnalysisGlobalState.register_dls_with_proc_desc_and_tenv Dependencies.currently_under_analysis
     ~init:(fun proc_desc _tenv -> Option.some (Procdesc.get_proc_name proc_desc) ) ;
   ()
 

infer/src/base/PerfEvent.ml

@@ -66,44 +66,48 @@ module JsonFragment = struct
 
   (** 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_state = Domain.DLS.new_key (fun () -> [Outside])
+
+  let get_state () = Domain.DLS.get pp_state
+
+  let set_state state = Domain.DLS.set pp_state state
 
   let pp f json_fragment =
-    match (json_fragment, !pp_state) with
+    match (json_fragment, get_state ()) with
     | AssocBegin, ((Outside | InList) :: _ as state) ->
-        pp_state := InAssocFirst :: state
+        set_state (InAssocFirst :: state)
     | AssocEnd, (InAssocFirst | InAssocMiddle) :: state' ->
         F.pp_print_string f "}" ;
-        pp_state := state'
+        set_state state'
     | ListBegin, ((Outside | InList) :: _ as state) ->
         F.pp_print_string f "[" ;
-        pp_state := InList :: state
+        set_state (InList :: state)
     | ListItemSeparator, InList :: _ ->
         F.pp_print_string f ","
     | ListEnd, InList :: state0 ->
         F.pp_print_string f "]" ;
-        pp_state := state0
+        set_state state0
     | _ ->
         L.die InternalError "Unexpected json fragment \"%s\" in state [%a]"
           (to_string json_fragment)
           (Pp.seq (Pp.of_string ~f:string_of_state))
-          !pp_state
+          (get_state ())
 
 
   let pp_assoc_field pp_value f key value =
-    match !pp_state with
+    match get_state () with
     | InAssocFirst :: state0 ->
         F.pp_print_string f "{" ;
         Json.pp_field pp_value f key value ;
-        pp_state := InAssocMiddle :: state0
+        set_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.of_string ~f:string_of_state))
-          !pp_state
+          (get_state ())
 end
 
 type event_type = Begin | Complete | End | Instant
@@ -246,7 +250,7 @@ let logger =
              Out_channel.close out_channel ) )
        else
          (* assume the trace file is here and is ready to accept list elements *)
-         JsonFragment.(pp_state := InList :: !pp_state) ) ;
+         JsonFragment.(set_state (InList :: get_state ())) ) ;
      logger )
 
 

infer/src/base/Timer.ml

@@ -12,14 +12,14 @@ exception Timeout of float
 
 let now () = (Unix.times ()).tms_utime
 
-let timer = ref None
+let timer = Domain.DLS.new_key (fun () -> None)
 
-let start () = timer := Some (now ())
+let start () = Domain.DLS.set timer (Some (now ()))
 
 let time_since start_time = now () -. start_time
 
 let get () =
-  match !timer with
+  match Domain.DLS.get timer with
   | None ->
       L.die InternalError "trying to get the value of the timer but no timer is active"
   | Some start_time ->
@@ -29,15 +29,15 @@ let get () =
 type state = float option
 
 let suspend () : state =
-  let current_timer = !timer in
-  timer := None ;
+  let current_timer = Domain.DLS.get timer in
+  Domain.DLS.set timer None ;
   Option.map current_timer ~f:time_since
 
 
 let resume (t : state) =
   (* forget about the time spent between [suspend ()] and [resume _] by pretending the timer started
      at [now - previous_time_spent] *)
-  timer := Option.map t ~f:(fun previous_time_spent -> now () -. previous_time_spent)
+  Option.map t ~f:(fun previous_time_spent -> now () -. previous_time_spent) |> Domain.DLS.set timer
 
 
 let check_timeout timeout =