Revision a7062da6
Added by LĂ©lio Brun over 3 years ago
src/backends/C/c_backend_common.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 Corelang |
15 | 16 |
open Machine_code_types |
... | ... | |
88 | 89 |
{ |
89 | 90 |
var_id = id; |
90 | 91 |
var_orig = false; |
91 |
var_dec_type = mktyp Location.dummy_loc Tydec_any;
|
|
92 |
var_dec_clock = mkclock Location.dummy_loc Ckdec_any;
|
|
92 |
var_dec_type = mktyp Location.dummy Tydec_any; |
|
93 |
var_dec_clock = mkclock Location.dummy Ckdec_any; |
|
93 | 94 |
var_dec_const = false; |
94 | 95 |
var_dec_value = None; |
95 | 96 |
var_parent_nodeid = None; |
... | ... | |
237 | 238 |
(* Not a basic C type. Do not handle arrays or pointers *) |
238 | 239 |
|
239 | 240 |
let pp_basic_c_type ?(pp_c_basic_type_desc = pp_c_basic_type_desc) |
240 |
?(var_opt = None) fmt t =
|
|
241 |
?var_opt fmt t =
|
|
241 | 242 |
match var_opt with |
242 | 243 |
| Some v when Machine_types.is_exportable v -> |
243 | 244 |
Machine_types.pp_c_var_type fmt v |
... | ... | |
248 | 249 |
let rec aux t pp_suffix = |
249 | 250 |
if is_basic_c_type t then |
250 | 251 |
fprintf fmt "%a %s%a" |
251 |
(pp_basic_c_type ?pp_c_basic_type_desc ~var_opt)
|
|
252 |
(pp_basic_c_type ?pp_c_basic_type_desc ?var_opt)
|
|
252 | 253 |
t var_id pp_suffix () |
253 | 254 |
else |
254 | 255 |
let open Types in |
... | ... | |
512 | 513 |
(Access (v, Cst (Const_int !r))) q | _ , LVar i :: q -> value_offsets (Access |
513 | 514 |
(v, Var i)) q *) |
514 | 515 |
(* Computes the list of nested loop variables together with their dimension |
515 |
bounds. - LInt r stands for loop expansion (no loop variable, but int loop |
|
516 |
index) - LVar v stands for loop variable v *) |
|
516 |
bounds. |
|
517 |
* - LInt r stands for loop expansion (no loop variable, but int loop |
|
518 |
index) |
|
519 |
* - LVar v stands for loop variable v *) |
|
517 | 520 |
let rec mk_loop_variables m ty depth = |
518 | 521 |
match (Types.repr ty).Types.tdesc, depth with |
519 | 522 |
| Types.Tarray (d, ty'), 0 -> |
... | ... | |
592 | 595 |
in |
593 | 596 |
match loop_vars, value.value_desc with |
594 | 597 |
| (x, LAcc i) :: q, _ when is_const_index i -> |
595 |
let r = ref (Dimension.size_const_dimension (dimension_of_value i)) in
|
|
598 |
let r = ref (Dimension.size_const (dimension_of_value i)) in |
|
596 | 599 |
pp_value_suffix ~indirect m self var_type ((x, LInt r) :: q) pp_var fmt |
597 | 600 |
value |
598 | 601 |
| (_, LInt r) :: q, Cst (Const_array cl) -> |
... | ... | |
664 | 667 |
* pp_c_decl_struct_var |
665 | 668 |
* fmt m.mmemory *) |
666 | 669 |
|
667 |
let print_machine_struct ?(ghost = false) fmt m =
|
|
670 |
let pp_machine_struct ?(ghost = false) fmt m =
|
|
668 | 671 |
if not (fst (Machine_code_common.get_stateless_status m)) then |
669 | 672 |
(* Define struct *) |
670 | 673 |
fprintf fmt "@[<v 2>%a {@,_Bool _reset;%a%a@]@,};" |
... | ... | |
693 | 696 |
(* Prototype Printing functions *) |
694 | 697 |
(********************************************************************************************) |
695 | 698 |
|
696 |
let print_global_init_prototype fmt baseNAME =
|
|
699 |
let pp_global_init_prototype fmt baseNAME =
|
|
697 | 700 |
fprintf fmt "void %a ()" pp_global_init_name baseNAME |
698 | 701 |
|
699 |
let print_global_clear_prototype fmt baseNAME =
|
|
702 |
let pp_global_clear_prototype fmt baseNAME =
|
|
700 | 703 |
fprintf fmt "void %a ()" pp_global_clear_name baseNAME |
701 | 704 |
|
702 |
let print_alloc_prototype fmt (name, static) =
|
|
705 |
let pp_alloc_prototype fmt (name, static) =
|
|
703 | 706 |
fprintf fmt "%a * %a %a" |
704 | 707 |
(pp_machine_memtype_name ~ghost:false) |
705 | 708 |
name pp_machine_alloc_name name |
706 | 709 |
(pp_print_parenthesized pp_c_decl_input_var) |
707 | 710 |
static |
708 | 711 |
|
709 |
let print_dealloc_prototype fmt name =
|
|
712 |
let pp_dealloc_prototype fmt name =
|
|
710 | 713 |
fprintf fmt "void %a (%a * _alloc)" pp_machine_dealloc_name name |
711 | 714 |
(pp_machine_memtype_name ~ghost:false) |
712 | 715 |
name |
... | ... | |
783 | 786 |
outputs |
784 | 787 |
end |
785 | 788 |
|
786 |
let print_import_prototype fmt dep = fprintf fmt "#include \"%s.h\"" dep.name
|
|
789 |
let pp_import_prototype fmt dep = fprintf fmt "#include \"%s.h\"" dep.name
|
|
787 | 790 |
|
788 |
let print_import_alloc_prototype fmt dep =
|
|
791 |
let pp_import_alloc_prototype fmt dep =
|
|
789 | 792 |
if dep.is_stateful then fprintf fmt "#include \"%s_alloc.h\"" dep.name |
790 | 793 |
|
791 | 794 |
let pp_c_var m self pp_var fmt var = |
... | ... | |
858 | 861 |
file_suffix typ arg file_suffix |
859 | 862 |
|
860 | 863 |
let pp_put_var fmt file_suffix name var_type var_id = |
861 |
let pp_file = pp_print_file ("out" ^ file_suffix) in
|
|
864 |
let pp_file = pp_file ("out" ^ file_suffix) in |
|
862 | 865 |
let unclocked_t = Types.unclock_type var_type in |
863 | 866 |
fprintf fmt "@[<v>%a@]" |
864 | 867 |
(fun fmt () -> |
... | ... | |
937 | 940 |
| (d, LInt r) :: q -> |
938 | 941 |
(*eprintf "pp_aux %a %d@." Dimension.pp_dimension d (!r);*) |
939 | 942 |
let typ' = Types.array_element_type typ in |
940 |
let szl = Utils.enumerate (Dimension.size_const_dimension d) in
|
|
943 |
let szl = Utils.enumerate (Dimension.size_const d) in |
|
941 | 944 |
fprintf fmt "@[<v 2>{@,%a@]@,}" |
942 | 945 |
(pp_print_list (fun fmt i -> |
943 | 946 |
r := i; |
Also available in: Unified diff
another step towards refactoring