Revision cefc3744
Added by Pierre-Loïc Garoche almost 11 years ago
| src/backends/C/c_backend.ml | ||
|---|---|---|
| 28 | 28 |
(* Translation function *) |
| 29 | 29 |
(********************************************************************************************) |
| 30 | 30 |
|
| 31 |
|
|
| 31 | 32 |
let translate_to_c header_fmt source_fmt makefile_fmt spec_fmt_opt |
| 32 | 33 |
basename prog machines dependencies = |
| 33 | 34 |
|
| 35 |
|
|
| 36 |
let module HeaderMod = C_backend_header.EmptyMod in |
|
| 37 |
let module Header = C_backend_header.Main (HeaderMod) in |
|
| 38 |
|
|
| 39 |
let module SourceMod = C_backend_src.EmptyMod in |
|
| 40 |
let module Source = C_backend_src.Main (SourceMod) in |
|
| 41 |
|
|
| 42 |
let module MakefileMod = C_backend_makefile.EmptyMod in |
|
| 43 |
let module Makefile = C_backend_makefile.Main (MakefileMod) in |
|
| 44 |
|
|
| 45 |
|
|
| 34 | 46 |
(* Generating H file *) |
| 35 |
C_backend_header.print_header header_fmt basename prog machines;
|
|
| 47 |
Header.print_header header_fmt basename prog machines;
|
|
| 36 | 48 |
|
| 37 | 49 |
(* Generating C file *) |
| 38 |
C_backend_src.print_c source_fmt basename prog machines dependencies;
|
|
| 50 |
Source.print_c source_fmt basename prog machines dependencies;
|
|
| 39 | 51 |
|
| 40 | 52 |
(* Generating Makefile *) |
| 41 | 53 |
(* If a main node is identified, generate a main target for it *) |
| ... | ... | |
| 45 | 57 |
match Machine_code.get_machine_opt main_node machines with |
| 46 | 58 |
| None -> Format.eprintf "Unable to find a main node named %s@.@?" main_node; |
| 47 | 59 |
() |
| 48 |
| Some _ -> C_backend_makefile.print_makefile basename !Options.main_node dependencies makefile_fmt
|
|
| 60 |
| Some _ -> Makefile.print_makefile basename !Options.main_node dependencies makefile_fmt
|
|
| 49 | 61 |
) |
| 50 | 62 |
|
| 51 | 63 |
(* Local Variables: *) |
| src/backends/C/c_backend_common.ml | ||
|---|---|---|
| 213 | 213 |
| Fun (n, vl) -> Basic_library.pp_c n (pp_c_val self pp_var) fmt vl |
| 214 | 214 |
|
| 215 | 215 |
let pp_c_checks self fmt m = |
| 216 |
Utils.fprintf_list ~sep:"" (fun fmt (loc, check) -> fprintf fmt "@[<v>%a@,assert (%a);@]@," Location.pp_c_loc loc (pp_c_val self (pp_c_var_read m)) check) fmt m.mstep.step_checks |
|
| 216 |
Utils.fprintf_list ~sep:"" |
|
| 217 |
(fun fmt (loc, check) -> |
|
| 218 |
fprintf fmt |
|
| 219 |
"@[<v>%a@,assert (%a);@]@," |
|
| 220 |
Location.pp_c_loc loc |
|
| 221 |
(pp_c_val self (pp_c_var_read m)) check |
|
| 222 |
) |
|
| 223 |
fmt |
|
| 224 |
m.mstep.step_checks |
|
| 217 | 225 |
|
| 218 | 226 |
|
| 219 | 227 |
(********************************************************************************************) |
| src/backends/C/c_backend_header.ml | ||
|---|---|---|
| 7 | 7 |
(********************************************************************************************) |
| 8 | 8 |
(* Header Printing functions *) |
| 9 | 9 |
(********************************************************************************************) |
| 10 |
let print_machine_decl_prefix = ref (fun fmt x -> ()) |
|
| 11 | 10 |
|
| 12 | 11 |
|
| 12 |
module type MODIFIERS_HDR = |
|
| 13 |
sig |
|
| 14 |
val print_machine_decl_prefix: Format.formatter -> Machine_code.machine_t -> unit |
|
| 15 |
end |
|
| 16 |
|
|
| 17 |
module EmptyMod = |
|
| 18 |
struct |
|
| 19 |
let print_machine_decl_prefix = fun fmt x -> () |
|
| 20 |
end |
|
| 21 |
|
|
| 22 |
module Main = functor (Mod: MODIFIERS_HDR) -> |
|
| 23 |
struct |
|
| 24 |
|
|
| 13 | 25 |
let print_import_standard fmt = |
| 14 | 26 |
fprintf fmt "#include \"%s/include/lustrec/arrow.h\"@.@." Version.prefix |
| 15 | 27 |
|
| ... | ... | |
| 107 | 119 |
|
| 108 | 120 |
|
| 109 | 121 |
let print_machine_decl fmt m = |
| 110 |
!print_machine_decl_prefix fmt m;
|
|
| 122 |
Mod.print_machine_decl_prefix fmt m;
|
|
| 111 | 123 |
if fst (get_stateless_status m) then |
| 112 | 124 |
begin |
| 113 | 125 |
fprintf fmt "extern %a;@.@." |
| ... | ... | |
| 182 | 194 |
(********************************************************************************************) |
| 183 | 195 |
(* MAIN Header Printing functions *) |
| 184 | 196 |
(********************************************************************************************) |
| 185 |
|
|
| 186 | 197 |
let print_header header_fmt basename prog machines = |
| 187 | 198 |
(* Include once: start *) |
| 188 | 199 |
let baseNAME = String.uppercase basename in |
| ... | ... | |
| 214 | 225 |
(* Include once: end *) |
| 215 | 226 |
fprintf header_fmt "#endif@."; |
| 216 | 227 |
pp_print_newline header_fmt () |
| 228 |
end |
|
| 217 | 229 |
|
| 218 | 230 |
(* Local Variables: *) |
| 219 | 231 |
(* compile-command:"make -C ../../.." *) |
| src/backends/C/c_backend_makefile.ml | ||
|---|---|---|
| 1 | 1 |
open Format |
| 2 | 2 |
open Corelang |
| 3 | 3 |
|
| 4 |
module type MODIFIERS_MKF = |
|
| 5 |
sig |
|
| 6 |
end |
|
| 7 |
|
|
| 8 |
module EmptyMod = |
|
| 9 |
struct |
|
| 10 |
end |
|
| 11 |
|
|
| 12 |
module Main = functor (Mod: MODIFIERS_MKF) -> |
|
| 13 |
struct |
|
| 14 |
|
|
| 4 | 15 |
let header_has_code header = |
| 5 | 16 |
List.exists |
| 6 | 17 |
(fun top -> |
| ... | ... | |
| 50 | 61 |
fprintf fmt "@."; |
| 51 | 62 |
fprintf fmt "clean:@."; |
| 52 | 63 |
fprintf fmt "\t\\rm -f *.o %s_%s@." basename nodename |
| 53 |
|
|
| 64 |
end |
|
| 54 | 65 |
|
| 55 | 66 |
(* Local Variables: *) |
| 56 | 67 |
(* compile-command:"make -C ../../.." *) |
| src/backends/C/c_backend_spec.ml | ||
|---|---|---|
| 3 | 3 |
|
| 4 | 4 |
(**************************************************************************) |
| 5 | 5 |
|
| 6 |
let pp_acsl_type var fmt t = |
|
| 7 |
let rec aux t pp_suffix = |
|
| 8 |
match (Types.repr t).Types.tdesc with |
|
| 9 |
| Types.Tclock t' -> aux t' pp_suffix |
|
| 10 |
| Types.Tbool -> fprintf fmt "int %s%a" var pp_suffix () |
|
| 11 |
| Types.Treal -> fprintf fmt "real %s%a" var pp_suffix () |
|
| 12 |
| Types.Tint -> fprintf fmt "int %s%a" var pp_suffix () |
|
| 13 |
| Types.Tarray (d, t') -> |
|
| 14 |
let pp_suffix' fmt () = fprintf fmt "%a[%a]" pp_suffix () pp_c_dimension d in |
|
| 15 |
aux t' pp_suffix' |
|
| 16 |
(* | Types.Tstatic (_, t') -> fprintf fmt "const "; aux t' pp_suffix *) |
|
| 17 |
(* | Types.Tconst ty -> fprintf fmt "%s %s" ty var *) |
|
| 18 |
(* | Types.Tarrow (_, _) -> fprintf fmt "void (\*%s)()" var *) |
|
| 19 |
| _ -> eprintf "internal error: pp_acsl_type %a@." Types.print_ty t; assert false |
|
| 20 |
in aux t (fun fmt () -> ()) |
|
| 21 |
|
|
| 22 |
let pp_acsl_var_decl fmt id = |
|
| 23 |
pp_acsl_type id.var_id fmt id.var_type |
|
| 24 |
|
|
| 6 | 25 |
|
| 7 | 26 |
let pp_econst fmt c = |
| 8 | 27 |
match c with |
| src/backends/C/c_backend_src.ml | ||
|---|---|---|
| 4 | 4 |
open Machine_code |
| 5 | 5 |
open C_backend_common |
| 6 | 6 |
|
| 7 |
module type MODIFIERS_SRC = |
|
| 8 |
sig |
|
| 9 |
end |
|
| 10 |
|
|
| 11 |
module EmptyMod = |
|
| 12 |
struct |
|
| 13 |
end |
|
| 14 |
|
|
| 15 |
module Main = functor (Mod: MODIFIERS_SRC) -> |
|
| 16 |
struct |
|
| 17 |
|
|
| 7 | 18 |
(********************************************************************************************) |
| 8 | 19 |
(* Instruction Printing functions *) |
| 9 | 20 |
(********************************************************************************************) |
| ... | ... | |
| 370 | 381 |
(* Print nodes one by one (in the previous order) *) |
| 371 | 382 |
List.iter (print_machine dependencies source_fmt) machines; |
| 372 | 383 |
main_print source_fmt |
| 373 |
|
|
| 384 |
end |
|
| 374 | 385 |
|
| 375 | 386 |
(* Local Variables: *) |
| 376 | 387 |
(* compile-command:"make -C ../../.." *) |
Also available in: Unified diff
Specialized the prefix/postfix modifiers through functors arguments
git-svn-id: https://cavale.enseeiht.fr/svn/lustrec/lustre_compiler/branches/cleaner_backend@281 041b043f-8d7c-46b2-b46e-ef0dd855326e