Timing framework.

compiler/main/hept2mls.ml

@@ -88,29 +88,30 @@ let translate_app app =
     ~id:(Some (fresh app.Heptagon.a_op))
     (translate_op app.Heptagon.a_op)
 
-let rec translate_extvalue e =
-  let mk_extvalue =
-    let clock = match e.Heptagon.e_ct_annot with
-      | None -> fresh_clock ()
-      | Some ct -> assert_1 (unprod ct)
-    in
-    mk_extvalue ~loc:e.Heptagon.e_loc ~linearity:e.Heptagon.e_linearity
-                ~ty:e.Heptagon.e_ty ~clock:clock
+let mk_extvalue e w =
+  let clock = match e.Heptagon.e_ct_annot with
+    | None -> fresh_clock ()
+    | Some ct -> assert_1 (unprod ct)
   in
+  mk_extvalue ~loc:e.Heptagon.e_loc ~linearity:e.Heptagon.e_linearity
+    ~ty:e.Heptagon.e_ty ~clock:clock w
+
+
+let rec translate_extvalue e =
   match e.Heptagon.e_desc with
-    | Heptagon.Econst c -> mk_extvalue (Wconst c)
-    | Heptagon.Evar x -> mk_extvalue (Wvar x)
+    | Heptagon.Econst c -> mk_extvalue e (Wconst c)
+    | Heptagon.Evar x -> mk_extvalue e (Wvar x)
     | Heptagon.Ewhen (e, c, x) ->
-        mk_extvalue (Wwhen (translate_extvalue e, c, x))
+        mk_extvalue e (Wwhen (translate_extvalue e, c, x))
     | Heptagon.Eapp({ Heptagon.a_op = Heptagon.Efield;
                       Heptagon.a_params = params }, e_list, _) ->
         let e = assert_1 e_list in
         let f = assert_1 params in
         let fn = match f.se_desc with Sfield fn -> fn | _ -> assert false in
-          mk_extvalue (Wfield (translate_extvalue e, fn))
+          mk_extvalue e (Wfield (translate_extvalue e, fn))
     | Heptagon.Eapp({ Heptagon.a_op = Heptagon.Ereinit }, e_list, _) ->
         let e1, e2 = assert_2 e_list in
-          mk_extvalue (Wreinit (translate_extvalue e1, translate_extvalue e2))
+          mk_extvalue e (Wreinit (translate_extvalue e1, translate_extvalue e2))
     | _ -> Error.message e.Heptagon.e_loc Error.Enormalization
 
 let rec translate ({ Heptagon.e_desc = desc; Heptagon.e_ty = ty;
@@ -139,10 +140,10 @@ let rec translate ({ Heptagon.e_desc = desc; Heptagon.e_ty = ty;
         Eapp (translate_app app, List.map translate_extvalue e_list, translate_reset reset)
     | Heptagon.Eiterator(it, app, n, pe_list, e_list, reset) ->
         Eiterator (translate_iterator_type it,
-                    translate_app app, n,
-                    List.map translate_extvalue pe_list,
-                    List.map translate_extvalue e_list,
-                    translate_reset reset)
+                   translate_app app, n,
+                   List.map translate_extvalue pe_list,
+                   List.map translate_extvalue e_list,
+                   translate_reset reset)
     | Heptagon.Efby _ | Heptagon.Esplit _
     | Heptagon.Elast _ ->
         Error.message loc Error.Eunsupported_language_construct

compiler/main/heptc.ml

@@ -60,21 +60,24 @@ let compile_program modname source_f =
   try
   (* Activates passes according to the backend used *)
     Mls2seq.load_conf ();
+  (* Record timing information *)
+    Compiler_timings.start_compiling modname;
   (* Process the [lexbuf] to an Heptagon AST *)
     let p = Hept_parser_scoper.parse_program modname lexbuf in
   (* Process the Heptagon AST *)
     let p = Hept_compiler.compile_program p in
   (* Compile Heptagon to MiniLS *)
-    let p = do_pass "Translation into MiniLs" Hept2mls.program p Mls_compiler.pp in
+    let p = do_pass "Translation into MiniLS" Hept2mls.program p Mls_compiler.pp in
   (* Output the .mls *)
-    Mls_printer.print mls_c p;
+    do_silent_pass "MiniLS serialization" (fun () -> Mls_printer.print mls_c p) ();
   (* Process the MiniLS AST *)
     let p = Mls_compiler.compile_program p in
   (* Output the .epci *)
     output_value epci_c (Modules.current_module ());
   (* Generate the sequential code *)
     Mls2seq.program p;
-    close_all_files ()
+    close_all_files ();
+    Compiler_timings.report_statistics ()
   with x -> close_all_files (); raise x
 
 
@@ -132,6 +135,7 @@ let main () =
         "-unroll", Arg.Set unroll_loops, doc_unroll;
         "-O", Arg.Unit do_optim, doc_optim;
         "-mall", Arg.Set interf_all, doc_interf_all;
+        "-time", Arg.Set time_passes, doc_time_passes;
       ]
         compile errmsg;
   with

compiler/main/mls2seq.ml

@@ -50,7 +50,7 @@ let write_object_file p =
 let write_obc_file p =
   let obc_name = (Names.modul_to_string p.Obc.p_modname)^".obc" in
   let obc = open_out obc_name in
-    Obc_printer.print obc p;
+    do_silent_pass "Obc serialization" (Obc_printer.print obc) p;
     close_out obc;
     comment "Generation of Obc code"
 
@@ -80,27 +80,30 @@ let generate_target p s =
     if !Compiler_options.verbose
     then List.iter (Mls_printer.print stderr) p_list in*)
   let target = (find_target s).t_program in
+  let callgraph p = do_silent_pass "Callgraph" Callgraph.program p in
+  let mls2obc p = do_silent_pass "Translation into MiniLS" Mls2obc.program p in
+  let mls2obc_list p_l = do_silent_pass "Translation into MiniLS" (List.map Mls2obc.program) p_l in
   match target with
     | Minils convert_fun ->
-        convert_fun p
+        do_silent_pass "Code generation from MiniLS" convert_fun p
     | Obc convert_fun ->
-        let o = Mls2obc.program p in
+        let o = mls2obc p in
         let o = Obc_compiler.compile_program o in
-          convert_fun o
+        do_silent_pass "Code generation from Obc" convert_fun o
     | Minils_no_params convert_fun ->
-        let p_list = Callgraph.program p in
-          List.iter convert_fun p_list
+        let p_list = callgraph p in
+        do_silent_pass "Code generation from Obc (w/o params)" (List.iter convert_fun) p_list
     | Obc_no_params convert_fun ->
-        let p_list = Callgraph.program p in
-        let o_list = List.map Mls2obc.program p_list in
+        let p_list = callgraph p in
+        let o_list = mls2obc_list p_list in
         let o_list = List.map Obc_compiler.compile_program o_list in
-        List.iter convert_fun o_list
+        do_silent_pass "Code generation from Obc (w/o params)"         List.iter convert_fun o_list
 
 let generate_interface i s =
   let target = (find_target s).t_interface  in
   match target with
     | IObc convert_fun ->
-      let o = Mls2obc.interface i in
+      let o = do_silent_pass "Translation into Obc (interfaces)" Mls2obc.interface i in
       convert_fun o
     | IMinils convert_fun -> convert_fun i
 

compiler/utilities/global/compiler_options.ml

@@ -137,6 +137,8 @@ let check_options () =
 
 let interf_all = ref false
 
+let time_passes = ref false
+
 let doc_verbose = "\t\t\tSet verbose mode"
 and doc_version = "\t\tThe version of the compiler"
 and doc_print_types = "\t\t\tPrint types"
@@ -173,3 +175,4 @@ and doc_interf_scheduler = "\tUse the old scheduler"
 and doc_optim = "\t\t\tOptimize with deadcode, tomato, itfusion and memalloc"
 and doc_interf_all = "\t\tPerform memory allocation on all types"
 and doc_unroll = "\t\tUnroll all loops"
+and doc_time_passes = "\t\tTime compilation passes"

compiler/utilities/global/compiler_utils.ml

@@ -40,10 +40,12 @@ let comment ?(sep=separateur) s =
   if !verbose then Format.printf "%s%s@." sep s
 
 let do_pass d f p pp =
-  comment (d^" ...\n");
-  let r = f p in
+  comment (d ^ " ...\n");
+  let start = Unix.gettimeofday () in
+  let r = Compiler_timings.time_pass d f p in
+  let stop = Unix.gettimeofday () in
   pp r;
-  comment ~sep:"*** " (d^" done.");
+  comment ~sep:"*** " (d ^ " done.");
   r
 
 let do_silent_pass d f p = do_pass d f p (fun _ -> ())