From d1b9423d66a26b050390ee47fe1cdd7ebc356c17 Mon Sep 17 00:00:00 2001
From: David Doose <david.doose@gmail.com>
Date: Thu, 2 Mar 2017 18:12:04 +0100
Subject: [PATCH] mauve generator: first shot
---
include/arrow.hpp | 1 +
src/_tags | 1 +
src/backends/C/c_backend.ml | 28 +++++
src/backends/C/c_backend_common.ml | 2 +-
src/backends/C/c_backend_mauve.ml | 169 +++++++++++++++++++++++++++++
src/options.ml | 4 +
6 files changed, 204 insertions(+), 1 deletion(-)
create mode 100644 src/backends/C/c_backend_mauve.ml
diff --git a/include/arrow.hpp b/include/arrow.hpp
index 636c2301..e8e04500 100644
--- a/include/arrow.hpp
+++ b/include/arrow.hpp
@@ -2,6 +2,7 @@
#ifndef _ARROW_CPP
#define _ARROW_CPP
+#include <stdint.h>
#include <stdlib.h>
struct _arrow_mem {
diff --git a/src/_tags b/src/_tags
index 90ced608..286ec864 100644
--- a/src/_tags
+++ b/src/_tags
@@ -9,3 +9,4 @@
<*.ml{,i}>: package(ocamlgraph)
<*.ml{,i}>: use_str
<*.ml{,i}>: use_unix
+
diff --git a/src/backends/C/c_backend.ml b/src/backends/C/c_backend.ml
index d5749dd5..3a9f1e91 100644
--- a/src/backends/C/c_backend.ml
+++ b/src/backends/C/c_backend.ml
@@ -10,6 +10,7 @@
(********************************************************************)
open Format
+open C_backend_mauve
(********************************************************************************************)
(* Translation function *)
(********************************************************************************************)
@@ -65,6 +66,33 @@ let gen_files funs basename prog machines dependencies =
end
));
+ (match !Options.mauve with
+ | "" -> ()
+ | mauve -> (
+ (* looking for the main node *)
+ match Machine_code.get_machine_opt mauve machines with
+ | None -> begin
+ Global.main_node := mauve;
+ Format.eprintf "Code generation error: %a@." Corelang.pp_error LustreSpec.Main_not_found;
+ raise (Corelang.Error (Location.dummy_loc, LustreSpec.Main_not_found))
+ end
+ | Some m -> begin
+ let source_mauve_file = destname ^ "_mauve.hpp" in
+ let source_mauve_out = open_out source_mauve_file in
+ let source_mauve_fmt = formatter_of_out_channel source_mauve_out in
+ (* Header *)
+ print_mauve_header source_mauve_fmt m basename prog machines dependencies;
+ (* Shell *)
+ print_mauve_shell source_mauve_fmt m basename prog machines dependencies;
+ (* Core *)
+ print_mauve_core source_mauve_fmt m basename prog machines dependencies;
+ (* FSM *)
+ print_mauve_fsm source_mauve_fmt m basename prog machines dependencies;
+
+ close_out source_mauve_out;
+ end
+ ));
+
(* Makefiles:
- for the moment two cases
diff --git a/src/backends/C/c_backend_common.ml b/src/backends/C/c_backend_common.ml
index 803b426e..a8aa3b25 100644
--- a/src/backends/C/c_backend_common.ml
+++ b/src/backends/C/c_backend_common.ml
@@ -125,7 +125,7 @@ let is_basic_c_type t =
| _ -> false
let pp_c_basic_type_desc t_dsec =
- match (t_dsec) with
+ match t_dsec with
| Types.Tbool when !Options.cpp -> "bool"
| Types.Tbool -> "_Bool"
| Types.Tint -> !Options.int_type
diff --git a/src/backends/C/c_backend_mauve.ml b/src/backends/C/c_backend_mauve.ml
new file mode 100644
index 00000000..29797592
--- /dev/null
+++ b/src/backends/C/c_backend_mauve.ml
@@ -0,0 +1,169 @@
+open LustreSpec
+open Corelang
+open Machine_code
+open Format
+open C_backend_common
+open Utils
+
+(* module type MODIFIERS_MAINSRC =
+sig
+end
+
+module EmptyMod =
+struct
+end
+
+module Mauve = functor (Mod: MODIFIERS_MAINSRC) ->
+struct
+end
+ *)
+(********************************************************************************************)
+(* Main related functions *)
+(********************************************************************************************)
+
+let mauve_default_value v =
+ let v_name = v.var_id in
+ let v_type = (Types.repr v.var_type).Types.tdesc in
+ match v_type with
+ | Types.Tbool -> "false"
+ | Types.Tint -> "0"
+ | Types.Treal -> "0.0"
+ | _ -> assert false
+
+let shell_name node = node ^ "Shell"
+let core_name node = node ^ "Core"
+let fsm_name node = node ^ "FSM"
+
+let print_mauve_header fmt mauve_machine basename prog machines _ (*dependencies*) =
+ fprintf fmt "#include \"mauve/runtime.hpp\"@.";
+ print_import_alloc_prototype fmt (Dep (true, basename, [], true (* assuming it is stateful*) ));
+ pp_print_newline fmt ();
+ pp_print_newline fmt ()
+
+
+let print_mauve_shell fmt mauve_machine basename prog machines _ (*dependencies*) =
+ let node_name = mauve_machine.mname.node_id in
+
+ fprintf fmt "/*@.";
+ fprintf fmt " * SHELL@.";
+ fprintf fmt " */@.";
+
+ fprintf fmt "struct %s: public Shell {@." (shell_name node_name);
+
+ (* in ports *)
+ fprintf fmt "\t// InputPorts@.";
+ List.iter
+ (fun v ->
+ let v_name = v.var_id in
+ let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
+ let default = mauve_default_value v in
+ fprintf fmt "\tReadPort<%s> port_%s = mk_readPort<%s>(\"%s\", %s);@." v_type v_name v_type v_name default;
+ ) mauve_machine.mstep.step_inputs;
+ (* out ports *)
+ fprintf fmt "\t// OutputPorts@.";
+ List.iter
+ (fun v ->
+ let v_name = v.var_id in
+ let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
+ fprintf fmt "\tWritePort<%s> port_%s = mk_writePort<%s>(\"%s\");@." v_type v_name v_type v_name;
+ ) mauve_machine.mstep.step_outputs;
+
+ fprintf fmt "};@.";
+
+ pp_print_newline fmt ()
+
+let print_mauve_step fmt node_name mauve_machine =
+ fprintf fmt "\t\t%s_step(" node_name;
+ List.iter
+ (fun v ->
+ let v_name = v.var_id in
+ fprintf fmt "%s, " v_name;
+ ) mauve_machine.mstep.step_inputs;
+ List.iter
+ (fun v ->
+ let v_name = v.var_id in
+ fprintf fmt "&%s, " v_name;
+ ) mauve_machine.mstep.step_outputs;
+ fprintf fmt "node";
+ fprintf fmt ");@."
+
+let print_mauve_core fmt mauve_machine basename prog machines _ (*dependencies*) =
+ let node_name = mauve_machine.mname.node_id in
+
+ fprintf fmt "/*@.";
+ fprintf fmt " * CORE@.";
+ fprintf fmt " */@.";
+
+ fprintf fmt "struct %s: public Core<%s> {@." (core_name node_name) (shell_name node_name);
+
+ (* Attribute *)
+ fprintf fmt "\tstruct %s_mem * node;@." node_name;
+ pp_print_newline fmt ();
+ (* Update *)
+ fprintf fmt "\tvoid update() {@.";
+ List.iter
+ (fun v ->
+ let v_name = v.var_id in
+ let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
+ fprintf fmt "\t\t%s %s = port_%s.read();@." v_type v_name v_name;
+ ) mauve_machine.mstep.step_inputs;
+ List.iter
+ (fun v ->
+ let v_name = v.var_id in
+ let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
+ fprintf fmt "\t\t%s %s;@." v_type v_name;
+ ) mauve_machine.mstep.step_outputs;
+ print_mauve_step fmt node_name mauve_machine;
+ List.iter
+ (fun v ->
+ let v_name = v.var_id in
+ fprintf fmt "\t\tport_%s.write(%s);@." v_name v_name;
+ ) mauve_machine.mstep.step_outputs;
+ fprintf fmt "\t}@.";
+ pp_print_newline fmt ();
+ (* Configure *)
+ fprintf fmt "\tbool configure_hook() override {@.";
+ fprintf fmt "\t\tnode = %s_alloc();@." node_name;
+ fprintf fmt "\t\t%s_reset(node);@." node_name;
+ fprintf fmt "\t\treturn true;@.";
+ fprintf fmt "\t}@.";
+ pp_print_newline fmt ();
+ (* Cleanup *)
+ fprintf fmt "\tvoid cleanup_hook() override {@.";
+ fprintf fmt "\t\t%s_reset(node);@." node_name;
+ fprintf fmt "\t\tfree(node);@.";
+ fprintf fmt "\t}@.";
+ fprintf fmt "};@.";
+ pp_print_newline fmt ()
+
+
+let print_mauve_fsm fmt mauve_machine basename prog machines _ (*dependencies*) =
+ let node_name = mauve_machine.mname.node_id in
+
+ fprintf fmt "/*@.";
+ fprintf fmt " * FSM@.";
+ fprintf fmt " */@.";
+
+ fprintf fmt "struct %s: public FiniteStateMachine<%s, %s> {@." (fsm_name node_name) (shell_name node_name) (core_name node_name);
+
+ (* Attribute *)
+ fprintf fmt "\tExecState<%s> & update = mk_execution (\"Update\" , &%s::update);@." (core_name node_name) (core_name node_name);
+ fprintf fmt "\tSynchroState<%s> & synchro = mk_synchronization(\"Synchro\", ms_to_ns(100));@." (core_name node_name);
+ pp_print_newline fmt ();
+ (* Configure *)
+ fprintf fmt "\tbool configure_hook() override {@.";
+ fprintf fmt "\t\tset_initial(update);@.";
+ fprintf fmt "\t\tset_next(update, synchro);@.";
+ fprintf fmt "\t\tset_next(synchro, update);@.";
+ fprintf fmt "\t\treturn true;@.";
+ fprintf fmt "\t}@.";
+ pp_print_newline fmt ();
+ (* Cleanup *)
+ fprintf fmt "\tvoid cleanup_hook() override {@.";
+ fprintf fmt "\t}@.";
+ fprintf fmt "};@.";
+ pp_print_newline fmt ()
+
+(* Local Variables: *)
+(* compile-command:"make -C ../../.." *)
+(* End: *)
diff --git a/src/options.ml b/src/options.ml
index 98d684e6..b678d85a 100755
--- a/src/options.ml
+++ b/src/options.ml
@@ -55,6 +55,8 @@ let cpp = ref false
let int_type = ref "int"
let real_type = ref "double"
+let mauve = ref ""
+
let sfunction = ref ""
let set_mpfr prec =
@@ -98,6 +100,8 @@ let options =
"-c++" , Arg.Set cpp , "c++ backend";
"-int" , Arg.Set_string int_type , "specifies the integer type (default=\"int\")";
"-real", Arg.Set_string real_type, "specifies the real type (default=\"double\" without mpfr option)";
+
+ "-mauve", Arg.String (fun node -> mauve := node; cpp := true; static_mem := false), "generates the mauve code";
]
--
GitLab