Project

General

Profile

« Previous | Next » 

Revision ca7ff3f7

Added by LĂ©lio Brun 8 months ago

reformatting

View differences:

src/backends/C/c_backend_mauve.ml
5 5
open Utils
6 6
open Printers
7 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
 *)
8
(* module type MODIFIERS_MAINSRC = sig end
9

  
10
   module EmptyMod = struct end
11

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

  
24 17
let shell_name node = node ^ "Shell"
25
let core_name  node = node ^ "Core"
26
let fsm_name   node = node ^ "FSM"
18

  
19
let core_name node = node ^ "Core"
20

  
21
let fsm_name node = node ^ "FSM"
27 22

  
28 23
(* -------------------------------------------------- *)
29 24
(*                       Hearder                      *)
......
31 26

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

  
......
41 38

  
42 39
let mauve_default_value v =
43 40
  (* let v_name = v.var_id in *)
44

  
45 41
  if Types.is_bool_type v.var_type then "false"
46 42
  else if Types.is_int_type v.var_type then "0"
47 43
  else if Types.is_real_type v.var_type then "0.0"
48 44
  else assert false
49 45

  
50
let print_mauve_default fmt mauve_machine v = 
51
  let v_name: string = v.var_id in
46
let print_mauve_default fmt mauve_machine v =
47
  let v_name : string = v.var_id in
52 48
  let found = ref false in
53
  let annotations: expr_annot list = mauve_machine.mname.node_annot in
49
  let annotations : expr_annot list = mauve_machine.mname.node_annot in
54 50
  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;
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;
63 64
  if not !found then fprintf fmt "%s" (mauve_default_value v)
64 65

  
65

  
66 66
let print_mauve_shell fmt mauve_machine =
67 67
  let node_name = mauve_machine.mname.node_id in
68
  
68

  
69 69
  fprintf fmt "/*@.";
70 70
  fprintf fmt " *          SHELL@.";
71 71
  fprintf fmt " */@.";
......
78 78
    (fun v ->
79 79
      let v_name = v.var_id in
80 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;
81
      fprintf fmt "\tReadPort<%s> & port_%s = mk_readPort<%s>(\"%s\", " v_type
82
        v_name v_type v_name;
82 83
      print_mauve_default fmt mauve_machine v;
83
      fprintf fmt ");@.";
84
    ) mauve_machine.mstep.step_inputs;
84
      fprintf fmt ");@.")
85
    mauve_machine.mstep.step_inputs;
85 86
  (* out ports *)
86 87
  fprintf fmt "\t// OutputPorts@.";
87 88
  List.iter
88 89
    (fun v ->
89 90
      let v_name = v.var_id in
90 91
      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;
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;
93 95

  
94 96
  fprintf fmt "};@.";
95 97

  
......
100 102
  List.iter
101 103
    (fun v ->
102 104
      let v_name = v.var_id in
103
      fprintf fmt "%s, " v_name;
104
    ) mauve_machine.mstep.step_inputs;
105
      fprintf fmt "%s, " v_name)
106
    mauve_machine.mstep.step_inputs;
105 107
  List.iter
106 108
    (fun v ->
107 109
      let v_name = v.var_id in
108
      fprintf fmt "&%s, " v_name;
109
    ) mauve_machine.mstep.step_outputs;
110
      fprintf fmt "&%s, " v_name)
111
    mauve_machine.mstep.step_outputs;
110 112
  fprintf fmt "node";
111 113
  fprintf fmt ");@."
112 114

  
......
121 123
  fprintf fmt " *          CORE@.";
122 124
  fprintf fmt " */@.";
123 125

  
124
  fprintf fmt "struct %s: public Core<%s> {@." (core_name node_name) (shell_name node_name);
126
  fprintf fmt "struct %s: public Core<%s> {@." (core_name node_name)
127
    (shell_name node_name);
125 128

  
126 129
  (* Attribute *)
127 130
  fprintf fmt "\tstruct %s_mem * node;@." node_name;
......
132 135
    (fun v ->
133 136
      let v_name = v.var_id in
134 137
      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;
138
      fprintf fmt "\t\t%s %s = port_%s.read();@." v_type v_name v_name)
139
    mauve_machine.mstep.step_inputs;
137 140
  List.iter
138 141
    (fun v ->
139 142
      let v_name = v.var_id in
140 143
      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;
144
      fprintf fmt "\t\t%s %s;@." v_type v_name)
145
    mauve_machine.mstep.step_outputs;
143 146
  print_mauve_step fmt node_name mauve_machine;
144 147
  List.iter
145 148
    (fun v ->
146 149
      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;
150
      fprintf fmt "\t\tport_%s.write(%s);@." v_name v_name)
151
    mauve_machine.mstep.step_outputs;
149 152
  fprintf fmt "\t}@.";
150 153
  pp_print_newline fmt ();
151 154
  (* Configure *)
......
167 170
(*                       FSM                          *)
168 171
(* -------------------------------------------------- *)
169 172

  
170
let print_period_conversion fmt expr = (
173
let print_period_conversion fmt expr =
171 174
  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 = 
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 =
184 197
  let found = ref false in
185
  let annotations: expr_annot list = mauve_machine.mname.node_annot in
198
  let annotations : expr_annot list = mauve_machine.mname.node_annot in
186 199
  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;
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;
194 212
  if not !found then fprintf fmt "0"
195 213

  
196

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

  
......
201 218
  fprintf fmt " *          FSM@.";
202 219
  fprintf fmt " */@.";
203 220

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

  
206 224
  (* 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);
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);
209 231
  print_mauve_period fmt mauve_machine;
210 232
  fprintf fmt ");@.";
211 233
  pp_print_newline fmt ();

Also available in: Unified diff