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: *)
|