Project

General

Profile

Revision 08fd9ec8

View differences:

src/backends/C/c_backend_mauve.ml
4 4
open Format
5 5
open C_backend_common
6 6
open Utils
7
open Printers
7 8

  
8 9
(* module type MODIFIERS_MAINSRC =
9 10
sig
......
21 22
(*                         Main related functions                                           *)
22 23
(********************************************************************************************)
23 24

  
24
let mauve_default_value v =
25
  let v_name = v.var_id in
26
  let v_type = (Types.repr v.var_type).Types.tdesc in
27
  match v_type with
28
  | Types.Tbool -> "false"
29
  | Types.Tint  -> "0"
30
  | Types.Treal -> "0.0"
31
  | _ -> assert false
32

  
33 25
let shell_name node = node ^ "Shell"
34 26
let core_name  node = node ^ "Core"
35 27
let fsm_name   node = node ^ "FSM"
36 28

  
29
(* -------------------------------------------------- *)
30
(*                       Hearder                      *)
31
(* -------------------------------------------------- *)
32

  
37 33
let print_mauve_header fmt mauve_machine basename prog machines _ (*dependencies*) =
38 34
  fprintf fmt "#include \"mauve/runtime.hpp\"@.";
39 35
  print_import_alloc_prototype fmt (Dep (true, basename, [], true (* assuming it is stateful*) ));
40 36
  pp_print_newline fmt ();
41 37
  pp_print_newline fmt ()
42 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

  
43 67

  
44 68
let print_mauve_shell fmt mauve_machine basename prog machines _ (*dependencies*) =
45 69
  let node_name = mauve_machine.mname.node_id in
......
56 80
    (fun v ->
57 81
      let v_name = v.var_id in
58 82
      let v_type = pp_c_basic_type_desc (Types.repr v.var_type).Types.tdesc in
59
      let default = mauve_default_value v in
60
      fprintf fmt "\tReadPort<%s> port_%s = mk_readPort<%s>(\"%s\", %s);@." v_type v_name v_type v_name default;
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 ");@.";
61 86
    ) mauve_machine.mstep.step_inputs;
62 87
  (* out ports *)
63 88
  fprintf fmt "\t// OutputPorts@.";
......
87 112
  fprintf fmt "node";
88 113
  fprintf fmt ");@."
89 114

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

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

  
......
136 165
  fprintf fmt "};@.";
137 166
  pp_print_newline fmt ()
138 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

  
139 198

  
140 199
let print_mauve_fsm fmt mauve_machine basename prog machines _ (*dependencies*) =
141 200
  let node_name = mauve_machine.mname.node_id in
......
148 207

  
149 208
  (* Attribute *)
150 209
  fprintf fmt "\tExecState<%s>    & update  = mk_execution      (\"Update\" , &%s::update);@." (core_name node_name) (core_name node_name);
151
  fprintf fmt "\tSynchroState<%s> & synchro = mk_synchronization(\"Synchro\", ms_to_ns(100));@." (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 ");@.";
152 213
  pp_print_newline fmt ();
153 214
  (* Configure *)
154 215
  fprintf fmt "\tbool configure_hook() override {@.";

Also available in: Unified diff