Project

General

Profile

Download (7.35 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 =
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: *)
(7-7/9)