Heptc works !!

This commit is contained in:
Cédric Pasteur 2010-06-18 15:40:48 +02:00
parent 45be96acb8
commit 2a6db8cb79
6 changed files with 157 additions and 222 deletions

View file

@ -46,7 +46,7 @@ let compile_impl modname filename =
end;
(* Call the compiler*)
Hept_compiler.compile_impl pp p;
let p = Hept_compiler.compile_impl pp p in
if !verbose
then begin
@ -78,7 +78,7 @@ let compile_interface modname filename =
let l = Scoping.translate_interface l in
(* Call the compiler*)
Hept_compiler.compile_interface l;
let l = Hept_compiler.compile_interface l in
Modules.write itc;

View file

@ -1,115 +0,0 @@
(**************************************************************************)
(* *)
(* Heptagon *)
(* *)
(* Author : Marc Pouzet *)
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
(* *)
(**************************************************************************)
(* $Id$ *)
open Location
open Misc
open Compiler_utils
let parse_implementation lexbuf =
parse Parser.program Lexer.token lexbuf
let parse_interface lexbuf =
parse Parser.interface Lexer.token lexbuf
let interface modname filename =
(* input and output files *)
let source_name = filename ^ ".epi"
and obj_interf_name = filename ^ ".epci" in
let ic = open_in source_name
and itc = open_out_bin obj_interf_name in
let close_all_files () =
close_in ic;
close_out itc in
try
Location.initialize source_name ic;
Modules.initialize modname;
Initial.initialize ();
(* Parsing of the file *)
let lexbuf = Lexing.from_channel ic in
let l = parse_interface lexbuf in
(* Convert the parse tree to Heptagon AST *)
let l = Scoping.translate_interface l in
Interface.Type.main l;
Modules.write itc;
if !print_types then Interface.Printer.print stdout;
close_all_files ()
with
| x -> close_all_files (); raise x
let compile modname filename =
(* input and output files *)
let source_name = filename ^ ".ept"
and obj_interf_name = filename ^ ".epci"
and mls_name = filename ^ ".mls"
and obc_name = filename ^ ".obc"
and ml_name = filename ^ ".ml" in
let ic = open_in source_name
and itc = open_out_bin obj_interf_name
and mlsc = open_out mls_name
and obc = open_out obc_name
and mlc = open_out ml_name in
let close_all_files () =
close_in ic;
close_out itc;
close_out mlsc;
close_out obc;
close_out mlc in
try
init_compiler modname source_name ic;
let pp = Printer.print stdout in
(* Parsing of the file *)
let lexbuf = Lexing.from_channel ic in
let p = parse_implementation lexbuf in
(* Convert the parse tree to Heptagon AST *)
let p = Scoping.translate_program p in
if !verbose
then begin
comment "Parsing";
pp p
end;
(* Process the Heptagon AST *)
Hept_compiler.compile pp p;
(* Compile Heptagon to MinilLs *)
let p = Hep2mls.program p;
let pp = Minils.Printer.print stdout in
if !verbose then comment "Translation into MiniLs";
Minils.Printer.print mlsc p;
(* Process the MiniLs AST *)
Mls_compiler.compile pp p;
(* Compile MiniLs to Obc *)
let o = Mls2obc.program p in
if !verbose then comment "Translation into Obc";
Obc.Printer.print obc o;
let pp = Obc.Printer.print stdout in
if !verbose then pp o;
(* Translation into dataflow and sequential languages *)
targets filename p o !target_languages;
close_all_files ();
with x -> close_all_files (); raise x

153
main/heptc.ml Normal file
View file

@ -0,0 +1,153 @@
(**************************************************************************)
(* *)
(* Heptagon *)
(* *)
(* Author : Marc Pouzet *)
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
(* *)
(**************************************************************************)
(* the main *)
open Misc
open Compiler_utils
let parse_implementation lexbuf =
parse Parser.program Lexer.token lexbuf
let parse_interface lexbuf =
parse Parser.interface Lexer.token lexbuf
let interface modname filename =
(* input and output files *)
let source_name = filename ^ ".epi"
and obj_interf_name = filename ^ ".epci" in
let ic = open_in source_name
and itc = open_out_bin obj_interf_name in
let close_all_files () =
close_in ic;
close_out itc in
try
init_compiler modname source_name ic;
(* Parsing of the file *)
let lexbuf = Lexing.from_channel ic in
let l = parse_interface lexbuf in
(* Convert the parse tree to Heptagon AST *)
let l = Scoping.translate_interface l in
(* Call the compiler*)
let l = Hept_compiler.compile_interface l in
Modules.write itc;
close_all_files ()
with
| x -> close_all_files (); raise x
let compile modname filename =
(* input and output files *)
let source_name = filename ^ ".ept"
and obj_interf_name = filename ^ ".epci"
and mls_name = filename ^ ".mls"
and obc_name = filename ^ ".obc"
and ml_name = filename ^ ".ml" in
let ic = open_in source_name
and itc = open_out_bin obj_interf_name
and mlsc = open_out mls_name
and obc = open_out obc_name
and mlc = open_out ml_name in
let close_all_files () =
close_in ic;
close_out itc;
close_out mlsc;
close_out obc;
close_out mlc in
try
init_compiler modname source_name ic;
let pp = Printer.print stdout in
(* Parsing of the file *)
let lexbuf = Lexing.from_channel ic in
let p = parse_implementation lexbuf in
(* Convert the parse tree to Heptagon AST *)
let p = Scoping.translate_program p in
if !verbose
then begin
comment "Parsing";
pp p
end;
(* Process the Heptagon AST *)
let p = Hept_compiler.compile_impl pp p in
(* Compile Heptagon to MiniLS *)
let p = Hept2mls.program p in
let pp = Minils_printer.print stdout in
if !verbose then comment "Translation into MiniLs";
Minils_printer.print mlsc p;
(* Process the MiniLS AST *)
let p = Mls_compiler.compile pp p in
(* Compile MiniLS to Obc *)
let o = Mls2obc.program p in
(*if !verbose then*) comment "Translation into Obc";
Obc.Printer.print obc o;
let pp = Obc.Printer.print stdout in
if !verbose then pp o;
(* Translation into dataflow and sequential languages *)
Mls2seq.targets filename p o !target_languages;
close_all_files ()
with
| x -> close_all_files (); raise x
let compile file =
if Filename.check_suffix file ".ept"
then
let filename = Filename.chop_suffix file ".ept" in
let modname = String.capitalize(Filename.basename filename) in
compile modname filename
else if Filename.check_suffix file ".epi"
then
let filename = Filename.chop_suffix file ".epi" in
let modname = String.capitalize(Filename.basename filename) in
interface modname filename
else
raise (Arg.Bad ("don't know what to do with " ^ file))
let main () =
try
Arg.parse
[
"-v",Arg.Set verbose, doc_verbose;
"-version", Arg.Unit show_version, doc_version;
"-i", Arg.Set print_types, doc_print_types;
"-I", Arg.String add_include, doc_include;
"-where", Arg.Unit locate_stdlib, doc_locate_stdlib;
"-stdlib", Arg.String set_stdlib, doc_stdlib;
"-s", Arg.String set_simulation_node, doc_sim;
"-nopervasives", Arg.Unit set_no_pervasives, doc_no_pervasives;
"-target", Arg.String add_target_language, doc_target;
"-targetpath", Arg.String set_target_path, doc_target_path;
"-noinit", Arg.Clear init, doc_noinit;
"-fti", Arg.Set full_type_info, doc_full_type_info;
]
compile
errmsg;
with
| Misc.Error -> exit 2;;
main ()

View file

@ -1,100 +0,0 @@
(**************************************************************************)
(* *)
(* Heptagon *)
(* *)
(* Author : Marc Pouzet *)
(* Organization : Demons, LRI, University of Paris-Sud, Orsay *)
(* *)
(**************************************************************************)
(* the main *)
(* $Id$ *)
open Misc
open Compiler
let compile file =
if Filename.check_suffix file ".ept"
then
let filename = Filename.chop_suffix file ".ept" in
let modname = String.capitalize(Filename.basename filename) in
compile modname filename
else if Filename.check_suffix file ".epi"
then
let filename = Filename.chop_suffix file ".epi" in
let modname = String.capitalize(Filename.basename filename) in
interface modname filename
else
raise (Arg.Bad ("don't know what to do with " ^ file))
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"
and doc_include = "<dir>\t\tAdd <dir> to the list of include directories"
and doc_stdlib = "<dir>\t\tDirectory for the standard library"
and doc_sim = "<node>\t\tCreate simulation for node <node>"
and doc_locate_stdlib = "\t\tLocate standard libray"
and doc_no_pervasives = "\tDo not load the pervasives module"
and doc_target =
"<lang>\tGenerate code in language <lang>\n\t\t\t(with <lang>=c, c-old,"
^ " vhdl_seq, vhdl_df,\n\t\t\t java, caml or z3z)"
and doc_full_type_info = "\t\t\tPrint full type information"
and doc_target_path =
"<path>\tGenerated files will be placed in <path>\n\t\t\t(the directory is cleaned)"
and doc_boolean = "\t\tTranslate enumerated values towards boolean vectors"
and doc_deadcode = "\t\tDeadcode removal"
and doc_noinit = "\t\tDisable initialization analysis"
and doc_cse = "\t\t\tPerform common sub-expression elimination"
and doc_tomato = "\t\tPerform auTOMATa minimizatiOn"
and doc_sigali = "\t\t\tGenerate symbolic equations for Sigali (Z/3Z format)"
and doc_flatten = "<node name>\tRecursively inline all calls in specified node"
and doc_inline = "<node list>\tInline the list of nodes, separated by commas"
and doc_dep2dot = "<node list>\tOutput to .dot files the dependency graph of "
^ "the list of nodes, separated by commas"
and doc_intermediate = "\t\tPerform intermediate-equations removal (buggy)"
and doc_nomemalloc = "\t\tDisable memory allocation algorithm"
and doc_interfscheduler = "\tUse the new scheduler, that tries to minimise interference"
and doc_main_node = "<node>\t\tUse <node> as the toplevel node"
and doc_new_reset = "\t\tUse the new alternate encoding of resets"
let errmsg = "Options are:"
let main () =
try
Arg.parse
[
"-v",Arg.Set verbose, doc_verbose;
"-version", Arg.Unit show_version, doc_version;
"-i", Arg.Set print_types, doc_print_types;
"-I", Arg.String add_include, doc_include;
"-where", Arg.Unit locate_stdlib, doc_locate_stdlib;
"-stdlib", Arg.String set_stdlib, doc_stdlib;
"-s", Arg.String set_simulation_node, doc_sim;
"-nopervasives", Arg.Unit set_no_pervasives, doc_no_pervasives;
"-target", Arg.String add_target_language, doc_target;
"-targetpath", Arg.String set_target_path, doc_target_path;
"-bool", Arg.Set boolean, doc_boolean;
"-deadcode", Arg.Set deadcode, doc_deadcode;
"-noinit", Arg.Clear init, doc_noinit;
"-fti", Arg.Set full_type_info, doc_full_type_info;
"-cse", Arg.Set cse, doc_cse;
"-tomato", Arg.Set tomato, doc_tomato;
"-z3z", Arg.Unit set_sigali, doc_sigali;
"-inter", Arg.Set intermediate, doc_intermediate;
"-flatten", Arg.String (fun s -> node_to_flatten := Some s), doc_flatten;
("-inline",
Arg.String (fun s -> nodes_to_inline := Misc.split_string s ','),
doc_inline);
("-dep2dot",
Arg.String (fun s -> nodes_to_display := Misc.split_string s ','),
doc_dep2dot);
"-nomemalloc", Arg.Set no_mem_alloc, doc_nomemalloc;
"-interfscheduler", Arg.Set use_interf_scheduler, doc_interfscheduler;
"-new-reset-encoding", Arg.Set use_new_reset_encoding, doc_new_reset;
]
compile
errmsg;
with
| Misc.Error -> exit 2;;
main ()

View file

@ -7,6 +7,8 @@
(* *)
(**************************************************************************)
open Compiler_utils
(** Generation of a dataflow target *)
let dataflow_target filename p target_languages =
let rec one_target = function

View file

@ -13,11 +13,6 @@ let compile pp p =
(* Clocking *)
let p = do_silent_pass Clocking.program "Clocking" p true in
(* Back-end causality check. Only useful to check that *)
(* we did not make any mistake during code generation *)
let p =
do_silent_pass Dfcausality.program "Causality check" p true in
(* Check that the dataflow code is well initialized *)
let p =
do_silent_pass Init.program "Initialization check" p !init in