Revision 3b2bd83d
Added by Teme Kahsai about 8 years ago
src/backends/C/c_backend_header.ml | ||
---|---|---|
34 | 34 |
struct |
35 | 35 |
|
36 | 36 |
let print_import_standard fmt = |
37 |
fprintf fmt "#include \"%s/arrow.h\"@.@." Version.include_path |
|
37 |
begin |
|
38 |
if !Options.mpfr then |
|
39 |
begin |
|
40 |
fprintf fmt "#include <mpfr.h>@." |
|
41 |
end; |
|
42 |
fprintf fmt "#include \"%s/arrow.h\"@.@." Version.include_path |
|
43 |
end |
|
38 | 44 |
|
39 | 45 |
let rec print_static_val pp_var fmt v = |
40 |
match v with |
|
46 |
match v.value_desc with
|
|
41 | 47 |
| Cst c -> pp_c_const fmt c |
42 | 48 |
| LocalVar v -> pp_var fmt v |
43 | 49 |
| Fun (n, vl) -> Basic_library.pp_c n (print_static_val pp_var) fmt vl |
... | ... | |
145 | 151 |
inst |
146 | 152 |
|
147 | 153 |
let print_machine_decl fmt m = |
148 |
Mod.print_machine_decl_prefix fmt m; |
|
149 |
if fst (get_stateless_status m) then |
|
150 |
begin |
|
151 |
fprintf fmt "extern %a;@.@." |
|
152 |
print_stateless_prototype |
|
153 |
(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs) |
|
154 |
end |
|
155 |
else |
|
156 |
begin |
|
157 |
(* Static allocation *) |
|
158 |
if !Options.static_mem |
|
159 |
then |
|
160 |
begin |
|
161 |
let inst = mk_instance m in |
|
162 |
let attr = mk_attribute m in |
|
163 |
fprintf fmt "%a@.%a@.%a@." |
|
164 |
print_static_declare_macro (m, attr, inst) |
|
165 |
print_static_link_macro (m, attr, inst) |
|
166 |
print_static_alloc_macro (m, attr, inst) |
|
167 |
end |
|
168 |
else |
|
169 |
begin |
|
170 |
(* Dynamic allocation *) |
|
171 |
fprintf fmt "extern %a;@.@." |
|
172 |
print_alloc_prototype (m.mname.node_id, m.mstatic) |
|
173 |
end; |
|
174 |
let self = mk_self m in |
|
175 |
fprintf fmt "extern %a;@.@." |
|
176 |
(print_reset_prototype self) (m.mname.node_id, m.mstatic); |
|
154 |
begin |
|
155 |
Mod.print_machine_decl_prefix fmt m; |
|
156 |
if fst (get_stateless_status m) then |
|
157 |
begin |
|
158 |
fprintf fmt "extern %a;@.@." |
|
159 |
print_stateless_prototype |
|
160 |
(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs) |
|
161 |
end |
|
162 |
else |
|
163 |
begin |
|
164 |
(* Static allocation *) |
|
165 |
if !Options.static_mem |
|
166 |
then |
|
167 |
begin |
|
168 |
let inst = mk_instance m in |
|
169 |
let attr = mk_attribute m in |
|
170 |
fprintf fmt "%a@.%a@.%a@." |
|
171 |
print_static_declare_macro (m, attr, inst) |
|
172 |
print_static_link_macro (m, attr, inst) |
|
173 |
print_static_alloc_macro (m, attr, inst) |
|
174 |
end |
|
175 |
else |
|
176 |
begin |
|
177 |
(* Dynamic allocation *) |
|
178 |
fprintf fmt "extern %a;@.@." |
|
179 |
print_alloc_prototype (m.mname.node_id, m.mstatic) |
|
180 |
end; |
|
181 |
let self = mk_self m in |
|
182 |
fprintf fmt "extern %a;@.@." |
|
183 |
(print_reset_prototype self) (m.mname.node_id, m.mstatic); |
|
177 | 184 |
|
178 |
fprintf fmt "extern %a;@.@." |
|
179 |
(print_step_prototype self) |
|
180 |
(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs) |
|
181 |
end |
|
185 |
fprintf fmt "extern %a;@.@." |
|
186 |
(print_step_prototype self) |
|
187 |
(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs); |
|
188 |
|
|
189 |
if !Options.mpfr then |
|
190 |
begin |
|
191 |
fprintf fmt "extern %a;@.@." |
|
192 |
(print_init_prototype self) (m.mname.node_id, m.mstatic); |
|
193 |
|
|
194 |
fprintf fmt "extern %a;@.@." |
|
195 |
(print_clear_prototype self) (m.mname.node_id, m.mstatic); |
|
196 |
end |
|
197 |
end |
|
198 |
end |
|
182 | 199 |
|
183 | 200 |
let print_machine_alloc_decl fmt m = |
184 | 201 |
Mod.print_machine_decl_prefix fmt m; |
... | ... | |
215 | 232 |
print_stateless_C_prototype |
216 | 233 |
(inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs) |
217 | 234 |
end |
218 |
else ( |
|
219 |
raise (Invalid_argument ("A node with declared prototype C cannot be stateful, it has to be a function"))) |
|
235 |
else (Format.eprintf "internal error: print_machine_decl_from_header"; assert false) |
|
220 | 236 |
else |
221 | 237 |
if inode.nodei_stateless then |
222 | 238 |
begin |
... | ... | |
233 | 249 |
let self = mk_new_name used "self" in |
234 | 250 |
fprintf fmt "extern %a;@.@." |
235 | 251 |
(print_reset_prototype self) (inode.nodei_id, static_inputs); |
236 |
|
|
252 |
|
|
253 |
fprintf fmt "extern %a;@.@." |
|
254 |
(print_init_prototype self) (inode.nodei_id, static_inputs); |
|
255 |
|
|
256 |
fprintf fmt "extern %a;@.@." |
|
257 |
(print_clear_prototype self) (inode.nodei_id, static_inputs); |
|
258 |
|
|
237 | 259 |
fprintf fmt "extern %a;@.@." |
238 | 260 |
(print_step_prototype self) |
239 | 261 |
(inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs) |
240 | 262 |
end |
241 | 263 |
|
242 | 264 |
let print_const_decl fmt cdecl = |
243 |
fprintf fmt "extern %a;@." |
|
244 |
(pp_c_type cdecl.const_id) cdecl.const_type |
|
265 |
if !Options.mpfr && Types.is_real_type (Types.array_base_type cdecl.const_type) |
|
266 |
then |
|
267 |
fprintf fmt "extern %a;@." |
|
268 |
(pp_c_type cdecl.const_id) (Types.dynamic_type cdecl.const_type) |
|
269 |
else |
|
270 |
fprintf fmt "extern %a;@." |
|
271 |
(pp_c_type cdecl.const_id) cdecl.const_type |
|
245 | 272 |
|
246 | 273 |
let rec pp_c_struct_type_field filename cpt fmt (label, tdesc) = |
247 | 274 |
fprintf fmt "%a;" (pp_c_type_decl filename cpt label) tdesc |
... | ... | |
249 | 276 |
match tdecl with |
250 | 277 |
| Tydec_any -> assert false |
251 | 278 |
| Tydec_int -> fprintf fmt "int %s" var |
279 |
| Tydec_real when !Options.mpfr |
|
280 |
-> fprintf fmt "%s %s" Mpfr.mpfr_t var |
|
252 | 281 |
| Tydec_real -> fprintf fmt "double %s" var |
253 |
| Tydec_float -> fprintf fmt "float %s" var
|
|
282 |
(* | Tydec_float -> fprintf fmt "float %s" var *)
|
|
254 | 283 |
| Tydec_bool -> fprintf fmt "_Bool %s" var |
255 | 284 |
| Tydec_clock ty -> pp_c_type_decl filename cpt var fmt ty |
256 | 285 |
| Tydec_const c -> fprintf fmt "%s %s" c var |
... | ... | |
290 | 319 |
(********************************************************************************************) |
291 | 320 |
let print_header header_fmt basename prog machines dependencies = |
292 | 321 |
(* Include once: start *) |
293 |
let baseNAME = String.uppercase basename in |
|
294 |
let baseNAME = Str.global_replace (Str.regexp "\\.\\|\\ ") "_" baseNAME in |
|
322 |
let baseNAME = file_to_module_name basename in |
|
295 | 323 |
begin |
296 |
(* Print the svn version number and the supported C standard (C90 or C99) *)
|
|
324 |
(* Print the version number and the supported C standard (C90 or C99) *) |
|
297 | 325 |
print_version header_fmt; |
298 | 326 |
fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME; |
299 | 327 |
pp_print_newline header_fmt (); |
... | ... | |
302 | 330 |
print_import_standard header_fmt; |
303 | 331 |
pp_print_newline header_fmt (); |
304 | 332 |
(* imports dependencies *) |
305 |
fprintf header_fmt "/* Import Dependencies */@.";
|
|
333 |
fprintf header_fmt "/* Import dependencies */@.";
|
|
306 | 334 |
fprintf header_fmt "@[<v>"; |
307 | 335 |
List.iter (print_import_prototype header_fmt) dependencies; |
308 | 336 |
fprintf header_fmt "@]@."; |
... | ... | |
314 | 342 |
fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@."; |
315 | 343 |
List.iter (fun c -> print_const_decl header_fmt (const_of_top c)) (get_consts prog); |
316 | 344 |
pp_print_newline header_fmt (); |
345 |
if !Options.mpfr then |
|
346 |
begin |
|
347 |
fprintf header_fmt "/* Global initialization declaration */@."; |
|
348 |
fprintf header_fmt "extern %a;@.@." |
|
349 |
print_global_init_prototype baseNAME; |
|
350 |
|
|
351 |
fprintf header_fmt "/* Global clear declaration */@."; |
|
352 |
fprintf header_fmt "extern %a;@.@." |
|
353 |
print_global_clear_prototype baseNAME; |
|
354 |
end; |
|
317 | 355 |
(* Print the struct declarations of all machines. *) |
318 |
fprintf header_fmt "/* Struct declarations */@."; |
|
356 |
fprintf header_fmt "/* Structs declarations */@.";
|
|
319 | 357 |
List.iter (print_machine_struct header_fmt) machines; |
320 | 358 |
pp_print_newline header_fmt (); |
321 | 359 |
(* Print the prototypes of all machines *) |
... | ... | |
329 | 367 |
|
330 | 368 |
let print_alloc_header header_fmt basename prog machines dependencies = |
331 | 369 |
(* Include once: start *) |
332 |
let baseNAME = String.uppercase basename in |
|
333 |
let baseNAME = Str.global_replace (Str.regexp "\\.\\|\\ ") "_" baseNAME in |
|
370 |
let baseNAME = file_to_module_name basename in |
|
334 | 371 |
begin |
335 | 372 |
(* Print the svn version number and the supported C standard (C90 or C99) *) |
336 | 373 |
print_version header_fmt; |
... | ... | |
362 | 399 |
header. *) |
363 | 400 |
let print_header_from_header header_fmt basename header = |
364 | 401 |
(* Include once: start *) |
365 |
let baseNAME = String.uppercase basename in |
|
366 |
let baseNAME = Str.global_replace (Str.regexp "\\.\\|\\ ") "_" baseNAME in |
|
402 |
let baseNAME = file_to_module_name basename in |
|
367 | 403 |
let types = get_typedefs header in |
368 | 404 |
let consts = get_consts header in |
369 | 405 |
let nodes = get_imported_nodes header in |
370 | 406 |
let dependencies = get_dependencies header in |
371 | 407 |
begin |
372 |
(* Print the svn version number and the supported C standard (C90 or C99) *)
|
|
408 |
(* Print the version number and the supported C standard (C90 or C99) *) |
|
373 | 409 |
print_version header_fmt; |
374 | 410 |
fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME; |
375 | 411 |
pp_print_newline header_fmt (); |
... | ... | |
395 | 431 |
fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@."; |
396 | 432 |
List.iter (fun c -> print_const_decl header_fmt (const_of_top c)) consts; |
397 | 433 |
pp_print_newline header_fmt (); |
434 |
if !Options.mpfr then |
|
435 |
begin |
|
436 |
fprintf header_fmt "/* Global initialization declaration */@."; |
|
437 |
fprintf header_fmt "extern %a;@.@." |
|
438 |
print_global_init_prototype baseNAME; |
|
439 |
|
|
440 |
fprintf header_fmt "/* Global clear declaration */@."; |
|
441 |
fprintf header_fmt "extern %a;@.@." |
|
442 |
print_global_clear_prototype baseNAME; |
|
443 |
end; |
|
398 | 444 |
(* Print the struct declarations of all machines. *) |
399 |
fprintf header_fmt "/* Struct declarations */@."; |
|
445 |
fprintf header_fmt "/* Structs declarations */@.";
|
|
400 | 446 |
List.iter (fun node -> print_machine_struct_from_header header_fmt (imported_node_of_top node)) nodes; |
401 | 447 |
pp_print_newline header_fmt (); |
402 | 448 |
(* Print the prototypes of all machines *) |
Also available in: Unified diff
updating to onera version 30f766a:2016-12-04