Project

General

Profile

Download (7.46 KB) Statistics
| Branch: | Tag: | Revision:
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 = sig end
9

    
10
   module EmptyMod = struct end
11

    
12
   module Mauve = functor (Mod: MODIFIERS_MAINSRC) -> struct end *)
13
(********************************************************************************************)
14
(* Main related functions *)
15
(********************************************************************************************)
16

    
17
let shell_name node = node ^ "Shell"
18

    
19
let core_name node = node ^ "Core"
20

    
21
let fsm_name node = node ^ "FSM"
22

    
23
(* -------------------------------------------------- *)
24
(*                       Hearder                      *)
25
(* -------------------------------------------------- *)
26

    
27
let print_mauve_header fmt basename =
28
  fprintf fmt "#include \"mauve/runtime.hpp\"@.";
29
  print_import_alloc_prototype fmt
30
    { local = true; name = basename; content = []; is_stateful = true }
31
  (* assuming it is stateful*);
32
  pp_print_newline fmt ();
33
  pp_print_newline fmt ()
34

    
35
(* -------------------------------------------------- *)
36
(*                       Shell                        *)
37
(* -------------------------------------------------- *)
38

    
39
let mauve_default_value v =
40
  (* let v_name = v.var_id in *)
41
  if Types.is_bool_type v.var_type then "false"
42
  else if Types.is_int_type v.var_type then "0"
43
  else if Types.is_real_type v.var_type then "0.0"
44
  else assert false
45

    
46
let print_mauve_default fmt mauve_machine v =
47
  let v_name : string = v.var_id in
48
  let found = ref false in
49
  let annotations : expr_annot list = mauve_machine.mname.node_annot in
50
  List.iter
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;
64
  if not !found then fprintf fmt "%s" (mauve_default_value v)
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
82
        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\");@."
93
        v_type v_name v_type v_name)
94
    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
(* -------------------------------------------------- *)
116
(*                       Core                      *)
117
(* -------------------------------------------------- *)
118

    
119
let print_mauve_core fmt mauve_machine =
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)
127
    (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" ->
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 =
197
  let found = ref false in
198
  let annotations : expr_annot list = mauve_machine.mname.node_annot in
199
  List.iter
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;
212
  if not !found then fprintf fmt "0"
213

    
214
let print_mauve_fsm fmt mauve_machine =
215
  let node_name = mauve_machine.mname.node_id in
216

    
217
  fprintf fmt "/*@.";
218
  fprintf fmt " *          FSM@.";
219
  fprintf fmt " */@.";
220

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

    
224
  (* Attribute *)
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);
231
  print_mauve_period fmt mauve_machine;
232
  fprintf fmt ");@.";
233
  pp_print_newline fmt ();
234
  (* Configure *)
235
  fprintf fmt "\tbool configure_hook() override {@.";
236
  fprintf fmt "\t\tset_initial(update);@.";
237
  fprintf fmt "\t\tset_next(update, synchro);@.";
238
  fprintf fmt "\t\tset_next(synchro, update);@.";
239
  fprintf fmt "\t\treturn true;@.";
240
  fprintf fmt "\t}@.";
241
  pp_print_newline fmt ();
242
  (* Cleanup *)
243
  fprintf fmt "\tvoid cleanup_hook() override {@.";
244
  fprintf fmt "\t}@.";
245
  fprintf fmt "};@.";
246
  pp_print_newline fmt ()
247

    
248
(* Local Variables: *)
249
(* compile-command:"make -C ../../.." *)
250
(* End: *)
(7-7/9)