Project

General

Profile

Statistics
| Branch: | Tag: | Revision:

lustrec / src / backends / C / c_backend_main.ml @ 3769b712

History | View | Annotate | Download (8.92 KB)

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 Lustrec.Lustre_types
13
open Lustrec.Machine_code_types
14
open Lustrec.Corelang
15
open Lustrec.Machine_code_common
16
open Format
17
open C_backend_common
18
open Lustrec.Utils
19

    
20
module type MODIFIERS_MAINSRC =
21
sig
22
end
23

    
24
module EmptyMod =
25
struct
26
end
27

    
28
module Main = functor (Mod: MODIFIERS_MAINSRC) -> 
29
struct
30

    
31
(********************************************************************************************)
32
(*                         Main related functions                                           *)
33
(********************************************************************************************)
34

    
35

    
36
let print_put_outputs fmt m = 
37
  let po fmt (id, o', o) =
38
    let suff = string_of_int id in
39
    print_put_var fmt suff o'.var_id o.var_type o.var_id
40
  in
41
  List.iteri2 (fun idx v' v -> fprintf fmt "@ %a;" po ((idx+1), v', v)) m.mname.node_outputs m.mstep.step_outputs
42

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

    
63
  
64
let print_main_memory_allocation mname main_mem fmt m =
65
  if not (fst (get_stateless_status m)) then
66
  begin  
67
    fprintf fmt "@ /* Main memory allocation */@ ";
68
    if (!Lustrec.Options.static_mem && !Lustrec.Options.main_node <> "")
69
    then (fprintf fmt "%a(static,main_mem);@ " pp_machine_static_alloc_name mname)
70
    else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname);
71
    fprintf fmt "@ /* Initialize the main memory */@ ";
72
    fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem;
73
  end
74

    
75
let print_global_initialize fmt basename =
76
  let mNAME = file_to_module_name basename in
77
  fprintf fmt "@ /* Initialize global constants */@ %a();@ "
78
    pp_global_init_name mNAME
79

    
80
let print_global_clear fmt basename =
81
  let mNAME = file_to_module_name basename in
82
  fprintf fmt "@ /* Clear global constants */@ %a();@ "
83
    pp_global_clear_name mNAME
84

    
85
let print_main_initialize mname main_mem fmt m =
86
  if not (fst (get_stateless_status m))
87
  then
88
    fprintf fmt "@ /* Initialize inputs, outputs and memories */@ %a%t%a%t%a(%s);@ "
89
      (Lustrec.Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs
90
      (Lustrec.Utils.pp_newline_if_non_empty m.mstep.step_inputs)
91
      (Lustrec.Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs
92
      (Lustrec.Utils.pp_newline_if_non_empty m.mstep.step_inputs)
93
      pp_machine_init_name mname
94
      main_mem
95
  else
96
    fprintf fmt "@ /* Initialize inputs and outputs */@ %a%t%a@ "
97
      (Lustrec.Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs
98
      (Lustrec.Utils.pp_newline_if_non_empty m.mstep.step_inputs)
99
      (Lustrec.Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs
100

    
101
let print_main_clear mname main_mem fmt m =
102
  if not (fst (get_stateless_status m))
103
  then
104
    fprintf fmt "@ /* Clear inputs, outputs and memories */@ %a%t%a%t%a(%s);@ "
105
      (Lustrec.Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs
106
      (Lustrec.Utils.pp_newline_if_non_empty m.mstep.step_inputs)
107
      (Lustrec.Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs
108
      (Lustrec.Utils.pp_newline_if_non_empty m.mstep.step_inputs)
109
      pp_machine_clear_name mname
110
      main_mem
111
  else
112
    fprintf fmt "@ /* Clear inputs and outputs */@ %a%t%a@ "
113
      (Lustrec.Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs
114
      (Lustrec.Utils.pp_newline_if_non_empty m.mstep.step_inputs)
115
      (Lustrec.Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs
116

    
117
let print_main_loop mname main_mem fmt m =
118
  let input_values =
119
    List.map (fun v -> mk_val (Var v) v.var_type)
120
      m.mstep.step_inputs in
121
  begin
122
    fprintf fmt "@ ISATTY = isatty(0);@ ";
123
    fprintf fmt "@ /* Infinite loop */@ ";
124
    fprintf fmt "@[<v 2>while(1){@ ";
125
    fprintf fmt  "fflush(stdout);@ ";
126
    fprintf fmt "@[<v 2>if (traces) {@ ";
127
    List.iteri (fun idx _ -> fprintf fmt "fflush(f_in%i);@ " (idx+1)) m.mstep.step_inputs;
128
    List.iteri (fun idx _ -> fprintf fmt "fflush(f_out%i);@ " (idx+1)) m.mstep.step_outputs;
129
    fprintf fmt "@]}@ ";
130
    fprintf fmt "%a@ %t%a"
131
      print_get_inputs m
132
      (fun fmt -> pp_main_call mname main_mem fmt m input_values m.mstep.step_outputs)
133
      print_put_outputs m
134
  end
135

    
136
let print_usage fmt =
137
  fprintf fmt "@[<v 2>void usage(char *argv[]) {@ ";
138
  fprintf fmt "printf(\"Usage: %%s\\n\", argv[0]);@ ";
139
  fprintf fmt "printf(\" -t: produce trace files for input/output flows\\n\");@ ";
140
  fprintf fmt "printf(\" -d<dir>: directory containing traces (default: _traces)\\n\");@ ";
141
  fprintf fmt "printf(\" -p<prefix>: prefix_simu.scope<id> (default: file_node)\\n\");@ ";
142
  fprintf fmt "exit (8);@ ";
143
  fprintf fmt "@]}@ "
144

    
145
let print_options fmt name =
146
  fprintf fmt "int traces = 0;@ ";
147
  fprintf fmt "char* prefix = \"%s\";@ " name;
148
  fprintf fmt "char* dir = \".\";@ ";
149
  fprintf fmt "@[<v 2>while ((argc > 1) && (argv[1][0] == '-')) {@ ";
150
  fprintf fmt "@[<v 2>switch (argv[1][1]) {@ ";
151
  fprintf fmt "@[<v 2>case 't':@ ";
152
  fprintf fmt "traces = 1;@ ";
153
  fprintf fmt "break;@ ";
154
  fprintf fmt "@]@ ";
155
  fprintf fmt "@[<v 2>case 'd':@ ";
156
  fprintf fmt "dir = &argv[1][2];@ ";
157
  fprintf fmt "break;@ ";
158
  fprintf fmt "@]@ ";
159
  fprintf fmt "@[<v 2>case 'p':@ ";
160
  fprintf fmt "prefix = &argv[1][2];@ ";
161
  fprintf fmt "break;@ ";
162
  fprintf fmt "@]@ ";
163
  fprintf fmt "@[<v 2>default:@ ";
164
  fprintf fmt "printf(\"Wrong Argument: %%s\\n\", argv[1]);@ ";
165
  fprintf fmt "usage(argv);@ ";
166
  fprintf fmt "@]@ ";
167
  fprintf fmt "@]}@ ";
168
  fprintf fmt "++argv;@ ";
169
  fprintf fmt "--argc;@ ";
170
  fprintf fmt "@]}@ "
171
  
172
let print_main_code fmt basename m =
173
  let mname = m.mname.node_id in
174
  (* TODO: find a proper way to shorthen long names. This causes segfault in the binary when trying to fprintf in them *)
175
  let mname = if String.length mname > 50 then string_of_int (Hashtbl.hash mname) else mname in
176
  
177
  let main_mem =
178
    if (!Lustrec.Options.static_mem && !Lustrec.Options.main_node <> "")
179
    then "&main_mem"
180
    else "main_mem" in
181
  print_usage fmt;
182
  
183
  fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ ";
184
  print_options fmt (basename ^ "_" ^ mname);
185
  print_main_inout_declaration m fmt;
186
  Plugins.c_backend_main_loop_body_prefix basename mname fmt ();
187
  print_main_memory_allocation mname main_mem fmt m;
188
  if !Lustrec.Options.mpfr then
189
    begin
190
      print_global_initialize fmt basename;
191
      print_main_initialize mname main_mem fmt m;
192
    end;
193
  print_main_loop mname main_mem fmt m;
194

    
195
  Plugins.c_backend_main_loop_body_suffix fmt ();
196
  fprintf fmt "@]@ }@ @ ";
197
  if !Lustrec.Options.mpfr then
198
    begin
199
      print_main_clear mname main_mem fmt m;
200
      print_global_clear fmt basename;
201
    end;
202
  fprintf fmt "@ return 1;";
203
  fprintf fmt "@]@ }@."       
204

    
205
let print_main_header fmt =
206
  fprintf fmt (if !Lustrec.Options.cpp then "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/io_frontend.hpp\"@." else "#include <stdio.h>@.#include <unistd.h>@.#include <string.h>@.#include \"%s/io_frontend.h\"@.")
207
    (Lustrec.Options_management.core_dependency "io_frontend")
208

    
209
let print_main_c main_fmt main_machine basename prog machines _ (*dependencies*) =
210
  print_main_header main_fmt;
211
  fprintf main_fmt "#include <stdlib.h>@.#include <assert.h>@.";
212
  print_import_alloc_prototype main_fmt {local=true; name=basename; content=[]; is_stateful=true} (* assuming it is stateful*) ;
213
  pp_print_newline main_fmt ();
214

    
215
  (* Print the svn version number and the supported C standard (C90 or C99) *)
216
  print_version main_fmt;
217
  print_main_code main_fmt basename main_machine
218
end  
219

    
220
(* Local Variables: *)
221
(* compile-command:"make -C ../../.." *)
222
(* End: *)