From e05f3732a05066abfd78c64450434cdc5b2ebe94 Mon Sep 17 00:00:00 2001 From: Adrien Guatto Date: Wed, 7 Mar 2012 17:44:57 +0100 Subject: [PATCH] Timing framework. --- compiler/main/hept2mls.ml | 35 ++++++++++--------- compiler/main/heptc.ml | 10 ++++-- compiler/main/mls2seq.ml | 23 ++++++------ compiler/utilities/global/compiler_options.ml | 3 ++ compiler/utilities/global/compiler_utils.ml | 8 +++-- 5 files changed, 46 insertions(+), 33 deletions(-) diff --git a/compiler/main/hept2mls.ml b/compiler/main/hept2mls.ml index 1480ea0..6069354 100644 --- a/compiler/main/hept2mls.ml +++ b/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 diff --git a/compiler/main/heptc.ml b/compiler/main/heptc.ml index 2ee6df9..4853e0d 100644 --- a/compiler/main/heptc.ml +++ b/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 diff --git a/compiler/main/mls2seq.ml b/compiler/main/mls2seq.ml index 78ee0d0..43cb0df 100644 --- a/compiler/main/mls2seq.ml +++ b/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 diff --git a/compiler/utilities/global/compiler_options.ml b/compiler/utilities/global/compiler_options.ml index 095a8ac..7f0e549 100644 --- a/compiler/utilities/global/compiler_options.ml +++ b/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" diff --git a/compiler/utilities/global/compiler_utils.ml b/compiler/utilities/global/compiler_utils.ml index e496733..942fa32 100644 --- a/compiler/utilities/global/compiler_utils.ml +++ b/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 _ -> ())