diff --git a/infer/src/.merlin b/infer/src/.merlin index 2b96746ad..5cb595931 100644 --- a/infer/src/.merlin +++ b/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 diff --git a/infer/src/backend/PerfStats.ml b/infer/src/backend/PerfStats.ml index ae99808d2..02d3199a6 100644 --- a/infer/src/backend/PerfStats.ml +++ b/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 diff --git a/infer/src/backend/dom.ml b/infer/src/backend/dom.ml index df81cba9b..003a74a1b 100644 --- a/infer/src/backend/dom.ml +++ b/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 (** diff --git a/infer/src/backend/dom.mli b/infer/src/backend/dom.mli index d5fc08db9..5a7aec919 100644 --- a/infer/src/backend/dom.mli +++ b/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 diff --git a/infer/src/backend/mergeCapture.ml b/infer/src/backend/mergeCapture.ml index 98dac854f..5fa2b9682 100644 --- a/infer/src/backend/mergeCapture.ml +++ b/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) diff --git a/infer/src/backend/ondemand.ml b/infer/src/backend/ondemand.ml index 61ad8c7e6..cdbfe0c49 100644 --- a/infer/src/backend/ondemand.ml +++ b/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 diff --git a/infer/src/base/Pp.ml b/infer/src/base/Pp.ml index 9f0a18ac9..461a155d8 100644 --- a/infer/src/base/Pp.ml +++ b/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 = Unix.gettimeofday () -. Utils.initial_timeofday in - F.fprintf fmt "%f" elapsed +let elapsed_time fmt () = Mtime.Span.pp fmt (Mtime_clock.elapsed ()) let string fmt s = F.fprintf fmt "%s" s diff --git a/infer/src/base/Serialization.ml b/infer/src/base/Serialization.ml index 99ebd3905..a4e6effa3 100644 --- a/infer/src/base/Serialization.ml +++ b/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 expired () = Unix.gettimeofday () -. init_time >= timeout in + let init_time = Mtime_clock.counter () 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 = diff --git a/infer/src/base/Utils.ml b/infer/src/base/Utils.ml index fb7be309b..c9edc2a74 100644 --- a/infer/src/base/Utils.ml +++ b/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 diff --git a/infer/src/base/Utils.mli b/infer/src/base/Utils.mli index da92b9f64..ef4685d69 100644 --- a/infer/src/base/Utils.mli +++ b/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 *) diff --git a/infer/src/clang/Capture.ml b/infer/src/clang/Capture.ml index 626476f6b..b15823994 100644 --- a/infer/src/clang/Capture.ml +++ b/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: %07.3f seconds.@\n" elapsed + L.(debug Capture Quiet) "Elapsed: %a.@\n" Mtime.Span.pp (Mtime_clock.count init_time) in let ast_decl = match ast_source with diff --git a/infer/src/jbuild.common.in b/infer/src/jbuild.common.in index cef9194db..c4d111dec 100644 --- a/infer/src/jbuild.common.in +++ b/infer/src/jbuild.common.in @@ -58,6 +58,7 @@ let common_libraries = ; "cmdliner" ; "core" ; "extlib" + ; "mtime.clock.os" ; "oUnit" ; "parmap" ; "sqlite3" diff --git a/opam b/opam index 5db66a476..98ba69aaf 100644 --- a/opam +++ b/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"} diff --git a/opam.lock b/opam.lock index ee37bfd5b..6c5ed8387 100644 --- a/opam.lock +++ b/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