[time] do not rely on gettimeofday for measuring time

Summary:
Use a monotonic time source instead.

Also, sleep between retries in the Serialization code.

Reviewed By: jberdine

Differential Revision: D5941697

fbshipit-source-id: 05efbe1

infer/src/.merlin

@@ -7,6 +7,8 @@ PKG base
 PKG cmdliner
 PKG core
 PKG javalib
+PKG mtime
+PKG mtime.clock.os
 PKG oUnit
 PKG parmap
 PKG ppx_compare

infer/src/backend/PerfStats.ml

@@ -106,9 +106,8 @@ let stats () =
   let gc_stats = Gc.quick_stat () in
   let allocated_words = gc_stats.minor_words +. gc_stats.major_words -. gc_stats.promoted_words in
   let gc_ctrl = Gc.get () in
-  let exit_timeofday = Unix.gettimeofday () in
   let exit_times = Unix.times () in
-  { rtime= exit_timeofday -. Utils.initial_timeofday
+  { rtime= Mtime_clock.elapsed () |> Mtime.Span.to_s
   ; utime= exit_times.tms_utime -. Utils.initial_times.tms_utime
   ; stime= exit_times.tms_stime -. Utils.initial_times.tms_stime
   ; cutime= exit_times.tms_cutime -. Utils.initial_times.tms_cutime

infer/src/backend/dom.ml

@@ -2018,12 +2018,9 @@ let pathset_collapse tenv pset =
   Paths.PathSet.from_renamed_list
     (List.map ~f:(fun (p, path) -> (Specs.Jprop.to_prop p, path)) plist')
 
-let join_time = ref 0.0
-
 let pathset_join pname tenv (pset1: Paths.PathSet.t) (pset2: Paths.PathSet.t)
     : Paths.PathSet.t * Paths.PathSet.t =
   let mode = JoinState.Post in
-  let initial_time = Unix.gettimeofday () in
   let pset_to_plist pset =
     let f_list p pa acc = (p, pa) :: acc in
     Paths.PathSet.fold f_list pset []
@@ -2070,7 +2067,6 @@ let pathset_join pname tenv (pset1: Paths.PathSet.t) (pset2: Paths.PathSet.t)
   let res =
     (Paths.PathSet.from_renamed_list ppalist1_res, Paths.PathSet.from_renamed_list ppalist2_res)
   in
-  join_time := !join_time +. (Unix.gettimeofday () -. initial_time) ;
   res
 
 (**

infer/src/backend/dom.mli

@@ -19,8 +19,6 @@ val pathset_join :
   -> Paths.PathSet.t * Paths.PathSet.t
 (** Join two pathsets *)
 
-val join_time : float ref
-
 val proplist_collapse_pre : Tenv.t -> Prop.normal Prop.t list -> Prop.normal Specs.Jprop.t list
 
 val pathset_collapse : Tenv.t -> Paths.PathSet.t -> Paths.PathSet.t

infer/src/backend/mergeCapture.ml

@@ -143,9 +143,9 @@ let process_merge_file deps_file =
   L.progress "Files linked: %d@\n" stats.files_linked
 
 let merge_captured_targets () =
-  let time0 = Unix.gettimeofday () in
+  let time0 = Mtime_clock.counter () in
   L.progress "Merging captured Buck targets...@\n%!" ;
   let infer_deps_file = Config.(results_dir ^/ buck_infer_deps_file_name) in
   MergeResults.merge_buck_flavors_results infer_deps_file ;
   process_merge_file infer_deps_file ;
-  L.progress "Merging captured Buck targets took %.03fs@\n%!" (Unix.gettimeofday () -. time0)
+  L.progress "Merging captured Buck targets took %a@\n%!" Mtime.Span.pp (Mtime_clock.count time0)

infer/src/backend/ondemand.ml

@@ -103,11 +103,11 @@ let run_proc_analysis analyze_proc curr_pdesc callee_pdesc =
   let curr_pname = Procdesc.get_proc_name curr_pdesc in
   let callee_pname = Procdesc.get_proc_name callee_pdesc in
   let log_elapsed_time =
-    let start_time = Unix.gettimeofday () in
+    let start_time = Mtime_clock.counter () in
     fun () ->
-      let elapsed_time = Unix.gettimeofday () -. start_time in
       L.(debug Analysis Medium)
-        "Elapsed analysis time: %a: %f@\n" Typ.Procname.pp callee_pname elapsed_time
+        "Elapsed analysis time: %a: %a@\n" Typ.Procname.pp callee_pname Mtime.Span.pp
+        (Mtime_clock.count start_time)
   in
   L.progressbar_procedure () ;
   if Config.trace_ondemand then

infer/src/base/Pp.ml

@@ -132,9 +132,7 @@ let current_time f () =
     tm.Unix.tm_hour tm.Unix.tm_min
 
 (** Print the time in seconds elapsed since the beginning of the execution of the current command. *)
-let elapsed_time fmt () =
+let elapsed_time fmt () = Mtime.Span.pp fmt (Mtime_clock.elapsed ())
-  let elapsed = Unix.gettimeofday () -. Utils.initial_timeofday in
-  F.fprintf fmt "%f" elapsed
 
 let string fmt s = F.fprintf fmt "%s" s
 

infer/src/base/Serialization.ml

@@ -42,11 +42,11 @@ let version = 27
 (** Retry the function while an exception filtered is thrown,
     or until the timeout in seconds expires. *)
 let retry_exception ~timeout ~catch_exn ~f x =
-  let init_time = Unix.gettimeofday () in
+  let init_time = Mtime_clock.counter () in
-  let expired () = Unix.gettimeofday () -. init_time >= timeout in
+  let expired () = Mtime.Span.compare timeout (Mtime_clock.count init_time) <= 0 in
   let rec retry () =
     try f x
-    with e when catch_exn e && not (expired ()) -> (retry [@tailcall]) ()
+    with e when catch_exn e && not (expired ()) -> Utils.yield () ; (retry [@tailcall]) ()
   in
   retry ()
 
@@ -94,7 +94,8 @@ let create_serializer (key: Key.t) : 'a serializer =
         in
         (* Retry to read for 1 second in case of end of file, *)
         (* which indicates that another process is writing the same file. *)
-        SymOp.try_finally ~f:(fun () -> retry_exception ~timeout:1.0 ~catch_exn ~f:read ())
+        let one_second = Mtime.Span.of_uint64_ns (Int64.of_int 1_000_000_000) in
+        SymOp.try_finally ~f:(fun () -> retry_exception ~timeout:one_second ~catch_exn ~f:read ())
           ~finally:(fun () -> In_channel.close inc )
   in
   let write_to_tmp_file fname data =

infer/src/base/Utils.ml

@@ -16,9 +16,6 @@ module L = Die
 (** initial process times *)
 let initial_times = Unix.times ()
 
-(** precise time of day at the start of the analysis *)
-let initial_timeofday = Unix.gettimeofday ()
-
 (** read a source file and return a list of lines, or None in case of error *)
 let read_file fname =
   let res = ref [] in
@@ -316,3 +313,6 @@ let without_gc ~f =
   let res = f () in
   Gc.set {stat with space_overhead= space_oh} ;
   res
+
+let yield () =
+  Unix.select ~read:[] ~write:[] ~except:[] ~timeout:(`After Time_ns.Span.min_value) |> ignore

infer/src/base/Utils.mli

@@ -13,9 +13,6 @@ open! IStd
 val initial_times : Unix.process_times
 (** initial process times *)
 
-val initial_timeofday : float
-(** precise time of day at the start of the analysis *)
-
 val string_crc_hex32 : string -> string
 (** Compute a 32-character hexadecimal crc using the Digest module  *)
 
@@ -101,3 +98,6 @@ val try_finally_swallow_timeout : f:(unit -> 'a) -> finally:(unit -> unit) -> 'a
 
 val without_gc : f:(unit -> unit) -> unit
 (** Call [f ()] with the gc compaction disabled during the execution *)
+
+val yield : unit -> unit
+(** try to give the control back to the OS without sleeping too much *)

infer/src/clang/Capture.ml

@@ -38,10 +38,9 @@ let init_global_state_for_capture_and_linters source_file =
   CFrontend_config.reset_global_state ()
 
 let run_clang_frontend ast_source =
-  let init_time = Unix.gettimeofday () in
+  let init_time = Mtime_clock.counter () in
   let print_elapsed () =
-    let elapsed = Unix.gettimeofday () -. init_time in
+    L.(debug Capture Quiet) "Elapsed: %a.@\n" Mtime.Span.pp (Mtime_clock.count init_time)
-    L.(debug Capture Quiet) "Elapsed: %07.3f seconds.@\n" elapsed
   in
   let ast_decl =
     match ast_source with

infer/src/jbuild.common.in

@@ -58,6 +58,7 @@ let common_libraries =
     ; "cmdliner"
     ; "core"
     ; "extlib"
+    ; "mtime.clock.os"
     ; "oUnit"
     ; "parmap"
     ; "sqlite3"

opam

@@ -30,11 +30,12 @@ depends: [
   "atdgen" {>="1.6.0"}
   "cmdliner" {>="1.0.0"}
   "core"
-  "conf-autoconf"
+  "conf-autoconf" {build}
   "ctypes" {>="0.9.2"}
   "extlib-compat"
   "javalib" {>="2.3.3"}
   "jbuilder" {build & >="1.0+beta11"}
+  "mtime"
   "ocamlfind" {build}
   "ounit" {="2.0.0"}
   "parmap" {>="1.0-rc8"}

opam.lock

@@ -26,6 +26,7 @@ jane-street-headers = v0.9.0
 javalib = 2.3.3
 jbuilder = 1.0+beta13
 menhir = 20170712
+mtime = 1.1.0
 num = 0
 ocaml-compiler-libs = v0.9.0
 ocaml-migrate-parsetree = 1.0.4