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 LustreSpec
|
13
|
open Corelang
|
14
|
open Machine_code
|
15
|
open Format
|
16
|
open C_backend_common
|
17
|
open Utils
|
18
|
|
19
|
module type MODIFIERS_MAINSRC =
|
20
|
sig
|
21
|
end
|
22
|
|
23
|
module EmptyMod =
|
24
|
struct
|
25
|
end
|
26
|
|
27
|
module Main = functor (Mod: MODIFIERS_MAINSRC) ->
|
28
|
struct
|
29
|
|
30
|
(********************************************************************************************)
|
31
|
(* Main related functions *)
|
32
|
(********************************************************************************************)
|
33
|
|
34
|
let print_get_inputs fmt m =
|
35
|
let pi fmt (id, v', v) =
|
36
|
match (Types.unclock_type v.var_type).Types.tdesc with
|
37
|
| Types.Tint -> fprintf fmt "%s = _get_int(f_in%i, \"%s\")" v.var_id id v'.var_id
|
38
|
| Types.Tbool -> fprintf fmt "%s = _get_bool(f_in%i, \"%s\")" v.var_id id v'.var_id
|
39
|
| Types.Treal when !Options.mpfr -> fprintf fmt "mpfr_set_d(%s, _get_double(f_in%i, \"%s\"), %i)" v.var_id id v'.var_id (Mpfr.mpfr_prec ())
|
40
|
| Types.Treal -> fprintf fmt "%s = _get_double(f_in%i, \"%s\")" v.var_id id v'.var_id
|
41
|
| _ ->
|
42
|
begin
|
43
|
Global.main_node := !Options.main_node;
|
44
|
Format.eprintf "Code generation error: %a%a@."
|
45
|
pp_error Main_wrong_kind
|
46
|
Location.pp_loc v'.var_loc;
|
47
|
raise (Error (v'.var_loc, Main_wrong_kind))
|
48
|
end
|
49
|
in
|
50
|
List.iteri2 (fun idx v' v ->
|
51
|
fprintf fmt "@ %a;" pi ((idx+1), v', v);
|
52
|
) m.mname.node_inputs m.mstep.step_inputs
|
53
|
|
54
|
let print_put_outputs fmt m =
|
55
|
let po fmt (id, o', o) =
|
56
|
match (Types.unclock_type o.var_type).Types.tdesc with
|
57
|
| Types.Tint -> fprintf fmt "_put_int(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
|
58
|
| Types.Tbool -> fprintf fmt "_put_bool(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
|
59
|
| Types.Treal when !Options.mpfr -> fprintf fmt "_put_double(f_out%i, \"%s\", mpfr_get_d(%s, %s))" id o'.var_id o.var_id (Mpfr.mpfr_rnd ())
|
60
|
| Types.Treal -> fprintf fmt "_put_double(f_out%i, \"%s\", %s)" id o'.var_id o.var_id
|
61
|
| _ -> assert false
|
62
|
in
|
63
|
Utils.List.iteri2 (fun idx v' v -> fprintf fmt "@ %a;" po ((idx+1), v', v)) m.mname.node_outputs m.mstep.step_outputs
|
64
|
|
65
|
let print_main_inout_declaration basename fmt m =
|
66
|
let mname = m.mname.node_id in
|
67
|
fprintf fmt "/* Declaration of inputs/outputs variables */@ ";
|
68
|
List.iteri
|
69
|
(fun idx v ->
|
70
|
fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type;
|
71
|
fprintf fmt "FILE *f_in%i;@ " (idx+1); (* we start from 1: in1, in2, ... *)
|
72
|
fprintf fmt "f_in%i = fopen(\"%s_%s_simu.in%i\", \"w\");@ " (idx+1) basename mname (idx+1);
|
73
|
) m.mstep.step_inputs;
|
74
|
List.iteri
|
75
|
(fun idx v ->
|
76
|
fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type;
|
77
|
fprintf fmt "FILE *f_out%i;@ " (idx+1); (* we start from 1: in1, in2, ... *)
|
78
|
fprintf fmt "f_out%i = fopen(\"%s_%s_simu.out%i\", \"w\");@ " (idx+1) basename mname (idx+1);
|
79
|
) m.mstep.step_outputs
|
80
|
|
81
|
|
82
|
|
83
|
let print_main_memory_allocation mname main_mem fmt m =
|
84
|
if not (fst (get_stateless_status m)) then
|
85
|
begin
|
86
|
fprintf fmt "@ /* Main memory allocation */@ ";
|
87
|
if (!Options.static_mem && !Options.main_node <> "")
|
88
|
then (fprintf fmt "%a(static,main_mem);@ " pp_machine_static_alloc_name mname)
|
89
|
else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname);
|
90
|
fprintf fmt "@ /* Initialize the main memory */@ ";
|
91
|
fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem;
|
92
|
end
|
93
|
|
94
|
let print_global_initialize fmt basename =
|
95
|
let mNAME = file_to_module_name basename in
|
96
|
fprintf fmt "@ /* Initialize global constants */@ %a();@ "
|
97
|
pp_global_init_name mNAME
|
98
|
|
99
|
let print_global_clear fmt basename =
|
100
|
let mNAME = file_to_module_name basename in
|
101
|
fprintf fmt "@ /* Clear global constants */@ %a();@ "
|
102
|
pp_global_clear_name mNAME
|
103
|
|
104
|
let print_main_initialize mname main_mem fmt m =
|
105
|
if not (fst (get_stateless_status m))
|
106
|
then
|
107
|
fprintf fmt "@ /* Initialize inputs, outputs and memories */@ %a%t%a%t%a(%s);@ "
|
108
|
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs
|
109
|
(Utils.pp_newline_if_non_empty m.mstep.step_inputs)
|
110
|
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs
|
111
|
(Utils.pp_newline_if_non_empty m.mstep.step_inputs)
|
112
|
pp_machine_init_name mname
|
113
|
main_mem
|
114
|
else
|
115
|
fprintf fmt "@ /* Initialize inputs and outputs */@ %a%t%a@ "
|
116
|
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs
|
117
|
(Utils.pp_newline_if_non_empty m.mstep.step_inputs)
|
118
|
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs
|
119
|
|
120
|
let print_main_clear mname main_mem fmt m =
|
121
|
if not (fst (get_stateless_status m))
|
122
|
then
|
123
|
fprintf fmt "@ /* Clear inputs, outputs and memories */@ %a%t%a%t%a(%s);@ "
|
124
|
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs
|
125
|
(Utils.pp_newline_if_non_empty m.mstep.step_inputs)
|
126
|
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs
|
127
|
(Utils.pp_newline_if_non_empty m.mstep.step_inputs)
|
128
|
pp_machine_clear_name mname
|
129
|
main_mem
|
130
|
else
|
131
|
fprintf fmt "@ /* Clear inputs and outputs */@ %a%t%a@ "
|
132
|
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs
|
133
|
(Utils.pp_newline_if_non_empty m.mstep.step_inputs)
|
134
|
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs
|
135
|
|
136
|
let print_main_loop mname main_mem fmt m =
|
137
|
let input_values =
|
138
|
List.map (fun v -> mk_val (LocalVar v) v.var_type)
|
139
|
m.mstep.step_inputs in
|
140
|
begin
|
141
|
fprintf fmt "@ ISATTY = isatty(0);@ ";
|
142
|
fprintf fmt "@ /* Infinite loop */@ ";
|
143
|
fprintf fmt "@[<v 2>while(1){@ ";
|
144
|
fprintf fmt "fflush(stdout);@ ";
|
145
|
List.iteri (fun idx _ -> fprintf fmt "fflush(f_in%i);@ " (idx+1)) m.mstep.step_inputs;
|
146
|
List.iteri (fun idx _ -> fprintf fmt "fflush(f_out%i);@ " (idx+1)) m.mstep.step_outputs;
|
147
|
fprintf fmt "%a@ %t%a"
|
148
|
print_get_inputs m
|
149
|
(fun fmt -> pp_main_call mname main_mem fmt m input_values m.mstep.step_outputs)
|
150
|
print_put_outputs m
|
151
|
end
|
152
|
|
153
|
let print_main_code fmt basename m =
|
154
|
let mname = m.mname.node_id in
|
155
|
let main_mem =
|
156
|
if (!Options.static_mem && !Options.main_node <> "")
|
157
|
then "&main_mem"
|
158
|
else "main_mem" in
|
159
|
fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ ";
|
160
|
print_main_inout_declaration basename fmt m;
|
161
|
print_main_memory_allocation mname main_mem fmt m;
|
162
|
if !Options.mpfr then
|
163
|
begin
|
164
|
print_global_initialize fmt basename;
|
165
|
print_main_initialize mname main_mem fmt m;
|
166
|
end;
|
167
|
print_main_loop mname main_mem fmt m;
|
168
|
if Scopes.Plugin.is_active () then
|
169
|
begin
|
170
|
fprintf fmt "@ %t" Scopes.Plugin.pp
|
171
|
end;
|
172
|
fprintf fmt "@]@ }@ @ ";
|
173
|
if !Options.mpfr then
|
174
|
begin
|
175
|
print_main_clear mname main_mem fmt m;
|
176
|
print_global_clear fmt basename;
|
177
|
end;
|
178
|
fprintf fmt "@ return 1;";
|
179
|
fprintf fmt "@]@ }@."
|
180
|
|
181
|
let print_main_header fmt =
|
182
|
fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/io_frontend.h\"@."
|
183
|
!Options.include_dir
|
184
|
|
185
|
let print_main_c main_fmt main_machine basename prog machines _ (*dependencies*) =
|
186
|
print_main_header main_fmt;
|
187
|
fprintf main_fmt "#include <stdlib.h>@.#include <assert.h>@.";
|
188
|
print_import_alloc_prototype main_fmt (Dep (true, basename, [], true (* assuming it is stateful*) ));
|
189
|
pp_print_newline main_fmt ();
|
190
|
|
191
|
(* Print the svn version number and the supported C standard (C90 or C99) *)
|
192
|
print_version main_fmt;
|
193
|
print_main_code main_fmt basename main_machine
|
194
|
end
|
195
|
|
196
|
(* Local Variables: *)
|
197
|
(* compile-command:"make -C ../../.." *)
|
198
|
(* End: *)
|