Revision a7062da6
Added by LĂ©lio Brun over 3 years ago
src/backends/C/c_backend_src.ml | ||
---|---|---|
9 | 9 |
(* *) |
10 | 10 |
(********************************************************************) |
11 | 11 |
|
12 |
open Utils.Format |
|
12 |
open Utils |
|
13 |
open Format |
|
13 | 14 |
open Lustre_types |
14 | 15 |
open Machine_code_types |
15 | 16 |
open Corelang |
16 | 17 |
open Machine_code_common |
17 | 18 |
open C_backend_common |
18 | 19 |
|
20 |
module Mpfr = Lustrec_mpfr |
|
21 |
|
|
19 | 22 |
module type MODIFIERS_SRC = sig |
20 | 23 |
module GhostProto : MODIFIERS_GHOST_PROTO |
21 | 24 |
|
... | ... | |
129 | 132 |
(if is_arrow_reset then fun fmt -> fprintf fmt "%s_reset" |
130 | 133 |
else pp_machine_name) |
131 | 134 |
name |
132 |
(pp_comma_list ~pp_eol:pp_print_comma Dimension.pp_dimension)
|
|
135 |
(pp_comma_list ~pp_eol:pp_print_comma Dimension.pp) |
|
133 | 136 |
static self |
134 | 137 |
(pp_print_option (fun fmt -> fprintf fmt "->%s")) |
135 | 138 |
inst |
... | ... | |
328 | 331 |
|
329 | 332 |
let print_alloc_instance fmt (i, (m, static)) = |
330 | 333 |
fprintf fmt "_alloc->%s = %a %a;" i pp_machine_alloc_name (node_name m) |
331 |
(pp_print_parenthesized Dimension.pp_dimension)
|
|
334 |
(pp_print_parenthesized Dimension.pp) |
|
332 | 335 |
static |
333 | 336 |
|
334 | 337 |
let print_dealloc_instance fmt (i, (m, _)) = |
... | ... | |
350 | 353 |
let base_type = Types.array_base_type vdecl.var_type in |
351 | 354 |
let size_types = Types.array_type_multi_dimension vdecl.var_type in |
352 | 355 |
let size_type = |
353 |
Dimension.multi_dimension_product vdecl.var_loc size_types
|
|
356 |
Dimension.multi_product vdecl.var_loc size_types |
|
354 | 357 |
in |
355 | 358 |
fprintf fmt |
356 | 359 |
"_alloc->_reg.%s = (%a*) malloc((%a)*sizeof(%a));@,assert(_alloc->%s);" |
357 |
vdecl.var_id (pp_c_type "") base_type Dimension.pp_dimension size_type
|
|
360 |
vdecl.var_id (pp_c_type "") base_type Dimension.pp size_type |
|
358 | 361 |
(pp_c_type "") base_type vdecl.var_id |
359 | 362 |
|
360 | 363 |
let print_dealloc_array fmt vdecl = |
... | ... | |
418 | 421 |
* (Utils.pp_newline_if_non_empty m.minit) *) |
419 | 422 |
|
420 | 423 |
let pp_c_check m self fmt (loc, check) = |
421 |
fprintf fmt "@[<v>%a@,assert (%a);@]" Location.pp_c_loc loc
|
|
424 |
fprintf fmt "@[<v>%a@,assert (%a);@]" Location.pp_c loc |
|
422 | 425 |
(pp_c_val m self (pp_c_var_read m)) |
423 | 426 |
check |
424 | 427 |
|
... | ... | |
458 | 461 |
let node_of_machine m = |
459 | 462 |
{ |
460 | 463 |
top_decl_desc = Node m.mname; |
461 |
top_decl_loc = Location.dummy_loc;
|
|
464 |
top_decl_loc = Location.dummy; |
|
462 | 465 |
top_decl_owner = ""; |
463 | 466 |
top_decl_itf = false; |
464 | 467 |
} |
... | ... | |
624 | 627 |
let rec aux indices value fmt typ = |
625 | 628 |
if Types.is_array_type typ then |
626 | 629 |
let dim = Types.array_type_dimension typ in |
627 |
let szl = Utils.enumerate (Dimension.size_const_dimension dim) in
|
|
630 |
let szl = Utils.enumerate (Dimension.size_const dim) in |
|
628 | 631 |
let typ' = Types.array_element_type typ in |
629 | 632 |
let value = |
630 | 633 |
match value with Const_array ca -> List.nth ca | _ -> assert false |
... | ... | |
688 | 691 |
}@,\ |
689 | 692 |
return;@]@,\ |
690 | 693 |
}" |
691 |
print_global_init_prototype baseNAME
|
|
694 |
pp_global_init_prototype baseNAME
|
|
692 | 695 |
(pp_c_basic_type_desc Type_predef.type_bool) |
693 | 696 |
(* constants *) |
694 | 697 |
(pp_print_list ~pp_prologue:pp_print_cut |
... | ... | |
709 | 712 |
}@,\ |
710 | 713 |
return;@]@,\ |
711 | 714 |
}" |
712 |
print_global_clear_prototype baseNAME
|
|
715 |
pp_global_clear_prototype baseNAME
|
|
713 | 716 |
(pp_c_basic_type_desc Type_predef.type_bool) |
714 | 717 |
(* constants *) |
715 | 718 |
(pp_print_list ~pp_prologue:pp_print_cut |
... | ... | |
723 | 726 |
if not !Options.static_mem then |
724 | 727 |
(* Alloc functions, only if non static mode *) |
725 | 728 |
fprintf fmt "@[<v 2>%a {@,%a%a@]@,}@,@[<v 2>%a {@,%a%a@]@,@," |
726 |
print_alloc_prototype
|
|
729 |
pp_alloc_prototype
|
|
727 | 730 |
(m.mname.node_id, m.mstatic) |
728 |
print_alloc_const m print_alloc_code m print_dealloc_prototype
|
|
731 |
print_alloc_const m print_alloc_code m pp_dealloc_prototype
|
|
729 | 732 |
m.mname.node_id print_alloc_const m print_dealloc_code m |
730 | 733 |
|
731 | 734 |
let print_mpfr_code self fmt m = |
... | ... | |
775 | 778 |
|
776 | 779 |
let print_extern_alloc_prototype fmt ind = |
777 | 780 |
let static = List.filter (fun v -> v.var_dec_const) ind.nodei_inputs in |
778 |
fprintf fmt "extern %a;@,extern %a;" print_alloc_prototype
|
|
779 |
(ind.nodei_id, static) print_dealloc_prototype ind.nodei_id
|
|
781 |
fprintf fmt "extern %a;@,extern %a;" pp_alloc_prototype
|
|
782 |
(ind.nodei_id, static) pp_dealloc_prototype ind.nodei_id
|
|
780 | 783 |
|
781 | 784 |
let print_lib_c source_fmt basename prog machines dependencies = |
782 | 785 |
fprintf source_fmt "@[<v>%a%a@,@,%a@,%a%a%a%a%a%a%a@]@." |
783 |
print_import_standard () print_import_prototype
|
|
786 |
print_import_standard () pp_import_prototype
|
|
784 | 787 |
{ |
785 | 788 |
local = true; |
786 | 789 |
name = basename; |
... | ... | |
793 | 796 |
(* Print dependencies *) |
794 | 797 |
(pp_print_list ~pp_open_box:pp_open_vbox0 |
795 | 798 |
~pp_prologue:(pp_print_endcut "/* Import dependencies */") |
796 |
print_import_prototype ~pp_epilogue:pp_print_cutcut)
|
|
799 |
pp_import_prototype ~pp_epilogue:pp_print_cutcut)
|
|
797 | 800 |
dependencies |
798 | 801 |
(* Print consts *) |
799 | 802 |
(pp_print_list ~pp_open_box:pp_open_vbox0 |
... | ... | |
836 | 839 |
~pp_prologue: |
837 | 840 |
(pp_print_endcut "/* Node allocation function prototypes */") |
838 | 841 |
~pp_sep:pp_print_cutcut (fun fmt m -> |
839 |
fprintf fmt "%a;@,%a;" print_alloc_prototype
|
|
842 |
fprintf fmt "%a;@,%a;" pp_alloc_prototype
|
|
840 | 843 |
(m.mname.node_id, m.mstatic) |
841 |
print_dealloc_prototype m.mname.node_id))
|
|
844 |
pp_dealloc_prototype m.mname.node_id))
|
|
842 | 845 |
machines |
843 | 846 |
else pp_print_nothing) |
844 | 847 |
() |
845 | 848 |
(* Print the struct definitions of all machines. *) |
846 | 849 |
(pp_print_list ~pp_open_box:pp_open_vbox0 |
847 | 850 |
~pp_prologue:(pp_print_endcut "/* Struct definitions */") |
848 |
~pp_sep:pp_print_cutcut print_machine_struct
|
|
851 |
~pp_sep:pp_print_cutcut pp_machine_struct
|
|
849 | 852 |
~pp_epilogue:pp_print_cutcut) |
850 | 853 |
machines (* Print the spec predicates *) Mod.pp_predicates machines |
851 | 854 |
(* Print nodes one by one (in the previous order) *) |
Also available in: Unified diff
another step towards refactoring