1 |
a2d97a3e
|
ploc
|
(********************************************************************)
|
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 |
13eb21df
|
ploc
|
open LustreSpec
|
13 |
|
|
open Corelang
|
14 |
|
|
open Machine_code
|
15 |
|
|
open Format
|
16 |
|
|
open C_backend_common
|
17 |
6fa45cb6
|
ploc
|
open Utils
|
18 |
13eb21df
|
ploc
|
|
19 |
d4107cf2
|
ploc
|
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 |
13eb21df
|
ploc
|
(********************************************************************************************)
|
31 |
|
|
(* Main related functions *)
|
32 |
|
|
(********************************************************************************************)
|
33 |
|
|
|
34 |
04a63d25
|
xthirioux
|
let print_get_inputs fmt m =
|
35 |
6fa45cb6
|
ploc
|
let pi fmt (id, v', v) =
|
36 |
04a63d25
|
xthirioux
|
match (Types.unclock_type v.var_type).Types.tdesc with
|
37 |
6fa45cb6
|
ploc
|
| 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 |
04a63d25
|
xthirioux
|
| _ ->
|
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 |
6fa45cb6
|
ploc
|
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 |
13eb21df
|
ploc
|
|
54 |
04a63d25
|
xthirioux
|
let print_put_outputs fmt m =
|
55 |
6fa45cb6
|
ploc
|
let po fmt (id, o', o) =
|
56 |
04a63d25
|
xthirioux
|
match (Types.unclock_type o.var_type).Types.tdesc with
|
57 |
6fa45cb6
|
ploc
|
| 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 |
13eb21df
|
ploc
|
| _ -> assert false
|
62 |
|
|
in
|
63 |
6fa45cb6
|
ploc
|
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 |
04a63d25
|
xthirioux
|
|
81 |
|
|
|
82 |
6fa45cb6
|
ploc
|
|
83 |
04a63d25
|
xthirioux
|
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 |
6fa45cb6
|
ploc
|
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 |
04a63d25
|
xthirioux
|
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 |
13eb21df
|
ploc
|
|
153 |
04a63d25
|
xthirioux
|
let print_main_code fmt basename m =
|
154 |
13eb21df
|
ploc
|
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 |
6fa45cb6
|
ploc
|
print_main_inout_declaration basename fmt m;
|
161 |
04a63d25
|
xthirioux
|
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 |
13eb21df
|
ploc
|
fprintf fmt "@]@ }@."
|
180 |
|
|
|
181 |
|
|
let print_main_header fmt =
|
182 |
52c5ba00
|
David Doose
|
fprintf fmt (if !Options.cpp then "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/io_frontend.hpp\"@." else "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/io_frontend.h\"@.")
|
183 |
dcafc99b
|
Ploc
|
!Options.include_dir
|
184 |
13eb21df
|
ploc
|
|
185 |
58a463e7
|
ploc
|
let print_main_c main_fmt main_machine basename prog machines _ (*dependencies*) =
|
186 |
d4107cf2
|
ploc
|
print_main_header main_fmt;
|
187 |
ef34b4ae
|
xthirioux
|
fprintf main_fmt "#include <stdlib.h>@.#include <assert.h>@.";
|
188 |
58a463e7
|
ploc
|
print_import_alloc_prototype main_fmt (Dep (true, basename, [], true (* assuming it is stateful*) ));
|
189 |
ef34b4ae
|
xthirioux
|
pp_print_newline main_fmt ();
|
190 |
|
|
|
191 |
d4107cf2
|
ploc
|
(* Print the svn version number and the supported C standard (C90 or C99) *)
|
192 |
|
|
print_version main_fmt;
|
193 |
04a63d25
|
xthirioux
|
print_main_code main_fmt basename main_machine
|
194 |
d4107cf2
|
ploc
|
end
|
195 |
13eb21df
|
ploc
|
|
196 |
|
|
(* Local Variables: *)
|
197 |
cd670fe1
|
ploc
|
(* compile-command:"make -C ../../.." *)
|
198 |
13eb21df
|
ploc
|
(* End: *)
|