Revision 08fd9ec8
Added by David Doose almost 8 years ago
| src/backends/C/c_backend_mauve.ml | ||
|---|---|---|
| 4 | 4 |
open Format |
| 5 | 5 |
open C_backend_common |
| 6 | 6 |
open Utils |
| 7 |
open Printers |
|
| 7 | 8 |
|
| 8 | 9 |
(* module type MODIFIERS_MAINSRC = |
| 9 | 10 |
sig |
| ... | ... | |
| 21 | 22 |
(* Main related functions *) |
| 22 | 23 |
(********************************************************************************************) |
| 23 | 24 |
|
| 24 |
let mauve_default_value v = |
|
| 25 |
let v_name = v.var_id in |
|
| 26 |
let v_type = (Types.repr v.var_type).Types.tdesc in |
|
| 27 |
match v_type with |
|
| 28 |
| Types.Tbool -> "false" |
|
| 29 |
| Types.Tint -> "0" |
|
| 30 |
| Types.Treal -> "0.0" |
|
| 31 |
| _ -> assert false |
|
| 32 |
|
|
| 33 | 25 |
let shell_name node = node ^ "Shell" |
| 34 | 26 |
let core_name node = node ^ "Core" |
| 35 | 27 |
let fsm_name node = node ^ "FSM" |
| 36 | 28 |
|
| 29 |
(* -------------------------------------------------- *) |
|
| 30 |
(* Hearder *) |
|
| 31 |
(* -------------------------------------------------- *) |
|
| 32 |
|
|
| 37 | 33 |
let print_mauve_header fmt mauve_machine basename prog machines _ (*dependencies*) = |
| 38 | 34 |
fprintf fmt "#include \"mauve/runtime.hpp\"@."; |
| 39 | 35 |
print_import_alloc_prototype fmt (Dep (true, basename, [], true (* assuming it is stateful*) )); |
| 40 | 36 |
pp_print_newline fmt (); |
| 41 | 37 |
pp_print_newline fmt () |
| 42 | 38 |
|
| 39 |
(* -------------------------------------------------- *) |
|
| 40 |
(* Shell *) |
|
| 41 |
(* -------------------------------------------------- *) |
|
| 42 |
|
|
| 43 |
let mauve_default_value v = |
|
| 44 |
let v_name = v.var_id in |
|
| 45 |
let v_type = (Types.repr v.var_type).Types.tdesc in |
|
| 46 |
match v_type with |
|
| 47 |
| Types.Tbool -> "false" |
|
| 48 |
| Types.Tint -> "0" |
|
| 49 |
| Types.Treal -> "0.0" |
|
| 50 |
| _ -> assert false |
|
| 51 |
|
|
| 52 |
let print_mauve_default fmt mauve_machine v = |
|
| 53 |
let v_name: string = v.var_id in |
|
| 54 |
let found = ref false in |
|
| 55 |
let annotations: expr_annot list = mauve_machine.mname.node_annot in |
|
| 56 |
List.iter |
|
| 57 |
(fun (al: expr_annot) -> |
|
| 58 |
List.iter |
|
| 59 |
(fun ((sl, e): string list * eexpr) -> if not !found then match sl with |
|
| 60 |
| ["mauve"; "default"; name] -> |
|
| 61 |
if v_name = name then begin (pp_expr fmt e.eexpr_qfexpr); found := true; end |
|
| 62 |
| _ -> (); |
|
| 63 |
) al.annots; |
|
| 64 |
) annotations; |
|
| 65 |
if not !found then fprintf fmt "%s" (mauve_default_value v) |
|
| 66 |
|
|
| 43 | 67 |
|
| 44 | 68 |
let print_mauve_shell fmt mauve_machine basename prog machines _ (*dependencies*) = |
| 45 | 69 |
let node_name = mauve_machine.mname.node_id in |
| ... | ... | |
| 56 | 80 |
(fun v -> |
| 57 | 81 |
let v_name = v.var_id in |
| 58 | 82 |
let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in |
| 59 |
let default = mauve_default_value v in |
|
| 60 |
fprintf fmt "\tReadPort<%s> port_%s = mk_readPort<%s>(\"%s\", %s);@." v_type v_name v_type v_name default; |
|
| 83 |
fprintf fmt "\tReadPort<%s> port_%s = mk_readPort<%s>(\"%s\", " v_type v_name v_type v_name; |
|
| 84 |
print_mauve_default fmt mauve_machine v; |
|
| 85 |
fprintf fmt ");@."; |
|
| 61 | 86 |
) mauve_machine.mstep.step_inputs; |
| 62 | 87 |
(* out ports *) |
| 63 | 88 |
fprintf fmt "\t// OutputPorts@."; |
| ... | ... | |
| 87 | 112 |
fprintf fmt "node"; |
| 88 | 113 |
fprintf fmt ");@." |
| 89 | 114 |
|
| 115 |
(* -------------------------------------------------- *) |
|
| 116 |
(* Core *) |
|
| 117 |
(* -------------------------------------------------- *) |
|
| 118 |
|
|
| 90 | 119 |
let print_mauve_core fmt mauve_machine basename prog machines _ (*dependencies*) = |
| 91 | 120 |
let node_name = mauve_machine.mname.node_id in |
| 92 | 121 |
|
| ... | ... | |
| 136 | 165 |
fprintf fmt "};@."; |
| 137 | 166 |
pp_print_newline fmt () |
| 138 | 167 |
|
| 168 |
(* -------------------------------------------------- *) |
|
| 169 |
(* FSM *) |
|
| 170 |
(* -------------------------------------------------- *) |
|
| 171 |
|
|
| 172 |
let print_period_conversion fmt expr = ( |
|
| 173 |
match expr.expr_desc with |
|
| 174 |
| Expr_tuple [p; u] -> ( |
|
| 175 |
match u.expr_desc with |
|
| 176 |
| Expr_ident "s" -> fprintf fmt "sec_to_ns("; (pp_expr fmt p); fprintf fmt ")"
|
|
| 177 |
| Expr_ident "ssec"-> fprintf fmt "sec_to_ns("; (pp_expr fmt p); fprintf fmt ")"
|
|
| 178 |
| Expr_ident "ms" -> fprintf fmt "ms_to_ns(" ; (pp_expr fmt p); fprintf fmt ")"
|
|
| 179 |
| Expr_ident "ns" -> pp_expr fmt p |
|
| 180 |
| _ -> assert false |
|
| 181 |
) |
|
| 182 |
| _ -> assert false |
|
| 183 |
) |
|
| 184 |
|
|
| 185 |
let print_mauve_period fmt mauve_machine = |
|
| 186 |
let found = ref false in |
|
| 187 |
let annotations: expr_annot list = mauve_machine.mname.node_annot in |
|
| 188 |
List.iter |
|
| 189 |
(fun (al: expr_annot) -> |
|
| 190 |
List.iter |
|
| 191 |
(fun ((sl, e): string list * eexpr) -> if not !found then match sl with |
|
| 192 |
| ["mauve"; "period" ] -> (print_period_conversion fmt e.eexpr_qfexpr); found := true; |
|
| 193 |
| _ -> (); |
|
| 194 |
) al.annots; |
|
| 195 |
) annotations; |
|
| 196 |
if not !found then fprintf fmt "0" |
|
| 197 |
|
|
| 139 | 198 |
|
| 140 | 199 |
let print_mauve_fsm fmt mauve_machine basename prog machines _ (*dependencies*) = |
| 141 | 200 |
let node_name = mauve_machine.mname.node_id in |
| ... | ... | |
| 148 | 207 |
|
| 149 | 208 |
(* Attribute *) |
| 150 | 209 |
fprintf fmt "\tExecState<%s> & update = mk_execution (\"Update\" , &%s::update);@." (core_name node_name) (core_name node_name); |
| 151 |
fprintf fmt "\tSynchroState<%s> & synchro = mk_synchronization(\"Synchro\", ms_to_ns(100));@." (core_name node_name); |
|
| 210 |
fprintf fmt "\tSynchroState<%s> & synchro = mk_synchronization(\"Synchro\", " (core_name node_name); |
|
| 211 |
print_mauve_period fmt mauve_machine; |
|
| 212 |
fprintf fmt ");@."; |
|
| 152 | 213 |
pp_print_newline fmt (); |
| 153 | 214 |
(* Configure *) |
| 154 | 215 |
fprintf fmt "\tbool configure_hook() override {@.";
|
Also available in: Unified diff
mauve generator with annotations