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 |
cd670fe1
|
ploc
|
open Format
|
13 |
|
|
open LustreSpec
|
14 |
|
|
open Corelang
|
15 |
|
|
open Machine_code
|
16 |
|
|
open C_backend_common
|
17 |
|
|
|
18 |
|
|
(********************************************************************************************)
|
19 |
|
|
(* Header Printing functions *)
|
20 |
|
|
(********************************************************************************************)
|
21 |
|
|
|
22 |
|
|
|
23 |
cefc3744
|
ploc
|
module type MODIFIERS_HDR =
|
24 |
|
|
sig
|
25 |
|
|
val print_machine_decl_prefix: Format.formatter -> Machine_code.machine_t -> unit
|
26 |
|
|
end
|
27 |
|
|
|
28 |
|
|
module EmptyMod =
|
29 |
|
|
struct
|
30 |
|
|
let print_machine_decl_prefix = fun fmt x -> ()
|
31 |
|
|
end
|
32 |
|
|
|
33 |
|
|
module Main = functor (Mod: MODIFIERS_HDR) ->
|
34 |
|
|
struct
|
35 |
|
|
|
36 |
cd670fe1
|
ploc
|
let print_import_standard fmt =
|
37 |
04a63d25
|
xthirioux
|
begin
|
38 |
|
|
if !Options.mpfr then
|
39 |
|
|
begin
|
40 |
|
|
fprintf fmt "#include <mpfr.h>@."
|
41 |
|
|
end;
|
42 |
52c5ba00
|
David Doose
|
if !Options.cpp then
|
43 |
|
|
fprintf fmt "#include \"%s/arrow.hpp\"@.@." !Options.include_dir
|
44 |
|
|
else
|
45 |
|
|
fprintf fmt "#include \"%s/arrow.h\"@.@." !Options.include_dir
|
46 |
dcafc99b
|
Ploc
|
|
47 |
04a63d25
|
xthirioux
|
end
|
48 |
cd670fe1
|
ploc
|
|
49 |
ec433d69
|
xthirioux
|
let rec print_static_val pp_var fmt v =
|
50 |
04a63d25
|
xthirioux
|
match v.value_desc with
|
51 |
ec433d69
|
xthirioux
|
| Cst c -> pp_c_const fmt c
|
52 |
|
|
| LocalVar v -> pp_var fmt v
|
53 |
|
|
| Fun (n, vl) -> Basic_library.pp_c n (print_static_val pp_var) fmt vl
|
54 |
|
|
| _ -> (Format.eprintf "Internal error: C_backend_header.print_static_val"; assert false)
|
55 |
|
|
|
56 |
14c56a07
|
xthirioux
|
let print_constant_decl (m, attr, inst) pp_var fmt v =
|
57 |
|
|
Format.fprintf fmt "%s %a = %a"
|
58 |
|
|
attr
|
59 |
|
|
(pp_c_type (Format.sprintf "%s ## %s" inst v.var_id)) v.var_type
|
60 |
ec433d69
|
xthirioux
|
(print_static_val pp_var) (Machine_code.get_const_assign m v)
|
61 |
|
|
|
62 |
14c56a07
|
xthirioux
|
let print_static_constant_decl (m, attr, inst) fmt const_locals =
|
63 |
ec433d69
|
xthirioux
|
let pp_var fmt v =
|
64 |
|
|
if List.mem v const_locals
|
65 |
|
|
then
|
66 |
|
|
Format.fprintf fmt "%s ## %s" inst v.var_id
|
67 |
|
|
else
|
68 |
|
|
Format.fprintf fmt "%s" v.var_id in
|
69 |
|
|
Format.fprintf fmt "%a%t"
|
70 |
14c56a07
|
xthirioux
|
(Utils.fprintf_list ~sep:";\\@," (print_constant_decl (m, attr, inst) pp_var)) const_locals
|
71 |
ec433d69
|
xthirioux
|
(Utils.pp_final_char_if_non_empty ";\\@," const_locals)
|
72 |
|
|
|
73 |
|
|
let print_static_declare_instance (m, attr, inst) const_locals fmt (i, (n, static)) =
|
74 |
|
|
let pp_var fmt v =
|
75 |
|
|
if List.mem v const_locals
|
76 |
|
|
then
|
77 |
|
|
Format.fprintf fmt "%s ## %s" inst v.var_id
|
78 |
|
|
else
|
79 |
|
|
Format.fprintf fmt "%s" v.var_id in
|
80 |
|
|
let values = List.map (Machine_code.value_of_dimension m) static in
|
81 |
cd670fe1
|
ploc
|
fprintf fmt "%a(%s, %a%t%s)"
|
82 |
ec433d69
|
xthirioux
|
pp_machine_static_declare_name (node_name n)
|
83 |
cd670fe1
|
ploc
|
attr
|
84 |
ec433d69
|
xthirioux
|
(Utils.fprintf_list ~sep:", " (print_static_val pp_var)) values
|
85 |
cd670fe1
|
ploc
|
(Utils.pp_final_char_if_non_empty ", " static)
|
86 |
|
|
i
|
87 |
|
|
|
88 |
ec433d69
|
xthirioux
|
let print_static_declare_macro fmt (m, attr, inst) =
|
89 |
|
|
let const_locals = List.filter (fun vdecl -> vdecl.var_dec_const) m.mstep.step_locals in
|
90 |
cd670fe1
|
ploc
|
let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
|
91 |
ec433d69
|
xthirioux
|
fprintf fmt "@[<v 2>#define %a(%s, %a%t%s)\\@,%a%s %a %s;\\@,%a%t%a;@,@]"
|
92 |
cd670fe1
|
ploc
|
pp_machine_static_declare_name m.mname.node_id
|
93 |
|
|
attr
|
94 |
|
|
(Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
|
95 |
|
|
(Utils.pp_final_char_if_non_empty ", " m.mstatic)
|
96 |
|
|
inst
|
97 |
ec433d69
|
xthirioux
|
(* constants *)
|
98 |
14c56a07
|
xthirioux
|
(print_static_constant_decl (m, attr, inst)) const_locals
|
99 |
cd670fe1
|
ploc
|
attr
|
100 |
|
|
pp_machine_memtype_name m.mname.node_id
|
101 |
|
|
inst
|
102 |
ec433d69
|
xthirioux
|
(Utils.fprintf_list ~sep:";\\@," (pp_c_decl_local_var m)) array_mem
|
103 |
cd670fe1
|
ploc
|
(Utils.pp_final_char_if_non_empty ";\\@," array_mem)
|
104 |
|
|
(Utils.fprintf_list ~sep:";\\@,"
|
105 |
|
|
(fun fmt (i',m') ->
|
106 |
ec433d69
|
xthirioux
|
let path = sprintf "%s ## _%s" inst i' in
|
107 |
cd670fe1
|
ploc
|
fprintf fmt "%a"
|
108 |
ec433d69
|
xthirioux
|
(print_static_declare_instance (m, attr, inst) const_locals) (path, m')
|
109 |
cd670fe1
|
ploc
|
)) m.minstances
|
110 |
|
|
|
111 |
|
|
|
112 |
|
|
let print_static_link_instance fmt (i, (m, _)) =
|
113 |
|
|
fprintf fmt "%a(%s)" pp_machine_static_link_name (node_name m) i
|
114 |
|
|
|
115 |
|
|
(* Allocation of a node struct:
|
116 |
|
|
- if node memory is an array/matrix/etc, we cast it to a pointer (see pp_registers_struct)
|
117 |
|
|
*)
|
118 |
ec433d69
|
xthirioux
|
let print_static_link_macro fmt (m, attr, inst) =
|
119 |
cd670fe1
|
ploc
|
let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in
|
120 |
ec433d69
|
xthirioux
|
fprintf fmt "@[<v>@[<v 2>#define %a(%s) do {\\@,%a%t%a;\\@]@,} while (0)@.@]"
|
121 |
cd670fe1
|
ploc
|
pp_machine_static_link_name m.mname.node_id
|
122 |
ec433d69
|
xthirioux
|
inst
|
123 |
cd670fe1
|
ploc
|
(Utils.fprintf_list ~sep:";\\@,"
|
124 |
|
|
(fun fmt v ->
|
125 |
ec433d69
|
xthirioux
|
fprintf fmt "%s._reg.%s = (%a*) &%s"
|
126 |
|
|
inst
|
127 |
cd670fe1
|
ploc
|
v.var_id
|
128 |
|
|
(fun fmt v -> pp_c_type "" fmt (Types.array_base_type v.var_type)) v
|
129 |
|
|
v.var_id
|
130 |
|
|
)) array_mem
|
131 |
|
|
(Utils.pp_final_char_if_non_empty ";\\@," array_mem)
|
132 |
|
|
(Utils.fprintf_list ~sep:";\\@,"
|
133 |
|
|
(fun fmt (i',m') ->
|
134 |
ec433d69
|
xthirioux
|
let path = sprintf "%s ## _%s" inst i' in
|
135 |
|
|
fprintf fmt "%a;\\@,%s.%s = &%s"
|
136 |
cd670fe1
|
ploc
|
print_static_link_instance (path,m')
|
137 |
ec433d69
|
xthirioux
|
inst
|
138 |
cd670fe1
|
ploc
|
i'
|
139 |
|
|
path
|
140 |
|
|
)) m.minstances
|
141 |
ec433d69
|
xthirioux
|
|
142 |
|
|
let print_static_alloc_macro fmt (m, attr, inst) =
|
143 |
|
|
fprintf fmt "@[<v>@[<v 2>#define %a(%s, %a%t%s)\\@,%a(%s, %a%t%s);\\@,%a(%s);@]@,@]@."
|
144 |
cd670fe1
|
ploc
|
pp_machine_static_alloc_name m.mname.node_id
|
145 |
ec433d69
|
xthirioux
|
attr
|
146 |
cd670fe1
|
ploc
|
(Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
|
147 |
|
|
(Utils.pp_final_char_if_non_empty ", " m.mstatic)
|
148 |
ec433d69
|
xthirioux
|
inst
|
149 |
cd670fe1
|
ploc
|
pp_machine_static_declare_name m.mname.node_id
|
150 |
ec433d69
|
xthirioux
|
attr
|
151 |
cd670fe1
|
ploc
|
(Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic
|
152 |
|
|
(Utils.pp_final_char_if_non_empty ", " m.mstatic)
|
153 |
ec433d69
|
xthirioux
|
inst
|
154 |
cd670fe1
|
ploc
|
pp_machine_static_link_name m.mname.node_id
|
155 |
ec433d69
|
xthirioux
|
inst
|
156 |
cd670fe1
|
ploc
|
|
157 |
|
|
let print_machine_decl fmt m =
|
158 |
04a63d25
|
xthirioux
|
begin
|
159 |
|
|
Mod.print_machine_decl_prefix fmt m;
|
160 |
|
|
if fst (get_stateless_status m) then
|
161 |
|
|
begin
|
162 |
|
|
fprintf fmt "extern %a;@.@."
|
163 |
|
|
print_stateless_prototype
|
164 |
|
|
(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs)
|
165 |
|
|
end
|
166 |
|
|
else
|
167 |
|
|
begin
|
168 |
|
|
(* Static allocation *)
|
169 |
|
|
if !Options.static_mem
|
170 |
|
|
then
|
171 |
|
|
begin
|
172 |
|
|
let inst = mk_instance m in
|
173 |
|
|
let attr = mk_attribute m in
|
174 |
|
|
fprintf fmt "%a@.%a@.%a@."
|
175 |
|
|
print_static_declare_macro (m, attr, inst)
|
176 |
|
|
print_static_link_macro (m, attr, inst)
|
177 |
|
|
print_static_alloc_macro (m, attr, inst)
|
178 |
|
|
end
|
179 |
|
|
else
|
180 |
|
|
begin
|
181 |
|
|
(* Dynamic allocation *)
|
182 |
|
|
fprintf fmt "extern %a;@.@."
|
183 |
|
|
print_alloc_prototype (m.mname.node_id, m.mstatic)
|
184 |
|
|
end;
|
185 |
|
|
let self = mk_self m in
|
186 |
|
|
fprintf fmt "extern %a;@.@."
|
187 |
|
|
(print_reset_prototype self) (m.mname.node_id, m.mstatic);
|
188 |
cd670fe1
|
ploc
|
|
189 |
04a63d25
|
xthirioux
|
fprintf fmt "extern %a;@.@."
|
190 |
|
|
(print_step_prototype self)
|
191 |
|
|
(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs);
|
192 |
|
|
|
193 |
|
|
if !Options.mpfr then
|
194 |
|
|
begin
|
195 |
|
|
fprintf fmt "extern %a;@.@."
|
196 |
|
|
(print_init_prototype self) (m.mname.node_id, m.mstatic);
|
197 |
|
|
|
198 |
|
|
fprintf fmt "extern %a;@.@."
|
199 |
|
|
(print_clear_prototype self) (m.mname.node_id, m.mstatic);
|
200 |
|
|
end
|
201 |
|
|
end
|
202 |
|
|
end
|
203 |
cd670fe1
|
ploc
|
|
204 |
ef34b4ae
|
xthirioux
|
let print_machine_alloc_decl fmt m =
|
205 |
|
|
Mod.print_machine_decl_prefix fmt m;
|
206 |
|
|
if fst (get_stateless_status m) then
|
207 |
|
|
begin
|
208 |
|
|
end
|
209 |
|
|
else
|
210 |
|
|
begin
|
211 |
|
|
if !Options.static_mem
|
212 |
|
|
then
|
213 |
|
|
begin
|
214 |
|
|
(* Static allocation *)
|
215 |
ec433d69
|
xthirioux
|
let inst = mk_instance m in
|
216 |
|
|
let attr = mk_attribute m in
|
217 |
ef34b4ae
|
xthirioux
|
fprintf fmt "%a@.%a@.%a@."
|
218 |
ec433d69
|
xthirioux
|
print_static_declare_macro (m, attr, inst)
|
219 |
|
|
print_static_link_macro (m, attr, inst)
|
220 |
|
|
print_static_alloc_macro (m, attr, inst)
|
221 |
ef34b4ae
|
xthirioux
|
end
|
222 |
|
|
else
|
223 |
|
|
begin
|
224 |
|
|
(* Dynamic allocation *)
|
225 |
|
|
fprintf fmt "extern %a;@."
|
226 |
|
|
print_alloc_prototype (m.mname.node_id, m.mstatic)
|
227 |
|
|
end
|
228 |
|
|
end
|
229 |
|
|
|
230 |
|
|
let print_machine_decl_from_header fmt inode =
|
231 |
|
|
(*Mod.print_machine_decl_prefix fmt m;*)
|
232 |
1e48ef45
|
ploc
|
if inode.nodei_prototype = Some "C" then
|
233 |
|
|
if inode.nodei_stateless then
|
234 |
|
|
begin
|
235 |
|
|
fprintf fmt "extern %a;@.@."
|
236 |
|
|
print_stateless_C_prototype
|
237 |
|
|
(inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs)
|
238 |
|
|
end
|
239 |
04a63d25
|
xthirioux
|
else (Format.eprintf "internal error: print_machine_decl_from_header"; assert false)
|
240 |
ef34b4ae
|
xthirioux
|
else
|
241 |
1e48ef45
|
ploc
|
if inode.nodei_stateless then
|
242 |
ef34b4ae
|
xthirioux
|
begin
|
243 |
|
|
fprintf fmt "extern %a;@.@."
|
244 |
1e48ef45
|
ploc
|
print_stateless_prototype
|
245 |
ef34b4ae
|
xthirioux
|
(inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs)
|
246 |
|
|
end
|
247 |
1e48ef45
|
ploc
|
else
|
248 |
|
|
begin
|
249 |
|
|
let static_inputs = List.filter (fun v -> v.var_dec_const) inode.nodei_inputs in
|
250 |
|
|
let used name =
|
251 |
|
|
(List.exists (fun v -> v.var_id = name) inode.nodei_inputs)
|
252 |
|
|
|| (List.exists (fun v -> v.var_id = name) inode.nodei_outputs) in
|
253 |
|
|
let self = mk_new_name used "self" in
|
254 |
|
|
fprintf fmt "extern %a;@.@."
|
255 |
|
|
(print_reset_prototype self) (inode.nodei_id, static_inputs);
|
256 |
04a63d25
|
xthirioux
|
|
257 |
|
|
fprintf fmt "extern %a;@.@."
|
258 |
|
|
(print_init_prototype self) (inode.nodei_id, static_inputs);
|
259 |
|
|
|
260 |
|
|
fprintf fmt "extern %a;@.@."
|
261 |
|
|
(print_clear_prototype self) (inode.nodei_id, static_inputs);
|
262 |
|
|
|
263 |
1e48ef45
|
ploc
|
fprintf fmt "extern %a;@.@."
|
264 |
|
|
(print_step_prototype self)
|
265 |
|
|
(inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs)
|
266 |
|
|
end
|
267 |
ef34b4ae
|
xthirioux
|
|
268 |
cd670fe1
|
ploc
|
let print_const_decl fmt cdecl =
|
269 |
04a63d25
|
xthirioux
|
if !Options.mpfr && Types.is_real_type (Types.array_base_type cdecl.const_type)
|
270 |
|
|
then
|
271 |
|
|
fprintf fmt "extern %a;@."
|
272 |
|
|
(pp_c_type cdecl.const_id) (Types.dynamic_type cdecl.const_type)
|
273 |
|
|
else
|
274 |
|
|
fprintf fmt "extern %a;@."
|
275 |
|
|
(pp_c_type cdecl.const_id) cdecl.const_type
|
276 |
cd670fe1
|
ploc
|
|
277 |
|
|
let rec pp_c_struct_type_field filename cpt fmt (label, tdesc) =
|
278 |
|
|
fprintf fmt "%a;" (pp_c_type_decl filename cpt label) tdesc
|
279 |
|
|
and pp_c_type_decl filename cpt var fmt tdecl =
|
280 |
|
|
match tdecl with
|
281 |
|
|
| Tydec_any -> assert false
|
282 |
|
|
| Tydec_int -> fprintf fmt "int %s" var
|
283 |
04a63d25
|
xthirioux
|
| Tydec_real when !Options.mpfr
|
284 |
|
|
-> fprintf fmt "%s %s" Mpfr.mpfr_t var
|
285 |
cd670fe1
|
ploc
|
| Tydec_real -> fprintf fmt "double %s" var
|
286 |
04a63d25
|
xthirioux
|
(* | Tydec_float -> fprintf fmt "float %s" var *)
|
287 |
cd670fe1
|
ploc
|
| Tydec_bool -> fprintf fmt "_Bool %s" var
|
288 |
|
|
| Tydec_clock ty -> pp_c_type_decl filename cpt var fmt ty
|
289 |
|
|
| Tydec_const c -> fprintf fmt "%s %s" c var
|
290 |
|
|
| Tydec_array (d, ty) -> fprintf fmt "%a[%a]" (pp_c_type_decl filename cpt var) ty pp_c_dimension d
|
291 |
|
|
| Tydec_enum tl ->
|
292 |
|
|
begin
|
293 |
|
|
incr cpt;
|
294 |
|
|
fprintf fmt "enum _enum_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:", " pp_print_string) tl var
|
295 |
|
|
end
|
296 |
|
|
| Tydec_struct fl ->
|
297 |
|
|
begin
|
298 |
|
|
incr cpt;
|
299 |
|
|
fprintf fmt "struct _struct_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:" " (pp_c_struct_type_field filename cpt)) fl var
|
300 |
|
|
end
|
301 |
|
|
|
302 |
|
|
let print_type_definitions fmt filename =
|
303 |
|
|
let cpt_type = ref 0 in
|
304 |
ef34b4ae
|
xthirioux
|
Hashtbl.iter (fun typ decl ->
|
305 |
|
|
match typ with
|
306 |
|
|
| Tydec_const var ->
|
307 |
|
|
(match decl.top_decl_desc with
|
308 |
|
|
| TypeDef tdef ->
|
309 |
|
|
fprintf fmt "typedef %a;@.@."
|
310 |
|
|
(pp_c_type_decl filename cpt_type var) tdef.tydef_desc
|
311 |
|
|
| _ -> assert false)
|
312 |
|
|
| _ -> ()) type_table
|
313 |
|
|
|
314 |
|
|
let reset_type_definitions, print_type_definition_from_header =
|
315 |
|
|
let cpt_type =ref 0 in
|
316 |
|
|
((fun () -> cpt_type := 0),
|
317 |
|
|
(fun fmt typ filename ->
|
318 |
|
|
fprintf fmt "typedef %a;@.@."
|
319 |
|
|
(pp_c_type_decl filename cpt_type typ.tydef_id) typ.tydef_desc))
|
320 |
cd670fe1
|
ploc
|
|
321 |
|
|
(********************************************************************************************)
|
322 |
|
|
(* MAIN Header Printing functions *)
|
323 |
|
|
(********************************************************************************************)
|
324 |
ef34b4ae
|
xthirioux
|
let print_header header_fmt basename prog machines dependencies =
|
325 |
cd670fe1
|
ploc
|
(* Include once: start *)
|
326 |
04a63d25
|
xthirioux
|
let baseNAME = file_to_module_name basename in
|
327 |
ef34b4ae
|
xthirioux
|
begin
|
328 |
04a63d25
|
xthirioux
|
(* Print the version number and the supported C standard (C90 or C99) *)
|
329 |
ef34b4ae
|
xthirioux
|
print_version header_fmt;
|
330 |
|
|
fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME;
|
331 |
|
|
pp_print_newline header_fmt ();
|
332 |
|
|
fprintf header_fmt "/* Imports standard library */@.";
|
333 |
|
|
(* imports standard library definitions (arrow) *)
|
334 |
|
|
print_import_standard header_fmt;
|
335 |
|
|
pp_print_newline header_fmt ();
|
336 |
|
|
(* imports dependencies *)
|
337 |
04a63d25
|
xthirioux
|
fprintf header_fmt "/* Import dependencies */@.";
|
338 |
ef34b4ae
|
xthirioux
|
fprintf header_fmt "@[<v>";
|
339 |
|
|
List.iter (print_import_prototype header_fmt) dependencies;
|
340 |
|
|
fprintf header_fmt "@]@.";
|
341 |
|
|
fprintf header_fmt "/* Types definitions */@.";
|
342 |
|
|
(* Print the type definitions from the type table *)
|
343 |
|
|
print_type_definitions header_fmt basename;
|
344 |
|
|
pp_print_newline header_fmt ();
|
345 |
|
|
(* Print the global constant declarations. *)
|
346 |
|
|
fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@.";
|
347 |
|
|
List.iter (fun c -> print_const_decl header_fmt (const_of_top c)) (get_consts prog);
|
348 |
|
|
pp_print_newline header_fmt ();
|
349 |
04a63d25
|
xthirioux
|
if !Options.mpfr then
|
350 |
|
|
begin
|
351 |
|
|
fprintf header_fmt "/* Global initialization declaration */@.";
|
352 |
|
|
fprintf header_fmt "extern %a;@.@."
|
353 |
|
|
print_global_init_prototype baseNAME;
|
354 |
|
|
|
355 |
|
|
fprintf header_fmt "/* Global clear declaration */@.";
|
356 |
|
|
fprintf header_fmt "extern %a;@.@."
|
357 |
|
|
print_global_clear_prototype baseNAME;
|
358 |
|
|
end;
|
359 |
ef34b4ae
|
xthirioux
|
(* Print the struct declarations of all machines. *)
|
360 |
04a63d25
|
xthirioux
|
fprintf header_fmt "/* Structs declarations */@.";
|
361 |
ef34b4ae
|
xthirioux
|
List.iter (print_machine_struct header_fmt) machines;
|
362 |
|
|
pp_print_newline header_fmt ();
|
363 |
|
|
(* Print the prototypes of all machines *)
|
364 |
|
|
fprintf header_fmt "/* Nodes declarations */@.";
|
365 |
|
|
List.iter (print_machine_decl header_fmt) machines;
|
366 |
|
|
pp_print_newline header_fmt ();
|
367 |
|
|
(* Include once: end *)
|
368 |
|
|
fprintf header_fmt "#endif@.";
|
369 |
|
|
pp_print_newline header_fmt ()
|
370 |
|
|
end
|
371 |
|
|
|
372 |
|
|
let print_alloc_header header_fmt basename prog machines dependencies =
|
373 |
|
|
(* Include once: start *)
|
374 |
04a63d25
|
xthirioux
|
let baseNAME = file_to_module_name basename in
|
375 |
ef34b4ae
|
xthirioux
|
begin
|
376 |
|
|
(* Print the svn version number and the supported C standard (C90 or C99) *)
|
377 |
|
|
print_version header_fmt;
|
378 |
|
|
fprintf header_fmt "#ifndef _%s_alloc@.#define _%s_alloc@." baseNAME baseNAME;
|
379 |
|
|
pp_print_newline header_fmt ();
|
380 |
|
|
(* Import the header *)
|
381 |
|
|
fprintf header_fmt "/* Import header from %s */@." basename;
|
382 |
|
|
fprintf header_fmt "@[<v>";
|
383 |
58a463e7
|
ploc
|
print_import_prototype header_fmt (Dep (true, basename, [], true (* assuming it is staful *) ));
|
384 |
ef34b4ae
|
xthirioux
|
fprintf header_fmt "@]@.";
|
385 |
|
|
fprintf header_fmt "/* Import dependencies */@.";
|
386 |
|
|
fprintf header_fmt "@[<v>";
|
387 |
|
|
List.iter (print_import_alloc_prototype header_fmt) dependencies;
|
388 |
|
|
fprintf header_fmt "@]@.";
|
389 |
|
|
(* Print the struct definitions of all machines. *)
|
390 |
|
|
fprintf header_fmt "/* Struct definitions */@.";
|
391 |
|
|
List.iter (print_machine_struct header_fmt) machines;
|
392 |
|
|
pp_print_newline header_fmt ();
|
393 |
|
|
(* Print the prototypes of all machines *)
|
394 |
|
|
fprintf header_fmt "/* Node allocation function/macro prototypes */@.";
|
395 |
|
|
List.iter (print_machine_alloc_decl header_fmt) machines;
|
396 |
|
|
pp_print_newline header_fmt ();
|
397 |
|
|
(* Include once: end *)
|
398 |
|
|
fprintf header_fmt "#endif@.";
|
399 |
|
|
pp_print_newline header_fmt ()
|
400 |
|
|
end
|
401 |
cd670fe1
|
ploc
|
|
402 |
1e48ef45
|
ploc
|
(* Function called when compiling a lusi file and generating the associated C
|
403 |
|
|
header. *)
|
404 |
ef34b4ae
|
xthirioux
|
let print_header_from_header header_fmt basename header =
|
405 |
|
|
(* Include once: start *)
|
406 |
04a63d25
|
xthirioux
|
let baseNAME = file_to_module_name basename in
|
407 |
ef34b4ae
|
xthirioux
|
let types = get_typedefs header in
|
408 |
|
|
let consts = get_consts header in
|
409 |
|
|
let nodes = get_imported_nodes header in
|
410 |
|
|
let dependencies = get_dependencies header in
|
411 |
|
|
begin
|
412 |
04a63d25
|
xthirioux
|
(* Print the version number and the supported C standard (C90 or C99) *)
|
413 |
ef34b4ae
|
xthirioux
|
print_version header_fmt;
|
414 |
|
|
fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME;
|
415 |
|
|
pp_print_newline header_fmt ();
|
416 |
|
|
fprintf header_fmt "/* Imports standard library */@.";
|
417 |
|
|
(* imports standard library definitions (arrow) *)
|
418 |
|
|
print_import_standard header_fmt;
|
419 |
|
|
pp_print_newline header_fmt ();
|
420 |
|
|
(* imports dependencies *)
|
421 |
|
|
fprintf header_fmt "/* Import dependencies */@.";
|
422 |
|
|
fprintf header_fmt "@[<v>";
|
423 |
|
|
List.iter
|
424 |
58a463e7
|
ploc
|
(fun dep ->
|
425 |
|
|
let (local, s) = dependency_of_top dep in
|
426 |
|
|
print_import_prototype header_fmt (Dep (local, s, [], true (* assuming it is stateful *))))
|
427 |
ef34b4ae
|
xthirioux
|
dependencies;
|
428 |
|
|
fprintf header_fmt "@]@.";
|
429 |
|
|
fprintf header_fmt "/* Types definitions */@.";
|
430 |
|
|
(* Print the type definitions from the type table *)
|
431 |
|
|
reset_type_definitions ();
|
432 |
|
|
List.iter (fun typ -> print_type_definition_from_header header_fmt (typedef_of_top typ) basename) types;
|
433 |
|
|
pp_print_newline header_fmt ();
|
434 |
|
|
(* Print the global constant declarations. *)
|
435 |
|
|
fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@.";
|
436 |
|
|
List.iter (fun c -> print_const_decl header_fmt (const_of_top c)) consts;
|
437 |
|
|
pp_print_newline header_fmt ();
|
438 |
04a63d25
|
xthirioux
|
if !Options.mpfr then
|
439 |
|
|
begin
|
440 |
|
|
fprintf header_fmt "/* Global initialization declaration */@.";
|
441 |
|
|
fprintf header_fmt "extern %a;@.@."
|
442 |
|
|
print_global_init_prototype baseNAME;
|
443 |
|
|
|
444 |
|
|
fprintf header_fmt "/* Global clear declaration */@.";
|
445 |
|
|
fprintf header_fmt "extern %a;@.@."
|
446 |
|
|
print_global_clear_prototype baseNAME;
|
447 |
|
|
end;
|
448 |
ef34b4ae
|
xthirioux
|
(* Print the struct declarations of all machines. *)
|
449 |
04a63d25
|
xthirioux
|
fprintf header_fmt "/* Structs declarations */@.";
|
450 |
ef34b4ae
|
xthirioux
|
List.iter (fun node -> print_machine_struct_from_header header_fmt (imported_node_of_top node)) nodes;
|
451 |
|
|
pp_print_newline header_fmt ();
|
452 |
|
|
(* Print the prototypes of all machines *)
|
453 |
|
|
fprintf header_fmt "/* Nodes declarations */@.";
|
454 |
|
|
List.iter (fun node -> print_machine_decl_from_header header_fmt (imported_node_of_top node)) nodes;
|
455 |
|
|
pp_print_newline header_fmt ();
|
456 |
|
|
(* Include once: end *)
|
457 |
|
|
fprintf header_fmt "#endif@.";
|
458 |
|
|
pp_print_newline header_fmt ()
|
459 |
|
|
end
|
460 |
|
|
|
461 |
|
|
end
|
462 |
cd670fe1
|
ploc
|
(* Local Variables: *)
|
463 |
|
|
(* compile-command:"make -C ../../.." *)
|
464 |
|
|
(* End: *)
|