Revision ca7ff3f7
Added by Lélio Brun over 1 year ago
| src/backends/C/c_backend_mauve.ml | ||
|---|---|---|
| 5 | 5 |
open Utils |
| 6 | 6 |
open Printers |
| 7 | 7 |
|
| 8 |
(* module type MODIFIERS_MAINSRC = |
|
| 9 |
sig |
|
| 10 |
end |
|
| 11 |
|
|
| 12 |
module EmptyMod = |
|
| 13 |
struct |
|
| 14 |
end |
|
| 15 |
|
|
| 16 |
module Mauve = functor (Mod: MODIFIERS_MAINSRC) -> |
|
| 17 |
struct |
|
| 18 |
end |
|
| 19 |
*) |
|
| 8 |
(* module type MODIFIERS_MAINSRC = sig end |
|
| 9 |
|
|
| 10 |
module EmptyMod = struct end |
|
| 11 |
|
|
| 12 |
module Mauve = functor (Mod: MODIFIERS_MAINSRC) -> struct end *) |
|
| 20 | 13 |
(********************************************************************************************) |
| 21 |
(* Main related functions *)
|
|
| 14 |
(* Main related functions *)
|
|
| 22 | 15 |
(********************************************************************************************) |
| 23 | 16 |
|
| 24 | 17 |
let shell_name node = node ^ "Shell" |
| 25 |
let core_name node = node ^ "Core" |
|
| 26 |
let fsm_name node = node ^ "FSM" |
|
| 18 |
|
|
| 19 |
let core_name node = node ^ "Core" |
|
| 20 |
|
|
| 21 |
let fsm_name node = node ^ "FSM" |
|
| 27 | 22 |
|
| 28 | 23 |
(* -------------------------------------------------- *) |
| 29 | 24 |
(* Hearder *) |
| ... | ... | |
| 31 | 26 |
|
| 32 | 27 |
let print_mauve_header fmt basename = |
| 33 | 28 |
fprintf fmt "#include \"mauve/runtime.hpp\"@."; |
| 34 |
print_import_alloc_prototype fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful*) ;
|
|
| 29 |
print_import_alloc_prototype fmt |
|
| 30 |
{ local = true; name = basename; content = []; is_stateful = true }
|
|
| 31 |
(* assuming it is stateful*); |
|
| 35 | 32 |
pp_print_newline fmt (); |
| 36 | 33 |
pp_print_newline fmt () |
| 37 | 34 |
|
| ... | ... | |
| 41 | 38 |
|
| 42 | 39 |
let mauve_default_value v = |
| 43 | 40 |
(* let v_name = v.var_id in *) |
| 44 |
|
|
| 45 | 41 |
if Types.is_bool_type v.var_type then "false" |
| 46 | 42 |
else if Types.is_int_type v.var_type then "0" |
| 47 | 43 |
else if Types.is_real_type v.var_type then "0.0" |
| 48 | 44 |
else assert false |
| 49 | 45 |
|
| 50 |
let print_mauve_default fmt mauve_machine v =
|
|
| 51 |
let v_name: string = v.var_id in |
|
| 46 |
let print_mauve_default fmt mauve_machine v = |
|
| 47 |
let v_name : string = v.var_id in
|
|
| 52 | 48 |
let found = ref false in |
| 53 |
let annotations: expr_annot list = mauve_machine.mname.node_annot in |
|
| 49 |
let annotations : expr_annot list = mauve_machine.mname.node_annot in
|
|
| 54 | 50 |
List.iter |
| 55 |
(fun (al: expr_annot) -> |
|
| 56 |
List.iter |
|
| 57 |
(fun ((sl, e): string list * eexpr) -> if not !found then match sl with |
|
| 58 |
| ["mauve"; "default"; name] -> |
|
| 59 |
if v_name = name then begin (pp_expr fmt e.eexpr_qfexpr); found := true; end |
|
| 60 |
| _ -> (); |
|
| 61 |
) al.annots; |
|
| 62 |
) annotations; |
|
| 51 |
(fun (al : expr_annot) -> |
|
| 52 |
List.iter |
|
| 53 |
(fun ((sl, e) : string list * eexpr) -> |
|
| 54 |
if not !found then |
|
| 55 |
match sl with |
|
| 56 |
| [ "mauve"; "default"; name ] -> |
|
| 57 |
if v_name = name then ( |
|
| 58 |
pp_expr fmt e.eexpr_qfexpr; |
|
| 59 |
found := true) |
|
| 60 |
| _ -> |
|
| 61 |
()) |
|
| 62 |
al.annots) |
|
| 63 |
annotations; |
|
| 63 | 64 |
if not !found then fprintf fmt "%s" (mauve_default_value v) |
| 64 | 65 |
|
| 65 |
|
|
| 66 | 66 |
let print_mauve_shell fmt mauve_machine = |
| 67 | 67 |
let node_name = mauve_machine.mname.node_id in |
| 68 |
|
|
| 68 |
|
|
| 69 | 69 |
fprintf fmt "/*@."; |
| 70 | 70 |
fprintf fmt " * SHELL@."; |
| 71 | 71 |
fprintf fmt " */@."; |
| ... | ... | |
| 78 | 78 |
(fun v -> |
| 79 | 79 |
let v_name = v.var_id in |
| 80 | 80 |
let v_type = pp_c_basic_type_desc v.var_type in |
| 81 |
fprintf fmt "\tReadPort<%s> & port_%s = mk_readPort<%s>(\"%s\", " v_type v_name v_type v_name; |
|
| 81 |
fprintf fmt "\tReadPort<%s> & port_%s = mk_readPort<%s>(\"%s\", " v_type |
|
| 82 |
v_name v_type v_name; |
|
| 82 | 83 |
print_mauve_default fmt mauve_machine v; |
| 83 |
fprintf fmt ");@.";
|
|
| 84 |
) mauve_machine.mstep.step_inputs;
|
|
| 84 |
fprintf fmt ");@.")
|
|
| 85 |
mauve_machine.mstep.step_inputs; |
|
| 85 | 86 |
(* out ports *) |
| 86 | 87 |
fprintf fmt "\t// OutputPorts@."; |
| 87 | 88 |
List.iter |
| 88 | 89 |
(fun v -> |
| 89 | 90 |
let v_name = v.var_id in |
| 90 | 91 |
let v_type = pp_c_basic_type_desc v.var_type in |
| 91 |
fprintf fmt "\tWritePort<%s> & port_%s = mk_writePort<%s>(\"%s\");@." v_type v_name v_type v_name; |
|
| 92 |
) mauve_machine.mstep.step_outputs; |
|
| 92 |
fprintf fmt "\tWritePort<%s> & port_%s = mk_writePort<%s>(\"%s\");@." |
|
| 93 |
v_type v_name v_type v_name) |
|
| 94 |
mauve_machine.mstep.step_outputs; |
|
| 93 | 95 |
|
| 94 | 96 |
fprintf fmt "};@."; |
| 95 | 97 |
|
| ... | ... | |
| 100 | 102 |
List.iter |
| 101 | 103 |
(fun v -> |
| 102 | 104 |
let v_name = v.var_id in |
| 103 |
fprintf fmt "%s, " v_name;
|
|
| 104 |
) mauve_machine.mstep.step_inputs;
|
|
| 105 |
fprintf fmt "%s, " v_name)
|
|
| 106 |
mauve_machine.mstep.step_inputs; |
|
| 105 | 107 |
List.iter |
| 106 | 108 |
(fun v -> |
| 107 | 109 |
let v_name = v.var_id in |
| 108 |
fprintf fmt "&%s, " v_name;
|
|
| 109 |
) mauve_machine.mstep.step_outputs;
|
|
| 110 |
fprintf fmt "&%s, " v_name)
|
|
| 111 |
mauve_machine.mstep.step_outputs; |
|
| 110 | 112 |
fprintf fmt "node"; |
| 111 | 113 |
fprintf fmt ");@." |
| 112 | 114 |
|
| ... | ... | |
| 121 | 123 |
fprintf fmt " * CORE@."; |
| 122 | 124 |
fprintf fmt " */@."; |
| 123 | 125 |
|
| 124 |
fprintf fmt "struct %s: public Core<%s> {@." (core_name node_name) (shell_name node_name);
|
|
| 126 |
fprintf fmt "struct %s: public Core<%s> {@." (core_name node_name)
|
|
| 127 |
(shell_name node_name); |
|
| 125 | 128 |
|
| 126 | 129 |
(* Attribute *) |
| 127 | 130 |
fprintf fmt "\tstruct %s_mem * node;@." node_name; |
| ... | ... | |
| 132 | 135 |
(fun v -> |
| 133 | 136 |
let v_name = v.var_id in |
| 134 | 137 |
let v_type = pp_c_basic_type_desc v.var_type in |
| 135 |
fprintf fmt "\t\t%s %s = port_%s.read();@." v_type v_name v_name;
|
|
| 136 |
) mauve_machine.mstep.step_inputs;
|
|
| 138 |
fprintf fmt "\t\t%s %s = port_%s.read();@." v_type v_name v_name)
|
|
| 139 |
mauve_machine.mstep.step_inputs; |
|
| 137 | 140 |
List.iter |
| 138 | 141 |
(fun v -> |
| 139 | 142 |
let v_name = v.var_id in |
| 140 | 143 |
let v_type = pp_c_basic_type_desc v.var_type in |
| 141 |
fprintf fmt "\t\t%s %s;@." v_type v_name;
|
|
| 142 |
) mauve_machine.mstep.step_outputs;
|
|
| 144 |
fprintf fmt "\t\t%s %s;@." v_type v_name)
|
|
| 145 |
mauve_machine.mstep.step_outputs; |
|
| 143 | 146 |
print_mauve_step fmt node_name mauve_machine; |
| 144 | 147 |
List.iter |
| 145 | 148 |
(fun v -> |
| 146 | 149 |
let v_name = v.var_id in |
| 147 |
fprintf fmt "\t\tport_%s.write(%s);@." v_name v_name;
|
|
| 148 |
) mauve_machine.mstep.step_outputs;
|
|
| 150 |
fprintf fmt "\t\tport_%s.write(%s);@." v_name v_name)
|
|
| 151 |
mauve_machine.mstep.step_outputs; |
|
| 149 | 152 |
fprintf fmt "\t}@."; |
| 150 | 153 |
pp_print_newline fmt (); |
| 151 | 154 |
(* Configure *) |
| ... | ... | |
| 167 | 170 |
(* FSM *) |
| 168 | 171 |
(* -------------------------------------------------- *) |
| 169 | 172 |
|
| 170 |
let print_period_conversion fmt expr = (
|
|
| 173 |
let print_period_conversion fmt expr = |
|
| 171 | 174 |
match expr.expr_desc with |
| 172 |
| Expr_tuple [p; u] -> ( |
|
| 173 |
match u.expr_desc with |
|
| 174 |
| Expr_ident "s" -> fprintf fmt "sec_to_ns("; (pp_expr fmt p); fprintf fmt ")"
|
|
| 175 |
| Expr_ident "ssec"-> fprintf fmt "sec_to_ns("; (pp_expr fmt p); fprintf fmt ")"
|
|
| 176 |
| Expr_ident "ms" -> fprintf fmt "ms_to_ns(" ; (pp_expr fmt p); fprintf fmt ")"
|
|
| 177 |
| Expr_ident "ns" -> pp_expr fmt p |
|
| 178 |
| _ -> assert false |
|
| 179 |
) |
|
| 180 |
| _ -> assert false |
|
| 181 |
) |
|
| 182 |
|
|
| 183 |
let print_mauve_period fmt mauve_machine = |
|
| 175 |
| Expr_tuple [ p; u ] -> ( |
|
| 176 |
match u.expr_desc with |
|
| 177 |
| Expr_ident "s" -> |
|
| 178 |
fprintf fmt "sec_to_ns(";
|
|
| 179 |
pp_expr fmt p; |
|
| 180 |
fprintf fmt ")" |
|
| 181 |
| Expr_ident "ssec" -> |
|
| 182 |
fprintf fmt "sec_to_ns(";
|
|
| 183 |
pp_expr fmt p; |
|
| 184 |
fprintf fmt ")" |
|
| 185 |
| Expr_ident "ms" -> |
|
| 186 |
fprintf fmt "ms_to_ns(";
|
|
| 187 |
pp_expr fmt p; |
|
| 188 |
fprintf fmt ")" |
|
| 189 |
| Expr_ident "ns" -> |
|
| 190 |
pp_expr fmt p |
|
| 191 |
| _ -> |
|
| 192 |
assert false) |
|
| 193 |
| _ -> |
|
| 194 |
assert false |
|
| 195 |
|
|
| 196 |
let print_mauve_period fmt mauve_machine = |
|
| 184 | 197 |
let found = ref false in |
| 185 |
let annotations: expr_annot list = mauve_machine.mname.node_annot in |
|
| 198 |
let annotations : expr_annot list = mauve_machine.mname.node_annot in
|
|
| 186 | 199 |
List.iter |
| 187 |
(fun (al: expr_annot) -> |
|
| 188 |
List.iter |
|
| 189 |
(fun ((sl, e): string list * eexpr) -> if not !found then match sl with |
|
| 190 |
| ["mauve"; "period" ] -> (print_period_conversion fmt e.eexpr_qfexpr); found := true; |
|
| 191 |
| _ -> (); |
|
| 192 |
) al.annots; |
|
| 193 |
) annotations; |
|
| 200 |
(fun (al : expr_annot) -> |
|
| 201 |
List.iter |
|
| 202 |
(fun ((sl, e) : string list * eexpr) -> |
|
| 203 |
if not !found then |
|
| 204 |
match sl with |
|
| 205 |
| [ "mauve"; "period" ] -> |
|
| 206 |
print_period_conversion fmt e.eexpr_qfexpr; |
|
| 207 |
found := true |
|
| 208 |
| _ -> |
|
| 209 |
()) |
|
| 210 |
al.annots) |
|
| 211 |
annotations; |
|
| 194 | 212 |
if not !found then fprintf fmt "0" |
| 195 | 213 |
|
| 196 |
|
|
| 197 | 214 |
let print_mauve_fsm fmt mauve_machine = |
| 198 | 215 |
let node_name = mauve_machine.mname.node_id in |
| 199 | 216 |
|
| ... | ... | |
| 201 | 218 |
fprintf fmt " * FSM@."; |
| 202 | 219 |
fprintf fmt " */@."; |
| 203 | 220 |
|
| 204 |
fprintf fmt "struct %s: public FiniteStateMachine<%s, %s> {@." (fsm_name node_name) (shell_name node_name) (core_name node_name);
|
|
| 221 |
fprintf fmt "struct %s: public FiniteStateMachine<%s, %s> {@."
|
|
| 222 |
(fsm_name node_name) (shell_name node_name) (core_name node_name); |
|
| 205 | 223 |
|
| 206 | 224 |
(* Attribute *) |
| 207 |
fprintf fmt "\tExecState<%s> & update = mk_execution (\"Update\" , &%s::update);@." (core_name node_name) (core_name node_name); |
|
| 208 |
fprintf fmt "\tSynchroState<%s> & synchro = mk_synchronization(\"Synchro\", " (core_name node_name); |
|
| 225 |
fprintf fmt |
|
| 226 |
"\tExecState<%s> & update = mk_execution (\"Update\" , \ |
|
| 227 |
&%s::update);@." |
|
| 228 |
(core_name node_name) (core_name node_name); |
|
| 229 |
fprintf fmt "\tSynchroState<%s> & synchro = mk_synchronization(\"Synchro\", " |
|
| 230 |
(core_name node_name); |
|
| 209 | 231 |
print_mauve_period fmt mauve_machine; |
| 210 | 232 |
fprintf fmt ");@."; |
| 211 | 233 |
pp_print_newline fmt (); |
Also available in: Unified diff
reformatting