Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / C / c_backend_mauve.ml @ 3769b712

History | View | Annotate | Download (7.63 KB)

1
open Lustrec
2
open Lustrec.Lustre_types
3
open Lustrec.Machine_code_types
4
open Lustrec.Corelang
5
open Machine_code
6
open Format
7
open C_backend_common
8
open Lustrec.Utils
9
open Lustrec.Printers
10

    
11
(* module type MODIFIERS_MAINSRC =
12
sig
13
end
14

    
15
module EmptyMod =
16
struct
17
end
18

    
19
module Mauve = functor (Mod: MODIFIERS_MAINSRC) -> 
20
struct
21
end
22
 *)
23
(********************************************************************************************)
24
(*                         Main related functions                                           *)
25
(********************************************************************************************)
26

    
27
let shell_name node = node ^ "Shell"
28
let core_name  node = node ^ "Core"
29
let fsm_name   node = node ^ "FSM"
30

    
31
(* -------------------------------------------------- *)
32
(*                       Hearder                      *)
33
(* -------------------------------------------------- *)
34

    
35
let print_mauve_header fmt mauve_machine basename prog machines _ (*dependencies*) =
36
  fprintf fmt "#include \"mauve/runtime.hpp\"@.";
37
  print_import_alloc_prototype fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful*) ;
38
  pp_print_newline fmt ();
39
  pp_print_newline fmt ()
40

    
41
(* -------------------------------------------------- *)
42
(*                       Shell                        *)
43
(* -------------------------------------------------- *)
44

    
45
let mauve_default_value v =
46
  (* let v_name = v.var_id in *)
47

    
48
  if Lustrec.Types.is_bool_type v.var_type then "false"
49
  else if Lustrec.Types.is_int_type v.var_type then "0"
50
  else if Lustrec.Types.is_real_type v.var_type then "0.0"
51
  else assert false
52

    
53
let print_mauve_default fmt mauve_machine v = 
54
  let v_name: string = v.var_id in
55
  let found = ref false in
56
  let annotations: expr_annot list = mauve_machine.mname.node_annot in
57
  List.iter
58
    (fun (al: expr_annot) ->
59
        List.iter
60
          (fun ((sl, e): string list * eexpr) -> if not !found then match sl with 
61
          | ["mauve"; "default"; name] ->
62
            if v_name = name then begin (pp_expr fmt e.eexpr_qfexpr); found := true; end
63
          | _ -> ();
64
          ) al.annots;
65
    ) annotations;
66
  if not !found then fprintf fmt "%s" (mauve_default_value v)
67

    
68

    
69
let print_mauve_shell fmt mauve_machine basename prog machines _ (*dependencies*) =
70
  let node_name = mauve_machine.mname.node_id in
71
  
72
  fprintf fmt "/*@.";
73
  fprintf fmt " *          SHELL@.";
74
  fprintf fmt " */@.";
75

    
76
  fprintf fmt "struct %s: public Shell {@." (shell_name node_name);
77

    
78
  (* in ports *)
79
  fprintf fmt "\t// InputPorts@.";
80
  List.iter
81
    (fun v ->
82
      let v_name = v.var_id in
83
      let v_type = pp_c_basic_type_desc v.var_type in
84
      fprintf fmt "\tReadPort<%s> & port_%s = mk_readPort<%s>(\"%s\", " v_type v_name v_type v_name;
85
      print_mauve_default fmt mauve_machine v;
86
      fprintf fmt ");@.";
87
    ) mauve_machine.mstep.step_inputs;
88
  (* out ports *)
89
  fprintf fmt "\t// OutputPorts@.";
90
  List.iter
91
    (fun v ->
92
      let v_name = v.var_id in
93
      let v_type = pp_c_basic_type_desc v.var_type in
94
      fprintf fmt "\tWritePort<%s> & port_%s = mk_writePort<%s>(\"%s\");@." v_type v_name v_type v_name;
95
    ) mauve_machine.mstep.step_outputs;
96

    
97
  fprintf fmt "};@.";
98

    
99
  pp_print_newline fmt ()
100

    
101
let print_mauve_step fmt node_name mauve_machine =
102
  fprintf fmt "\t\t%s_step(" node_name;
103
  List.iter
104
    (fun v ->
105
      let v_name = v.var_id in
106
      fprintf fmt "%s, " v_name;
107
    ) mauve_machine.mstep.step_inputs;
108
  List.iter
109
    (fun v ->
110
      let v_name = v.var_id in
111
      fprintf fmt "&%s, " v_name;
112
    ) mauve_machine.mstep.step_outputs;
113
  fprintf fmt "node";
114
  fprintf fmt ");@."
115

    
116
(* -------------------------------------------------- *)
117
(*                       Core                      *)
118
(* -------------------------------------------------- *)
119

    
120
let print_mauve_core fmt mauve_machine basename prog machines _ (*dependencies*) =
121
  let node_name = mauve_machine.mname.node_id in
122

    
123
  fprintf fmt "/*@.";
124
  fprintf fmt " *          CORE@.";
125
  fprintf fmt " */@.";
126

    
127
  fprintf fmt "struct %s: public Core<%s> {@." (core_name node_name) (shell_name node_name);
128

    
129
  (* Attribute *)
130
  fprintf fmt "\tstruct %s_mem * node;@." node_name;
131
  pp_print_newline fmt ();
132
  (* Update *)
133
  fprintf fmt "\tvoid update() {@.";
134
  List.iter
135
    (fun v ->
136
      let v_name = v.var_id in
137
      let v_type = pp_c_basic_type_desc v.var_type in
138
      fprintf fmt "\t\t%s %s = port_%s.read();@." v_type v_name v_name;
139
    ) mauve_machine.mstep.step_inputs;
140
  List.iter
141
    (fun v ->
142
      let v_name = v.var_id in
143
      let v_type = pp_c_basic_type_desc v.var_type in
144
      fprintf fmt "\t\t%s %s;@." v_type v_name;
145
    ) mauve_machine.mstep.step_outputs;
146
  print_mauve_step fmt node_name mauve_machine;
147
  List.iter
148
    (fun v ->
149
      let v_name = v.var_id in
150
      fprintf fmt "\t\tport_%s.write(%s);@." v_name v_name;
151
    ) mauve_machine.mstep.step_outputs;
152
  fprintf fmt "\t}@.";
153
  pp_print_newline fmt ();
154
  (* Configure *)
155
  fprintf fmt "\tbool configure_hook() override {@.";
156
  fprintf fmt "\t\tnode = %s_alloc();@." node_name;
157
  fprintf fmt "\t\t%s_reset(node);@." node_name;
158
  fprintf fmt "\t\treturn true;@.";
159
  fprintf fmt "\t}@.";
160
  pp_print_newline fmt ();
161
  (* Cleanup *)
162
  fprintf fmt "\tvoid cleanup_hook() override {@.";
163
  fprintf fmt "\t\t%s_reset(node);@." node_name;
164
  fprintf fmt "\t\t%s_dealloc(node);@." node_name;
165
  fprintf fmt "\t}@.";
166
  fprintf fmt "};@.";
167
  pp_print_newline fmt ()
168

    
169
(* -------------------------------------------------- *)
170
(*                       FSM                          *)
171
(* -------------------------------------------------- *)
172

    
173
let print_period_conversion fmt expr = (
174
  match expr.expr_desc with
175
    | Expr_tuple [p; u] -> (
176
       match u.expr_desc with 
177
       | Expr_ident "s"   -> fprintf fmt "sec_to_ns("; (pp_expr fmt p); fprintf fmt ")"
178
       | Expr_ident "ssec"-> fprintf fmt "sec_to_ns("; (pp_expr fmt p); fprintf fmt ")"
179
       | Expr_ident "ms"  -> fprintf fmt "ms_to_ns(" ; (pp_expr fmt p); fprintf fmt ")"
180
       | Expr_ident "ns"  -> pp_expr fmt p
181
       | _    -> assert false
182
      )
183
    | _ -> assert false
184
  )
185

    
186
let print_mauve_period fmt mauve_machine = 
187
  let found = ref false in
188
  let annotations: expr_annot list = mauve_machine.mname.node_annot in
189
  List.iter
190
    (fun (al: expr_annot) ->
191
        List.iter
192
          (fun ((sl, e): string list * eexpr) -> if not !found then match sl with 
193
           | ["mauve"; "period" ] -> (print_period_conversion fmt e.eexpr_qfexpr); found := true;
194
           | _ -> ();
195
          ) al.annots;
196
    ) annotations;
197
  if not !found then fprintf fmt "0"
198

    
199

    
200
let print_mauve_fsm fmt mauve_machine basename prog machines _ (*dependencies*) =
201
  let node_name = mauve_machine.mname.node_id in
202

    
203
  fprintf fmt "/*@.";
204
  fprintf fmt " *          FSM@.";
205
  fprintf fmt " */@.";
206

    
207
  fprintf fmt "struct %s: public FiniteStateMachine<%s, %s> {@." (fsm_name node_name) (shell_name node_name) (core_name node_name);
208

    
209
  (* Attribute *)
210
  fprintf fmt "\tExecState<%s>    & update  = mk_execution      (\"Update\" , &%s::update);@." (core_name node_name) (core_name node_name);
211
  fprintf fmt "\tSynchroState<%s> & synchro = mk_synchronization(\"Synchro\", " (core_name node_name);
212
  print_mauve_period fmt mauve_machine;
213
  fprintf fmt ");@.";
214
  pp_print_newline fmt ();
215
  (* Configure *)
216
  fprintf fmt "\tbool configure_hook() override {@.";
217
  fprintf fmt "\t\tset_initial(update);@.";
218
  fprintf fmt "\t\tset_next(update, synchro);@.";
219
  fprintf fmt "\t\tset_next(synchro, update);@.";
220
  fprintf fmt "\t\treturn true;@.";
221
  fprintf fmt "\t}@.";
222
  pp_print_newline fmt ();
223
  (* Cleanup *)
224
  fprintf fmt "\tvoid cleanup_hook() override {@.";
225
  fprintf fmt "\t}@.";
226
  fprintf fmt "};@.";
227
  pp_print_newline fmt ()
228

    
229
(* Local Variables: *)
230
(* compile-command:"make -C ../../.." *)
231
(* End: *)