Project

General

Profile

Download (7.5 KB) Statistics
| Branch: | Tag: | Revision:
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: *)
(8-8/10)