aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorBernhard Schommer <bernhardschommer@gmail.com>2014-09-29 14:04:59 +0200
committerBernhard Schommer <bernhardschommer@gmail.com>2014-09-29 14:04:59 +0200
commite5b59af8a21c42b504b1beeb89208dd0cb0c8b3b (patch)
treec257060ca943eade1562bf9071a54a6f82fa5467
parent6087efa0b68ae3a1b003dac86970719728976395 (diff)
downloadcompcert-kvx-e5b59af8a21c42b504b1beeb89208dd0cb0c8b3b.tar.gz
compcert-kvx-e5b59af8a21c42b504b1beeb89208dd0cb0c8b3b.zip
Moved the timing facility to a seperate file.
-rw-r--r--cparser/Parse.ml6
-rw-r--r--driver/Clflags.ml50
-rw-r--r--driver/Driver.ml1
-rw-r--r--driver/Timing.ml63
-rw-r--r--extraction/extraction.v2
5 files changed, 68 insertions, 54 deletions
diff --git a/cparser/Parse.ml b/cparser/Parse.ml
index 61b5bc41..59b04e7a 100644
--- a/cparser/Parse.ml
+++ b/cparser/Parse.ml
@@ -48,7 +48,7 @@ let preprocessed_file transfs name sourcefile =
let rec inf = Datatypes.S inf in
let ast : Cabs.definition list =
Obj.magic
- (match Clflags.time2 "Parsing"
+ (match Timing.time2 "Parsing"
Parser.translation_unit_file inf (Lexer.tokens_stream lb) with
| Parser.Parser.Inter.Fail_pr ->
(* Theoretically impossible : implies inconsistencies
@@ -56,8 +56,8 @@ let preprocessed_file transfs name sourcefile =
Cerrors.fatal_error "Internal error while parsing"
| Parser.Parser.Inter.Timeout_pr -> assert false
| Parser.Parser.Inter.Parsed_pr (ast, _ ) -> ast) in
- let p1 = Clflags.time "Elaboration" Elab.elab_file ast in
- Clflags.time2 "Emulations" transform_program t p1
+ let p1 = Timing.time "Elaboration" Elab.elab_file ast in
+ Timing.time2 "Emulations" transform_program t p1
with
| Cerrors.Abort ->
[] in
diff --git a/driver/Clflags.ml b/driver/Clflags.ml
index 76c98924..c6217ba1 100644
--- a/driver/Clflags.ml
+++ b/driver/Clflags.ml
@@ -54,53 +54,3 @@ let option_small_data =
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
diff --git a/driver/Driver.ml b/driver/Driver.ml
index ae397838..7dacc4d2 100644
--- a/driver/Driver.ml
+++ b/driver/Driver.ml
@@ -13,6 +13,7 @@
open Printf
open Camlcoq
open Clflags
+open Timing
(* Location of the compatibility library *)
diff --git a/driver/Timing.ml b/driver/Timing.ml
new file mode 100644
index 00000000..b45dad40
--- /dev/null
+++ b/driver/Timing.ml
@@ -0,0 +1,63 @@
+(* *********************************************************************)
+(* *)
+(* The Compcert verified compiler *)
+(* *)
+(* Bernhard Schommer, AbsInt Angewandte Informatik GmbH *)
+(* *)
+(* AbsInt Angewandte Informatik GmbH. All rights reserved. This file *)
+(* is distributed under the terms of the INRIA Non-Commercial *)
+(* License Agreement. *)
+(* *)
+(* *********************************************************************)
+
+open Clflags
+
+(** 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
diff --git a/extraction/extraction.v b/extraction/extraction.v
index f5556fd1..5b71a150 100644
--- a/extraction/extraction.v
+++ b/extraction/extraction.v
@@ -104,7 +104,7 @@ Extract Constant Compiler.print_RTL => "PrintRTL.print_if".
Extract Constant Compiler.print_LTL => "PrintLTL.print_if".
Extract Constant Compiler.print_Mach => "PrintMach.print_if".
Extract Constant Compiler.print => "fun (f: 'a -> unit) (x: 'a) -> f x; x".
-Extract Constant Compiler.time => "Clflags.time_coq".
+Extract Constant Compiler.time => "Timing.time_coq".
(*Extraction Inline Compiler.apply_total Compiler.apply_partial.*)