Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / C / c_backend_mauve.ml @ 5fccce23

History | View | Annotate | Download (7.55 KB)

1 8446bf03 ploc
open Lustre_types
2 089f94be ploc
open Machine_code_types
3 d1b9423d David Doose
open Corelang
4
open Machine_code
5
open Format
6
open C_backend_common
7
open Utils
8 08fd9ec8 David Doose
open Printers
9 d1b9423d David Doose
10
(* module type MODIFIERS_MAINSRC =
11
sig
12
end
13
14
module EmptyMod =
15
struct
16
end
17
18
module Mauve = functor (Mod: MODIFIERS_MAINSRC) -> 
19
struct
20
end
21
 *)
22
(********************************************************************************************)
23
(*                         Main related functions                                           *)
24
(********************************************************************************************)
25
26
let shell_name node = node ^ "Shell"
27
let core_name  node = node ^ "Core"
28
let fsm_name   node = node ^ "FSM"
29
30 08fd9ec8 David Doose
(* -------------------------------------------------- *)
31
(*                       Hearder                      *)
32
(* -------------------------------------------------- *)
33
34 d1b9423d David Doose
let print_mauve_header fmt mauve_machine basename prog machines _ (*dependencies*) =
35
  fprintf fmt "#include \"mauve/runtime.hpp\"@.";
36 5fccce23 ploc
  print_import_alloc_prototype fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful*) ;
37 d1b9423d David Doose
  pp_print_newline fmt ();
38
  pp_print_newline fmt ()
39
40 08fd9ec8 David Doose
(* -------------------------------------------------- *)
41
(*                       Shell                        *)
42
(* -------------------------------------------------- *)
43
44
let mauve_default_value v =
45 2fdbc781 ploc
  (* let v_name = v.var_id in *)
46
47 66359a5e ploc
  if Types.is_bool_type v.var_type then "false"
48
  else if Types.is_int_type v.var_type then "0"
49
  else if Types.is_real_type v.var_type then "0.0"
50
  else assert false
51 08fd9ec8 David Doose
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
67 d1b9423d David Doose
68
let print_mauve_shell fmt mauve_machine basename prog machines _ (*dependencies*) =
69
  let node_name = mauve_machine.mname.node_id in
70
  
71
  fprintf fmt "/*@.";
72
  fprintf fmt " *          SHELL@.";
73
  fprintf fmt " */@.";
74
75
  fprintf fmt "struct %s: public Shell {@." (shell_name node_name);
76
77
  (* in ports *)
78
  fprintf fmt "\t// InputPorts@.";
79
  List.iter
80
    (fun v ->
81
      let v_name = v.var_id in
82 66359a5e ploc
      let v_type = pp_c_basic_type_desc v.var_type in
83 be206ad8 David Doose
      fprintf fmt "\tReadPort<%s> & port_%s = mk_readPort<%s>(\"%s\", " v_type v_name v_type v_name;
84 08fd9ec8 David Doose
      print_mauve_default fmt mauve_machine v;
85
      fprintf fmt ");@.";
86 d1b9423d David Doose
    ) mauve_machine.mstep.step_inputs;
87
  (* out ports *)
88
  fprintf fmt "\t// OutputPorts@.";
89
  List.iter
90
    (fun v ->
91
      let v_name = v.var_id in
92 66359a5e ploc
      let v_type = pp_c_basic_type_desc v.var_type in
93 be206ad8 David Doose
      fprintf fmt "\tWritePort<%s> & port_%s = mk_writePort<%s>(\"%s\");@." v_type v_name v_type v_name;
94 d1b9423d David Doose
    ) mauve_machine.mstep.step_outputs;
95
96
  fprintf fmt "};@.";
97
98
  pp_print_newline fmt ()
99
100
let print_mauve_step fmt node_name mauve_machine =
101
  fprintf fmt "\t\t%s_step(" node_name;
102
  List.iter
103
    (fun v ->
104
      let v_name = v.var_id in
105
      fprintf fmt "%s, " v_name;
106
    ) mauve_machine.mstep.step_inputs;
107
  List.iter
108
    (fun v ->
109
      let v_name = v.var_id in
110
      fprintf fmt "&%s, " v_name;
111
    ) mauve_machine.mstep.step_outputs;
112
  fprintf fmt "node";
113
  fprintf fmt ");@."
114
115 08fd9ec8 David Doose
(* -------------------------------------------------- *)
116
(*                       Core                      *)
117
(* -------------------------------------------------- *)
118
119 d1b9423d David Doose
let print_mauve_core fmt mauve_machine basename prog machines _ (*dependencies*) =
120
  let node_name = mauve_machine.mname.node_id in
121
122
  fprintf fmt "/*@.";
123
  fprintf fmt " *          CORE@.";
124
  fprintf fmt " */@.";
125
126
  fprintf fmt "struct %s: public Core<%s> {@." (core_name node_name) (shell_name node_name);
127
128
  (* Attribute *)
129
  fprintf fmt "\tstruct %s_mem * node;@." node_name;
130
  pp_print_newline fmt ();
131
  (* Update *)
132
  fprintf fmt "\tvoid update() {@.";
133
  List.iter
134
    (fun v ->
135
      let v_name = v.var_id in
136 66359a5e ploc
      let v_type = pp_c_basic_type_desc v.var_type in
137 d1b9423d David Doose
      fprintf fmt "\t\t%s %s = port_%s.read();@." v_type v_name v_name;
138
    ) mauve_machine.mstep.step_inputs;
139
  List.iter
140
    (fun v ->
141
      let v_name = v.var_id in
142 66359a5e ploc
      let v_type = pp_c_basic_type_desc v.var_type in
143 d1b9423d David Doose
      fprintf fmt "\t\t%s %s;@." v_type v_name;
144
    ) mauve_machine.mstep.step_outputs;
145
  print_mauve_step fmt node_name mauve_machine;
146
  List.iter
147
    (fun v ->
148
      let v_name = v.var_id in
149
      fprintf fmt "\t\tport_%s.write(%s);@." v_name v_name;
150
    ) mauve_machine.mstep.step_outputs;
151
  fprintf fmt "\t}@.";
152
  pp_print_newline fmt ();
153
  (* Configure *)
154
  fprintf fmt "\tbool configure_hook() override {@.";
155
  fprintf fmt "\t\tnode = %s_alloc();@." node_name;
156
  fprintf fmt "\t\t%s_reset(node);@." node_name;
157
  fprintf fmt "\t\treturn true;@.";
158
  fprintf fmt "\t}@.";
159
  pp_print_newline fmt ();
160
  (* Cleanup *)
161
  fprintf fmt "\tvoid cleanup_hook() override {@.";
162
  fprintf fmt "\t\t%s_reset(node);@." node_name;
163 86854b27 David Doose
  fprintf fmt "\t\t%s_dealloc(node);@." node_name;
164 d1b9423d David Doose
  fprintf fmt "\t}@.";
165
  fprintf fmt "};@.";
166
  pp_print_newline fmt ()
167
168 08fd9ec8 David Doose
(* -------------------------------------------------- *)
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
198 d1b9423d David Doose
199
let print_mauve_fsm fmt mauve_machine basename prog machines _ (*dependencies*) =
200
  let node_name = mauve_machine.mname.node_id in
201
202
  fprintf fmt "/*@.";
203
  fprintf fmt " *          FSM@.";
204
  fprintf fmt " */@.";
205
206
  fprintf fmt "struct %s: public FiniteStateMachine<%s, %s> {@." (fsm_name node_name) (shell_name node_name) (core_name node_name);
207
208
  (* Attribute *)
209
  fprintf fmt "\tExecState<%s>    & update  = mk_execution      (\"Update\" , &%s::update);@." (core_name node_name) (core_name node_name);
210 08fd9ec8 David Doose
  fprintf fmt "\tSynchroState<%s> & synchro = mk_synchronization(\"Synchro\", " (core_name node_name);
211
  print_mauve_period fmt mauve_machine;
212
  fprintf fmt ");@.";
213 d1b9423d David Doose
  pp_print_newline fmt ();
214
  (* Configure *)
215
  fprintf fmt "\tbool configure_hook() override {@.";
216
  fprintf fmt "\t\tset_initial(update);@.";
217
  fprintf fmt "\t\tset_next(update, synchro);@.";
218
  fprintf fmt "\t\tset_next(synchro, update);@.";
219
  fprintf fmt "\t\treturn true;@.";
220
  fprintf fmt "\t}@.";
221
  pp_print_newline fmt ();
222
  (* Cleanup *)
223
  fprintf fmt "\tvoid cleanup_hook() override {@.";
224
  fprintf fmt "\t}@.";
225
  fprintf fmt "};@.";
226
  pp_print_newline fmt ()
227
228
(* Local Variables: *)
229
(* compile-command:"make -C ../../.." *)
230
(* End: *)