Timing framework.
This commit is contained in:
parent
f09792485e
commit
e05f3732a0
|
@ -88,29 +88,30 @@ let translate_app app =
|
||||||
~id:(Some (fresh app.Heptagon.a_op))
|
~id:(Some (fresh app.Heptagon.a_op))
|
||||||
(translate_op app.Heptagon.a_op)
|
(translate_op app.Heptagon.a_op)
|
||||||
|
|
||||||
let rec translate_extvalue e =
|
let mk_extvalue e w =
|
||||||
let mk_extvalue =
|
let clock = match e.Heptagon.e_ct_annot with
|
||||||
let clock = match e.Heptagon.e_ct_annot with
|
| None -> fresh_clock ()
|
||||||
| None -> fresh_clock ()
|
| Some ct -> assert_1 (unprod ct)
|
||||||
| 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
|
|
||||||
in
|
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
|
match e.Heptagon.e_desc with
|
||||||
| Heptagon.Econst c -> mk_extvalue (Wconst c)
|
| Heptagon.Econst c -> mk_extvalue e (Wconst c)
|
||||||
| Heptagon.Evar x -> mk_extvalue (Wvar x)
|
| Heptagon.Evar x -> mk_extvalue e (Wvar x)
|
||||||
| Heptagon.Ewhen (e, c, 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.Eapp({ Heptagon.a_op = Heptagon.Efield;
|
||||||
Heptagon.a_params = params }, e_list, _) ->
|
Heptagon.a_params = params }, e_list, _) ->
|
||||||
let e = assert_1 e_list in
|
let e = assert_1 e_list in
|
||||||
let f = assert_1 params in
|
let f = assert_1 params in
|
||||||
let fn = match f.se_desc with Sfield fn -> fn | _ -> assert false 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, _) ->
|
| Heptagon.Eapp({ Heptagon.a_op = Heptagon.Ereinit }, e_list, _) ->
|
||||||
let e1, e2 = assert_2 e_list in
|
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
|
| _ -> Error.message e.Heptagon.e_loc Error.Enormalization
|
||||||
|
|
||||||
let rec translate ({ Heptagon.e_desc = desc; Heptagon.e_ty = ty;
|
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)
|
Eapp (translate_app app, List.map translate_extvalue e_list, translate_reset reset)
|
||||||
| Heptagon.Eiterator(it, app, n, pe_list, e_list, reset) ->
|
| Heptagon.Eiterator(it, app, n, pe_list, e_list, reset) ->
|
||||||
Eiterator (translate_iterator_type it,
|
Eiterator (translate_iterator_type it,
|
||||||
translate_app app, n,
|
translate_app app, n,
|
||||||
List.map translate_extvalue pe_list,
|
List.map translate_extvalue pe_list,
|
||||||
List.map translate_extvalue e_list,
|
List.map translate_extvalue e_list,
|
||||||
translate_reset reset)
|
translate_reset reset)
|
||||||
| Heptagon.Efby _ | Heptagon.Esplit _
|
| Heptagon.Efby _ | Heptagon.Esplit _
|
||||||
| Heptagon.Elast _ ->
|
| Heptagon.Elast _ ->
|
||||||
Error.message loc Error.Eunsupported_language_construct
|
Error.message loc Error.Eunsupported_language_construct
|
||||||
|
|
|
@ -60,21 +60,24 @@ let compile_program modname source_f =
|
||||||
try
|
try
|
||||||
(* Activates passes according to the backend used *)
|
(* Activates passes according to the backend used *)
|
||||||
Mls2seq.load_conf ();
|
Mls2seq.load_conf ();
|
||||||
|
(* Record timing information *)
|
||||||
|
Compiler_timings.start_compiling modname;
|
||||||
(* Process the [lexbuf] to an Heptagon AST *)
|
(* Process the [lexbuf] to an Heptagon AST *)
|
||||||
let p = Hept_parser_scoper.parse_program modname lexbuf in
|
let p = Hept_parser_scoper.parse_program modname lexbuf in
|
||||||
(* Process the Heptagon AST *)
|
(* Process the Heptagon AST *)
|
||||||
let p = Hept_compiler.compile_program p in
|
let p = Hept_compiler.compile_program p in
|
||||||
(* Compile Heptagon to MiniLS *)
|
(* 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 *)
|
(* 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 *)
|
(* Process the MiniLS AST *)
|
||||||
let p = Mls_compiler.compile_program p in
|
let p = Mls_compiler.compile_program p in
|
||||||
(* Output the .epci *)
|
(* Output the .epci *)
|
||||||
output_value epci_c (Modules.current_module ());
|
output_value epci_c (Modules.current_module ());
|
||||||
(* Generate the sequential code *)
|
(* Generate the sequential code *)
|
||||||
Mls2seq.program p;
|
Mls2seq.program p;
|
||||||
close_all_files ()
|
close_all_files ();
|
||||||
|
Compiler_timings.report_statistics ()
|
||||||
with x -> close_all_files (); raise x
|
with x -> close_all_files (); raise x
|
||||||
|
|
||||||
|
|
||||||
|
@ -132,6 +135,7 @@ let main () =
|
||||||
"-unroll", Arg.Set unroll_loops, doc_unroll;
|
"-unroll", Arg.Set unroll_loops, doc_unroll;
|
||||||
"-O", Arg.Unit do_optim, doc_optim;
|
"-O", Arg.Unit do_optim, doc_optim;
|
||||||
"-mall", Arg.Set interf_all, doc_interf_all;
|
"-mall", Arg.Set interf_all, doc_interf_all;
|
||||||
|
"-time", Arg.Set time_passes, doc_time_passes;
|
||||||
]
|
]
|
||||||
compile errmsg;
|
compile errmsg;
|
||||||
with
|
with
|
||||||
|
|
|
@ -50,7 +50,7 @@ let write_object_file p =
|
||||||
let write_obc_file p =
|
let write_obc_file p =
|
||||||
let obc_name = (Names.modul_to_string p.Obc.p_modname)^".obc" in
|
let obc_name = (Names.modul_to_string p.Obc.p_modname)^".obc" in
|
||||||
let obc = open_out obc_name 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;
|
close_out obc;
|
||||||
comment "Generation of Obc code"
|
comment "Generation of Obc code"
|
||||||
|
|
||||||
|
@ -80,27 +80,30 @@ let generate_target p s =
|
||||||
if !Compiler_options.verbose
|
if !Compiler_options.verbose
|
||||||
then List.iter (Mls_printer.print stderr) p_list in*)
|
then List.iter (Mls_printer.print stderr) p_list in*)
|
||||||
let target = (find_target s).t_program 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
|
match target with
|
||||||
| Minils convert_fun ->
|
| Minils convert_fun ->
|
||||||
convert_fun p
|
do_silent_pass "Code generation from MiniLS" convert_fun p
|
||||||
| Obc convert_fun ->
|
| Obc convert_fun ->
|
||||||
let o = Mls2obc.program p in
|
let o = mls2obc p in
|
||||||
let o = Obc_compiler.compile_program o 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 ->
|
| Minils_no_params convert_fun ->
|
||||||
let p_list = Callgraph.program p in
|
let p_list = callgraph p in
|
||||||
List.iter convert_fun p_list
|
do_silent_pass "Code generation from Obc (w/o params)" (List.iter convert_fun) p_list
|
||||||
| Obc_no_params convert_fun ->
|
| Obc_no_params convert_fun ->
|
||||||
let p_list = Callgraph.program p in
|
let p_list = callgraph p in
|
||||||
let o_list = List.map Mls2obc.program p_list in
|
let o_list = mls2obc_list p_list in
|
||||||
let o_list = List.map Obc_compiler.compile_program o_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 generate_interface i s =
|
||||||
let target = (find_target s).t_interface in
|
let target = (find_target s).t_interface in
|
||||||
match target with
|
match target with
|
||||||
| IObc convert_fun ->
|
| 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
|
convert_fun o
|
||||||
| IMinils convert_fun -> convert_fun i
|
| IMinils convert_fun -> convert_fun i
|
||||||
|
|
||||||
|
|
|
@ -137,6 +137,8 @@ let check_options () =
|
||||||
|
|
||||||
let interf_all = ref false
|
let interf_all = ref false
|
||||||
|
|
||||||
|
let time_passes = ref false
|
||||||
|
|
||||||
let doc_verbose = "\t\t\tSet verbose mode"
|
let doc_verbose = "\t\t\tSet verbose mode"
|
||||||
and doc_version = "\t\tThe version of the compiler"
|
and doc_version = "\t\tThe version of the compiler"
|
||||||
and doc_print_types = "\t\t\tPrint types"
|
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_optim = "\t\t\tOptimize with deadcode, tomato, itfusion and memalloc"
|
||||||
and doc_interf_all = "\t\tPerform memory allocation on all types"
|
and doc_interf_all = "\t\tPerform memory allocation on all types"
|
||||||
and doc_unroll = "\t\tUnroll all loops"
|
and doc_unroll = "\t\tUnroll all loops"
|
||||||
|
and doc_time_passes = "\t\tTime compilation passes"
|
||||||
|
|
|
@ -40,10 +40,12 @@ let comment ?(sep=separateur) s =
|
||||||
if !verbose then Format.printf "%s%s@." sep s
|
if !verbose then Format.printf "%s%s@." sep s
|
||||||
|
|
||||||
let do_pass d f p pp =
|
let do_pass d f p pp =
|
||||||
comment (d^" ...\n");
|
comment (d ^ " ...\n");
|
||||||
let r = f p in
|
let start = Unix.gettimeofday () in
|
||||||
|
let r = Compiler_timings.time_pass d f p in
|
||||||
|
let stop = Unix.gettimeofday () in
|
||||||
pp r;
|
pp r;
|
||||||
comment ~sep:"*** " (d^" done.");
|
comment ~sep:"*** " (d ^ " done.");
|
||||||
r
|
r
|
||||||
|
|
||||||
let do_silent_pass d f p = do_pass d f p (fun _ -> ())
|
let do_silent_pass d f p = do_pass d f p (fun _ -> ())
|
||||||
|
|
Loading…
Reference in a new issue