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