Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / C / c_backend_mauve.ml @ be206ad8

History | View | Annotate | Download (7.58 KB)

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
  let v_type = (Types.repr v.var_type).Types.tdesc in
46
  match v_type with
47
  | Types.Tbool -> "false"
48
  | Types.Tint  -> "0"
49
  | Types.Treal -> "0.0"
50
  | _ -> assert false
51

    
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

    
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
      let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
83
      fprintf fmt "\tReadPort<%s> & port_%s = mk_readPort<%s>(\"%s\", " v_type v_name v_type v_name;
84
      print_mauve_default fmt mauve_machine v;
85
      fprintf fmt ");@.";
86
    ) 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
      let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
93
      fprintf fmt "\tWritePort<%s> & port_%s = mk_writePort<%s>(\"%s\");@." 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 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
      let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
137
      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
      let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
143
      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
  fprintf fmt "\t\tfree(node);@.";
164
  fprintf fmt "\t}@.";
165
  fprintf fmt "};@.";
166
  pp_print_newline fmt ()
167

    
168
(* -------------------------------------------------- *)
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

    
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
  fprintf fmt "\tSynchroState<%s> & synchro = mk_synchronization(\"Synchro\", " (core_name node_name);
211
  print_mauve_period fmt mauve_machine;
212
  fprintf fmt ");@.";
213
  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: *)