1
|
open Lustre_types
|
2
|
open Machine_code_types
|
3
|
open Format
|
4
|
open C_backend_common
|
5
|
open Utils
|
6
|
open Printers
|
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
|
*)
|
20
|
(********************************************************************************************)
|
21
|
(* Main related functions *)
|
22
|
(********************************************************************************************)
|
23
|
|
24
|
let shell_name node = node ^ "Shell"
|
25
|
let core_name node = node ^ "Core"
|
26
|
let fsm_name node = node ^ "FSM"
|
27
|
|
28
|
(* -------------------------------------------------- *)
|
29
|
(* Hearder *)
|
30
|
(* -------------------------------------------------- *)
|
31
|
|
32
|
let print_mauve_header fmt basename =
|
33
|
fprintf fmt "#include \"mauve/runtime.hpp\"@.";
|
34
|
print_import_alloc_prototype fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful*) ;
|
35
|
pp_print_newline fmt ();
|
36
|
pp_print_newline fmt ()
|
37
|
|
38
|
(* -------------------------------------------------- *)
|
39
|
(* Shell *)
|
40
|
(* -------------------------------------------------- *)
|
41
|
|
42
|
let mauve_default_value v =
|
43
|
(* let v_name = v.var_id in *)
|
44
|
|
45
|
if Types.is_bool_type v.var_type then "false"
|
46
|
else if Types.is_int_type v.var_type then "0"
|
47
|
else if Types.is_real_type v.var_type then "0.0"
|
48
|
else assert false
|
49
|
|
50
|
let print_mauve_default fmt mauve_machine v =
|
51
|
let v_name: string = v.var_id in
|
52
|
let found = ref false in
|
53
|
let annotations: expr_annot list = mauve_machine.mname.node_annot in
|
54
|
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;
|
63
|
if not !found then fprintf fmt "%s" (mauve_default_value v)
|
64
|
|
65
|
|
66
|
let print_mauve_shell fmt mauve_machine =
|
67
|
let node_name = mauve_machine.mname.node_id in
|
68
|
|
69
|
fprintf fmt "/*@.";
|
70
|
fprintf fmt " * SHELL@.";
|
71
|
fprintf fmt " */@.";
|
72
|
|
73
|
fprintf fmt "struct %s: public Shell {@." (shell_name node_name);
|
74
|
|
75
|
(* in ports *)
|
76
|
fprintf fmt "\t// InputPorts@.";
|
77
|
List.iter
|
78
|
(fun v ->
|
79
|
let v_name = v.var_id in
|
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;
|
82
|
print_mauve_default fmt mauve_machine v;
|
83
|
fprintf fmt ");@.";
|
84
|
) mauve_machine.mstep.step_inputs;
|
85
|
(* out ports *)
|
86
|
fprintf fmt "\t// OutputPorts@.";
|
87
|
List.iter
|
88
|
(fun v ->
|
89
|
let v_name = v.var_id in
|
90
|
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;
|
93
|
|
94
|
fprintf fmt "};@.";
|
95
|
|
96
|
pp_print_newline fmt ()
|
97
|
|
98
|
let print_mauve_step fmt node_name mauve_machine =
|
99
|
fprintf fmt "\t\t%s_step(" node_name;
|
100
|
List.iter
|
101
|
(fun v ->
|
102
|
let v_name = v.var_id in
|
103
|
fprintf fmt "%s, " v_name;
|
104
|
) mauve_machine.mstep.step_inputs;
|
105
|
List.iter
|
106
|
(fun v ->
|
107
|
let v_name = v.var_id in
|
108
|
fprintf fmt "&%s, " v_name;
|
109
|
) mauve_machine.mstep.step_outputs;
|
110
|
fprintf fmt "node";
|
111
|
fprintf fmt ");@."
|
112
|
|
113
|
(* -------------------------------------------------- *)
|
114
|
(* Core *)
|
115
|
(* -------------------------------------------------- *)
|
116
|
|
117
|
let print_mauve_core fmt mauve_machine =
|
118
|
let node_name = mauve_machine.mname.node_id in
|
119
|
|
120
|
fprintf fmt "/*@.";
|
121
|
fprintf fmt " * CORE@.";
|
122
|
fprintf fmt " */@.";
|
123
|
|
124
|
fprintf fmt "struct %s: public Core<%s> {@." (core_name node_name) (shell_name node_name);
|
125
|
|
126
|
(* Attribute *)
|
127
|
fprintf fmt "\tstruct %s_mem * node;@." node_name;
|
128
|
pp_print_newline fmt ();
|
129
|
(* Update *)
|
130
|
fprintf fmt "\tvoid update() {@.";
|
131
|
List.iter
|
132
|
(fun v ->
|
133
|
let v_name = v.var_id in
|
134
|
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;
|
137
|
List.iter
|
138
|
(fun v ->
|
139
|
let v_name = v.var_id in
|
140
|
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;
|
143
|
print_mauve_step fmt node_name mauve_machine;
|
144
|
List.iter
|
145
|
(fun v ->
|
146
|
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;
|
149
|
fprintf fmt "\t}@.";
|
150
|
pp_print_newline fmt ();
|
151
|
(* Configure *)
|
152
|
fprintf fmt "\tbool configure_hook() override {@.";
|
153
|
fprintf fmt "\t\tnode = %s_alloc();@." node_name;
|
154
|
fprintf fmt "\t\t%s_reset(node);@." node_name;
|
155
|
fprintf fmt "\t\treturn true;@.";
|
156
|
fprintf fmt "\t}@.";
|
157
|
pp_print_newline fmt ();
|
158
|
(* Cleanup *)
|
159
|
fprintf fmt "\tvoid cleanup_hook() override {@.";
|
160
|
fprintf fmt "\t\t%s_reset(node);@." node_name;
|
161
|
fprintf fmt "\t\t%s_dealloc(node);@." node_name;
|
162
|
fprintf fmt "\t}@.";
|
163
|
fprintf fmt "};@.";
|
164
|
pp_print_newline fmt ()
|
165
|
|
166
|
(* -------------------------------------------------- *)
|
167
|
(* FSM *)
|
168
|
(* -------------------------------------------------- *)
|
169
|
|
170
|
let print_period_conversion fmt expr = (
|
171
|
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 =
|
184
|
let found = ref false in
|
185
|
let annotations: expr_annot list = mauve_machine.mname.node_annot in
|
186
|
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;
|
194
|
if not !found then fprintf fmt "0"
|
195
|
|
196
|
|
197
|
let print_mauve_fsm fmt mauve_machine =
|
198
|
let node_name = mauve_machine.mname.node_id in
|
199
|
|
200
|
fprintf fmt "/*@.";
|
201
|
fprintf fmt " * FSM@.";
|
202
|
fprintf fmt " */@.";
|
203
|
|
204
|
fprintf fmt "struct %s: public FiniteStateMachine<%s, %s> {@." (fsm_name node_name) (shell_name node_name) (core_name node_name);
|
205
|
|
206
|
(* 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);
|
209
|
print_mauve_period fmt mauve_machine;
|
210
|
fprintf fmt ");@.";
|
211
|
pp_print_newline fmt ();
|
212
|
(* Configure *)
|
213
|
fprintf fmt "\tbool configure_hook() override {@.";
|
214
|
fprintf fmt "\t\tset_initial(update);@.";
|
215
|
fprintf fmt "\t\tset_next(update, synchro);@.";
|
216
|
fprintf fmt "\t\tset_next(synchro, update);@.";
|
217
|
fprintf fmt "\t\treturn true;@.";
|
218
|
fprintf fmt "\t}@.";
|
219
|
pp_print_newline fmt ();
|
220
|
(* Cleanup *)
|
221
|
fprintf fmt "\tvoid cleanup_hook() override {@.";
|
222
|
fprintf fmt "\t}@.";
|
223
|
fprintf fmt "};@.";
|
224
|
pp_print_newline fmt ()
|
225
|
|
226
|
(* Local Variables: *)
|
227
|
(* compile-command:"make -C ../../.." *)
|
228
|
(* End: *)
|