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