Revision 04e26a3f
Added by Xavier Thirioux almost 9 years ago
| src/c_backend.ml | ||
|---|---|---|
| 547 | 547 |
| _ -> () (* We don't do anything here *) |
| 548 | 548 |
*) |
| 549 | 549 |
|
| 550 |
let print_import_standard fmt = |
|
| 551 |
fprintf fmt "#include \"%s/include/lustrec/arrow.h\"@.@." Version.prefix |
|
| 552 |
|
|
| 550 | 553 |
let print_prototype fmt decl = |
| 551 | 554 |
match decl.top_decl_desc with |
| 552 | 555 |
| Open m -> fprintf fmt "#include \"%s.h\"@," m |
| ... | ... | |
| 562 | 565 |
() |
| 563 | 566 |
|
| 564 | 567 |
let print_machine_struct fmt m = |
| 565 |
(* Define struct *) |
|
| 566 |
fprintf fmt "@[%a {@[%a%a%t@]};@]@."
|
|
| 567 |
pp_machine_memtype_name m.mname.node_id |
|
| 568 |
pp_registers_struct m |
|
| 569 |
(Utils.fprintf_list ~sep:"; " pp_c_decl_instance_var) m.minstances |
|
| 570 |
(Utils.pp_final_char_if_non_empty "; " m.minstances) |
|
| 568 |
if m.mname.node_id != arrow_id |
|
| 569 |
then ( |
|
| 570 |
(* We don't print arrow function *) |
|
| 571 |
(* Define struct *) |
|
| 572 |
fprintf fmt "@[%a {@[%a%a%t@]};@]@."
|
|
| 573 |
pp_machine_memtype_name m.mname.node_id |
|
| 574 |
pp_registers_struct m |
|
| 575 |
(Utils.fprintf_list ~sep:"; " pp_c_decl_instance_var) m.minstances |
|
| 576 |
(Utils.pp_final_char_if_non_empty "; " m.minstances) |
|
| 577 |
) |
|
| 571 | 578 |
|
| 572 | 579 |
(* |
| 573 | 580 |
let pp_static_array_instance fmt m (v, m) = |
| ... | ... | |
| 631 | 638 |
pp_machine_static_link_name m.mname.node_id |
| 632 | 639 |
|
| 633 | 640 |
let print_machine_decl fmt m = |
| 634 |
(* Static allocation *) |
|
| 635 |
if !Options.static_mem then ( |
|
| 636 |
fprintf fmt "%a@.%a@.%a@." |
|
| 637 |
print_static_declare_macro m |
|
| 638 |
print_static_link_macro m |
|
| 639 |
print_static_alloc_macro m; |
|
| 640 |
) |
|
| 641 |
else ( |
|
| 641 |
if m.mname.node_id <> arrow_id |
|
| 642 |
then ( |
|
| 643 |
(* We don't print arrow function *) |
|
| 644 |
(* Static allocation *) |
|
| 645 |
if !Options.static_mem |
|
| 646 |
then ( |
|
| 647 |
fprintf fmt "%a@.%a@.%a@." |
|
| 648 |
print_static_declare_macro m |
|
| 649 |
print_static_link_macro m |
|
| 650 |
print_static_alloc_macro m |
|
| 651 |
) |
|
| 652 |
else ( |
|
| 642 | 653 |
(* Dynamic allocation *) |
| 643 |
fprintf fmt "extern %a;@.@." |
|
| 644 |
print_alloc_prototype (m.mname.node_id, m.mstatic); |
|
| 645 |
); |
|
| 646 |
if m.mname.node_id = arrow_id then ( |
|
| 647 |
(* Arrow will be defined by a #define macro because of polymorphism *) |
|
| 648 |
fprintf fmt "#define _arrow_step(x,y,output,self) ((self)->_reg._first?((self)->_reg._first=0,(*output = x)):(*output = y))@.@."; |
|
| 649 |
fprintf fmt "#define _arrow_reset(self) {(self)->_reg._first = 1;}@.@."
|
|
| 650 |
) |
|
| 651 |
else ( |
|
| 654 |
fprintf fmt "extern %a;@.@." |
|
| 655 |
print_alloc_prototype (m.mname.node_id, m.mstatic) |
|
| 656 |
); |
|
| 652 | 657 |
let self = mk_self m in |
| 653 | 658 |
fprintf fmt "extern %a;@.@." |
| 654 | 659 |
(print_reset_prototype self) (m.mname.node_id, m.mstatic); |
| ... | ... | |
| 736 | 741 |
(fun fmt -> fprintf fmt "return;") |
| 737 | 742 |
|
| 738 | 743 |
let print_machine fmt m = |
| 744 |
if m.mname.node_id <> arrow_id |
|
| 745 |
then ( |
|
| 746 |
(* We don't print arrow function *) |
|
| 739 | 747 |
(* Alloc function, only if non static mode *) |
| 740 |
if (not !Options.static_mem) then |
|
| 741 |
( |
|
| 742 |
fprintf fmt "@[<v 2>%a {@,%a@]@,}@.@."
|
|
| 743 |
print_alloc_prototype (m.mname.node_id, m.mstatic) |
|
| 744 |
print_alloc_code m; |
|
| 745 |
); |
|
| 746 |
if m.mname.node_id = arrow_id then () else ( (* We don't print arrow function *) |
|
| 748 |
if (not !Options.static_mem) then |
|
| 749 |
( |
|
| 750 |
fprintf fmt "@[<v 2>%a {@,%a@]@,}@.@."
|
|
| 751 |
print_alloc_prototype (m.mname.node_id, m.mstatic) |
|
| 752 |
print_alloc_code m; |
|
| 753 |
); |
|
| 747 | 754 |
let self = mk_self m in |
| 748 | 755 |
(* Reset function *) |
| 749 | 756 |
fprintf fmt "@[<v 2>%a {@,%a%treturn;@]@,}@.@."
|
| ... | ... | |
| 835 | 842 |
fprintf fmt "@]@ }@." |
| 836 | 843 |
|
| 837 | 844 |
let print_main_header fmt = |
| 838 |
fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"io_frontend.h\"@."
|
|
| 845 |
fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/include/lustrec/io_frontend.h\"@." Version.prefix
|
|
| 839 | 846 |
|
| 840 |
let rec pp_c_type_decl cpt var fmt tdecl = |
|
| 847 |
let rec pp_c_type_decl filename cpt var fmt tdecl =
|
|
| 841 | 848 |
match tdecl with |
| 842 | 849 |
| Tydec_any -> assert false |
| 843 | 850 |
| Tydec_int -> fprintf fmt "int %s" var |
| 844 | 851 |
| Tydec_real -> fprintf fmt "double %s" var |
| 845 | 852 |
| Tydec_float -> fprintf fmt "float %s" var |
| 846 | 853 |
| Tydec_bool -> fprintf fmt "_Bool %s" var |
| 847 |
| Tydec_clock ty -> pp_c_type_decl cpt var fmt ty |
|
| 854 |
| Tydec_clock ty -> pp_c_type_decl filename cpt var fmt ty
|
|
| 848 | 855 |
| Tydec_const c -> fprintf fmt "%s %s" c var |
| 849 |
| Tydec_array (d, ty) -> fprintf fmt "%a[%a]" (pp_c_type_decl cpt var) ty pp_c_dimension d |
|
| 856 |
| Tydec_array (d, ty) -> fprintf fmt "%a[%a]" (pp_c_type_decl filename cpt var) ty pp_c_dimension d
|
|
| 850 | 857 |
| Tydec_enum tl -> |
| 851 | 858 |
begin |
| 852 | 859 |
incr cpt; |
| 853 |
fprintf fmt "enum _enum_%d { %a } %s" !cpt (Utils.fprintf_list ~sep:", " pp_print_string) tl var
|
|
| 860 |
fprintf fmt "enum _enum_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:", " pp_print_string) tl var
|
|
| 854 | 861 |
end |
| 855 | 862 |
|
| 856 |
let print_type_definitions fmt = |
|
| 863 |
let print_type_definitions fmt filename =
|
|
| 857 | 864 |
let cpt_type = ref 0 in |
| 858 | 865 |
Hashtbl.iter (fun typ def -> |
| 859 | 866 |
match typ with |
| 860 | 867 |
| Tydec_const var -> |
| 861 | 868 |
fprintf fmt "typedef %a;@.@." |
| 862 |
(pp_c_type_decl cpt_type var) def |
|
| 869 |
(pp_c_type_decl filename cpt_type var) def
|
|
| 863 | 870 |
| _ -> ()) type_table |
| 864 | 871 |
|
| 865 | 872 |
let print_makefile basename nodename dependencies fmt = |
| ... | ... | |
| 898 | 905 |
print_version header_fmt; |
| 899 | 906 |
fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME; |
| 900 | 907 |
pp_print_newline header_fmt (); |
| 908 |
fprintf header_fmt "/* Imports standard library */@."; |
|
| 909 |
(* imports standard library definitions (arrow) *) |
|
| 910 |
print_import_standard header_fmt; |
|
| 911 |
pp_print_newline header_fmt (); |
|
| 901 | 912 |
fprintf header_fmt "/* Types definitions */@."; |
| 902 | 913 |
(* Print the type definitions from the type table *) |
| 903 |
print_type_definitions header_fmt; |
|
| 914 |
print_type_definitions header_fmt basename; |
|
| 915 |
pp_print_newline header_fmt (); |
|
| 904 | 916 |
(* Print the global constant declarations. *) |
| 905 | 917 |
fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@."; |
| 906 | 918 |
List.iter (fun c -> print_const_decl header_fmt c) (get_consts prog); |
Also available in: Unified diff
answer to #feature 50:
- arrows are now factorized out and become part of include
as files arrow.h and arrow.c
- no more arrows in generated code
- compiling and linking arrow.c is only necessary
in case of dynamic allocation
- version now includes installation prefix (for the standard lib)
and svn number
git-svn-id: https://cavale.enseeiht.fr/svn/lustrec/lustre_compiler/trunk@180 041b043f-8d7c-46b2-b46e-ef0dd855326e