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