Project

General

Profile

Download (12.3 KB) Statistics
| Branch: | Tag: | Revision:
1
(********************************************************************)
2
(*                                                                  *)
3
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
5
(*                                                                  *)
6
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
7
(*  under the terms of the GNU Lesser General Public License        *)
8
(*  version 2.1.                                                    *)
9
(*                                                                  *)
10
(********************************************************************)
11

    
12
open Lustre_types
13
open Machine_code_types
14
open Machine_code_common
15
open Utils.Format
16
open C_backend_common
17
open Utils
18

    
19
module type MODIFIERS_MAINSRC = sig end
20

    
21
module EmptyMod = struct end
22

    
23
module Main =
24
functor
25
  (Mod : MODIFIERS_MAINSRC)
26
  ->
27
  struct
28
    (********************************************************************************************)
29
    (* Main related functions *)
30
    (********************************************************************************************)
31

    
32
    let pp_c_main_var_input fmt id = fprintf fmt "%s" id.var_id
33

    
34
    let pp_c_main_var_output fmt id =
35
      if Types.is_address_type id.var_type then fprintf fmt "%s" id.var_id
36
      else fprintf fmt "&%s" id.var_id
37

    
38
    let print_put_output fmt id o' o =
39
      let suff = string_of_int (id + 1) in
40
      print_put_var fmt suff o'.var_id o.var_type o.var_id
41

    
42
    let print_main_inout_declaration fmt m =
43
      fprintf fmt
44
        "/* Declaration of inputs/outputs variables */@,\
45
         %a%a@[<v 2>if (traces) {@,\
46
         %a%a@]@,\
47
         }"
48
        (pp_print_list_i ~pp_open_box:pp_open_vbox0 ~pp_epilogue:pp_print_cut
49
           (fun fmt idx v ->
50
             fprintf fmt "%a; %a" (pp_c_type v.var_id) v.var_type
51
               (fun fmt () -> pp_file_decl fmt "in" idx)
52
               ()))
53
        m.mstep.step_inputs
54
        (pp_print_list_i ~pp_open_box:pp_open_vbox0 ~pp_epilogue:pp_print_cut
55
           (fun fmt idx v ->
56
             fprintf fmt "%a; %a" (pp_c_type v.var_id) v.var_type
57
               (fun fmt () -> pp_file_decl fmt "out" idx)
58
               ()))
59
        m.mstep.step_outputs
60
        (pp_print_list_i ~pp_epilogue:pp_print_cut (fun fmt idx _ ->
61
             ignore (pp_file_open fmt "in" idx)))
62
        m.mstep.step_inputs
63
        (pp_print_list_i (fun fmt idx _ -> ignore (pp_file_open fmt "out" idx)))
64
        m.mstep.step_outputs
65

    
66
    let print_main_memory_allocation mname main_mem fmt m =
67
      if not (fst (get_stateless_status m)) then
68
        fprintf fmt
69
          "@[<v>/* Main memory allocation */@,\
70
           %a@,\
71
           @,\
72
           /* Initialize the main memory */@,\
73
           %a(%s);@]"
74
          (fun fmt () ->
75
            if !Options.static_mem && !Options.main_node <> "" then
76
              fprintf fmt "%a(static,main_mem);" pp_machine_static_alloc_name
77
                mname
78
            else
79
              fprintf fmt "%a *main_mem = %a();"
80
                (pp_machine_memtype_name ~ghost:false)
81
                mname pp_machine_alloc_name mname)
82
          () pp_machine_set_reset_name mname main_mem
83

    
84
    let print_global_initialize fmt basename =
85
      let mNAME = file_to_module_name basename in
86
      fprintf fmt "/* Initialize global constants */@,%a();" pp_global_init_name
87
        mNAME
88

    
89
    let print_global_clear fmt basename =
90
      let mNAME = file_to_module_name basename in
91
      fprintf fmt "/* Clear global constants */@,%a();" pp_global_clear_name
92
        mNAME
93

    
94
    let print_main_initialize mname main_mem fmt m =
95
      let inputs = mpfr_vars m.mstep.step_inputs in
96
      let outputs = mpfr_vars m.mstep.step_outputs in
97
      if not (fst (get_stateless_status m)) then
98
        fprintf fmt "/* Initialize inputs, outputs and memories */@,%a%a%a(%s);"
99
          (pp_print_list ~pp_open_box:pp_open_vbox0 ~pp_eol:pp_print_cut
100
             (pp_initialize m main_mem (pp_c_var_read m)))
101
          inputs
102
          (pp_print_list ~pp_open_box:pp_open_vbox0 ~pp_eol:pp_print_cut
103
             (pp_initialize m main_mem (pp_c_var_read m)))
104
          outputs pp_machine_init_name mname main_mem
105
      else
106
        fprintf fmt "/* Initialize inputs and outputs */@,%a%a@ "
107
          (pp_print_list ~pp_open_box:pp_open_vbox0 ~pp_eol:pp_print_cut
108
             (pp_initialize m main_mem (pp_c_var_read m)))
109
          inputs
110
          (pp_print_list ~pp_open_box:pp_open_vbox0
111
             (pp_initialize m main_mem (pp_c_var_read m)))
112
          outputs
113

    
114
    let print_main_clear mname main_mem fmt m =
115
      let inputs = mpfr_vars m.mstep.step_inputs in
116
      let outputs = mpfr_vars m.mstep.step_outputs in
117
      if not (fst (get_stateless_status m)) then
118
        fprintf fmt
119
          "@[<v>/* Clear inputs, outputs and memories */@,%a%a%a(%s);@]"
120
          (pp_print_list ~pp_open_box:pp_open_vbox0 ~pp_eol:pp_print_cut
121
             (pp_clear m main_mem (pp_c_var_read m)))
122
          inputs
123
          (pp_print_list ~pp_open_box:pp_open_vbox0 ~pp_eol:pp_print_cut
124
             (pp_clear m main_mem (pp_c_var_read m)))
125
          outputs pp_machine_clear_name mname main_mem
126
      else
127
        fprintf fmt "@[<v>/* Clear inputs and outputs */@,%a%a@]"
128
          (pp_print_list ~pp_open_box:pp_open_vbox0 ~pp_eol:pp_print_cut
129
             (pp_clear m main_mem (pp_c_var_read m)))
130
          inputs
131
          (pp_print_list ~pp_open_box:pp_open_vbox0
132
             (pp_clear m main_mem (pp_c_var_read m)))
133
          outputs
134

    
135
    let print_get_input fmt id v' v =
136
      let pp_file = pp_print_file ("in" ^ string_of_int (id + 1)) in
137
      let unclocked_t = Types.unclock_type v.var_type in
138
      fprintf fmt "@[<v>%a@]"
139
        (fun fmt () ->
140
          if Types.is_int_type unclocked_t then
141
            fprintf fmt "%s = _get_int(\"%s\");@,%a" v.var_id v'.var_id pp_file
142
              ("d", v.var_id)
143
          else if Types.is_bool_type unclocked_t then
144
            fprintf fmt "%s = _get_bool(\"%s\");@,%a" v.var_id v'.var_id pp_file
145
              ("i", v.var_id)
146
          else if Types.is_real_type unclocked_t then
147
            if !Options.mpfr then
148
              fprintf fmt
149
                "double %s_tmp = _get_double(\"%s\");@,\
150
                 %a@,\
151
                 mpfr_set_d(%s, %s_tmp, %i);" v.var_id v'.var_id pp_file
152
                ("f", v.var_id ^ "_tmp")
153
                v.var_id v.var_id (Mpfr.mpfr_prec ())
154
            else
155
              fprintf fmt "%s = _get_double(\"%s\");@,%a" v.var_id v'.var_id
156
                pp_file ("f", v.var_id)
157
          else (
158
            Global.main_node := !Options.main_node;
159
            eprintf "Code generation error: %a%a@." Error.pp_error_msg
160
              Error.Main_wrong_kind Location.pp_loc v'.var_loc;
161
            raise (Error.Error (v'.var_loc, Error.Main_wrong_kind))))
162
        ()
163

    
164
    let pp_main_call mname self fmt m (inputs : value_t list)
165
        (outputs : var_decl list) =
166
      if fst (Machine_code_common.get_stateless_status m) then
167
        fprintf fmt "%a (%a%a);" pp_machine_step_name mname
168
          (pp_print_list ~pp_sep:pp_print_comma ~pp_eol:pp_print_comma
169
             (pp_c_val m self pp_c_main_var_input))
170
          inputs
171
          (pp_print_list ~pp_sep:pp_print_comma pp_c_main_var_output)
172
          outputs
173
      else
174
        fprintf fmt "%a (%a%a%s);" pp_machine_step_name mname
175
          (pp_print_list ~pp_sep:pp_print_comma ~pp_eol:pp_print_comma
176
             (pp_c_val m self pp_c_main_var_input))
177
          inputs
178
          (pp_print_list ~pp_sep:pp_print_comma ~pp_eol:pp_print_comma
179
             pp_c_main_var_output)
180
          outputs self
181

    
182
    let print_main_loop mname main_mem fmt m =
183
      let input_values =
184
        List.map (fun v -> mk_val (Var v) v.var_type) m.mstep.step_inputs
185
      in
186
      fprintf fmt
187
        "ISATTY = isatty(0);@,\
188
         @,\
189
         /* Infinite loop */@,\
190
         @[<v 2>while(1){@,\
191
         fflush(stdout);@,\
192
         @[<v 2>if (traces) {@,\
193
         %a%a@]@,\
194
         }@,\
195
         %a%a%a"
196
        (pp_print_list_i ~pp_open_box:pp_open_vbox0 ~pp_epilogue:pp_print_cut
197
           (fun fmt idx _ -> fprintf fmt "fflush(f_in%i);" (idx + 1)))
198
        m.mstep.step_inputs
199
        (pp_print_list_i ~pp_open_box:pp_open_vbox0 (fun fmt idx _ ->
200
             fprintf fmt "fflush(f_out%i);" (idx + 1)))
201
        m.mstep.step_outputs
202
        (pp_print_list_i2 ~pp_open_box:pp_open_vbox0 ~pp_epilogue:pp_print_cut
203
           print_get_input)
204
        (m.mname.node_inputs, m.mstep.step_inputs)
205
        (fun fmt () ->
206
          pp_main_call mname main_mem fmt m input_values m.mstep.step_outputs)
207
        ()
208
        (pp_print_list_i2 ~pp_open_box:pp_open_vbox0 ~pp_prologue:pp_print_cut
209
           print_put_output)
210
        (m.mname.node_outputs, m.mstep.step_outputs)
211

    
212
    let print_usage fmt () =
213
      fprintf fmt
214
        "@[<v 2>void usage(char *argv[]) {@,\
215
         printf(\"Usage: %%s\\n\", argv[0]);@,\
216
         printf(\" -t: produce trace files for input/output flows\\n\");@,\
217
         printf(\" -d<dir>: directory containing traces (default: \
218
         _traces)\\n\");@,\
219
         printf(\" -p<prefix>: prefix_simu.scope<id> (default: \
220
         file_node)\\n\");@,\
221
         exit (8);@]@,\
222
         }"
223

    
224
    let print_options fmt name =
225
      fprintf fmt
226
        "@[<v>int traces = 0;@,\
227
         char* prefix = \"%s\";@,\
228
         char* dir = \".\";@,\
229
         @[<v 2>while ((argc > 1) && (argv[1][0] == '-')) {@,\
230
         @[<v 2>switch (argv[1][1]) {@,\
231
         @[<v 2>case 't':@,\
232
         traces = 1;@,\
233
         break;@,\
234
         @]@,\
235
         @[<v 2>case 'd':@,\
236
         dir = &argv[1][2];@,\
237
         break;@,\
238
         @]@,\
239
         @[<v 2>case 'p':@,\
240
         prefix = &argv[1][2];@,\
241
         break;@,\
242
         @]@,\
243
         @[<v 2>default:@,\
244
         printf(\"Wrong Argument: %%s\\n\", argv[1]);@,\
245
         usage(argv);@]@]@,\
246
         }@,\
247
         ++argv;@,\
248
         --argc;@]@,\
249
         }@]"
250
        name
251

    
252
    let print_main_code fmt (basename, m) =
253
      let mname = m.mname.node_id in
254
      (* TODO: find a proper way to shorthen long names. This causes segfault in
255
         the binary when trying to fprintf in them *)
256
      let mname =
257
        if String.length mname > 50 then string_of_int (Hashtbl.hash mname)
258
        else mname
259
      in
260
      let main_mem =
261
        if !Options.static_mem && !Options.main_node <> "" then "&main_mem"
262
        else "main_mem"
263
      in
264

    
265
      fprintf fmt
266
        "@[<v>%a@,\
267
         @,\
268
         @[<v 2>int main (int argc, char *argv[]) {@,\
269
         %a@,\
270
         @,\
271
         %a@,\
272
         %a@,\
273
         %a@,\
274
         %a@,\
275
         %a@,\
276
         %a@]@,\
277
         }@,\
278
         %areturn 1;@]@,\
279
         }@]@."
280
        print_usage () print_options
281
        (basename ^ "_" ^ mname)
282
        print_main_inout_declaration m
283
        (Plugins.c_backend_main_loop_body_prefix basename mname)
284
        ()
285
        (print_main_memory_allocation mname main_mem)
286
        m
287
        (fun fmt () ->
288
          if !Options.mpfr then
289
            fprintf fmt "@[<v>%a@,%a@]@," print_global_initialize basename
290
              (print_main_initialize mname main_mem)
291
              m)
292
        ()
293
        (print_main_loop mname main_mem)
294
        m Plugins.c_backend_main_loop_body_suffix ()
295
        (fun fmt () ->
296
          if !Options.mpfr then
297
            fprintf fmt "@[<v>%a@,%a@]@,"
298
              (print_main_clear mname main_mem)
299
              m print_global_clear basename)
300
        ()
301

    
302
    let print_main_header fmt () =
303
      fprintf fmt "@[<v>#include <stdio.h>@,#include <unistd.h>@,%a@]"
304
        (fun fmt () ->
305
          fprintf fmt
306
            (if !Options.cpp then "#include \"%s/io_frontend.hpp\""
307
            else "#include <string.h>@,#include \"%s/io_frontend.h\"")
308
            (Options_management.core_dependency "io_frontend"))
309
        ()
310

    
311
    let print_main_c main_fmt main_machine basename _prog _machines
312
        _dependencies =
313
      fprintf main_fmt
314
        "@[<v>%a@,\
315
         #include <stdlib.h>@,\
316
         #include <assert.h>@,\
317
         %a@,\
318
         @,\
319
         %a@,\
320
         %a\n\
321
        \       @]@." print_main_header () print_import_alloc_prototype
322
        {
323
          local = true;
324
          name = basename;
325
          content = [];
326
          is_stateful = true (* assuming it is stateful*);
327
        }
328
        (* Print the svn version number and the supported C standard (C90 or
329
           C99) *)
330
        pp_print_version () print_main_code (basename, main_machine)
331
  end
332

    
333
(* Local Variables: *)
334
(* compile-command:"make -C ../../.." *)
335
(* End: *)
(5-5/9)