diff options
author | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2014-04-06 07:11:12 +0000 |
---|---|---|
committer | xleroy <xleroy@fca1b0fc-160b-0410-b1d3-a4f43f01ea2e> | 2014-04-06 07:11:12 +0000 |
commit | 56579f8ade21cb0a880ffbd6d5e28f152e951be8 (patch) | |
tree | 533192cc9757df2c0811497231acb6290f678e29 /driver/Clflags.ml | |
parent | f45d0c79bc220fc5dbbf7a59b5d100d16726f1ec (diff) | |
download | compcert-kvx-56579f8ade21cb0a880ffbd6d5e28f152e951be8.tar.gz compcert-kvx-56579f8ade21cb0a880ffbd6d5e28f152e951be8.zip |
Merge of branch linear-typing:
1) Revised division of labor between RTLtyping and Lineartyping:
- RTLtyping no longer keeps track of single-precision floats,
switches from subtype-based inference to unification-based inference.
- Unityping: new library for unification-based inference.
- Locations: don't normalize at assignment in a stack slot
- Allocation, Allocproof: simplify accordingly.
- Lineartyping: add inference of locations that contain
a single-precision float.
- Stackingproof: adapted accordingly.
This addresses a defect report whereas RTLtyping was rejecting code that used a RTL pseudoreg to hold both double- and single-precision floats (see test/regression/singlefloats.c).
This corresponds to commits 2435+2436 plus improvements in Lineartyping.
2) Add -dtimings option to measure compilation times.
Moved call to C parser from Elab to Parse, to make it easier to
measure parsing time independently of elaboration time.
git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2449 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
Diffstat (limited to 'driver/Clflags.ml')
-rw-r--r-- | driver/Clflags.ml | 51 |
1 files changed, 51 insertions, 0 deletions
diff --git a/driver/Clflags.ml b/driver/Clflags.ml index b1f2bd8e..610d807d 100644 --- a/driver/Clflags.ml +++ b/driver/Clflags.ml @@ -52,3 +52,54 @@ let option_small_data = && Configuration.system = "diab" then 8 else 0) let option_small_const = ref (!option_small_data) +let option_timings = ref false + +(** Timing facility *) + +let timers : (string * float) list ref = ref [] + +let add_to_timer name time = + let rec add = function + | [] -> [name, time] + | (name1, time1 as nt1) :: rem -> + if name1 = name then (name1, time1 +. time) :: rem else nt1 :: add rem + in timers := add !timers + +let time name fn arg = + if not !option_timings then + fn arg + else begin + let start = Sys.time() in + try + let res = fn arg in + add_to_timer name (Sys.time() -. start); + res + with x -> + add_to_timer name (Sys.time() -. start); + raise x + end + +let time2 name fn arg1 arg2 = time name (fun () -> fn arg1 arg2) () +let time3 name fn arg1 arg2 arg3 = time name (fun () -> fn arg1 arg2 arg3) () + +let time_coq name fn arg = + if not !option_timings then + fn arg + else begin + let start = Sys.time() in + try + let res = fn arg in + add_to_timer (Camlcoq.camlstring_of_coqstring name) (Sys.time() -. start); + res + with x -> + add_to_timer (Camlcoq.camlstring_of_coqstring name) (Sys.time() -. start); + raise x + end + +let print_timers () = + if !option_timings then + List.iter + (fun (name, time) -> Printf.printf "%7.2fs %s\n" time name) + !timers + +let _ = at_exit print_timers |