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 Mpfr = Lustrec_mpfr
20

    
21
module type MODIFIERS_MAINSRC = sig end
22

    
23
module EmptyMod = struct end
24

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

    
34
    let pp_c_main_var_input fmt id = fprintf fmt "%s" id.var_id
35

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

    
40
    let print_put_output fmt id o' o =
41
      let suff = string_of_int (id + 1) in
42
      pp_put_var fmt suff o'.var_id o.var_type o.var_id
43

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    
335
(* Local Variables: *)
336
(* compile-command:"make -C ../../.." *)
337
(* End: *)
(9-9/18)