lustrec / src / backends / C / c_backend_main.ml @ 3b2bd83d
History | View | Annotate | Download (7.43 KB)
1 |
(********************************************************************) |
---|---|
2 |
(* *) |
3 |
(* The LustreC compiler toolset / The LustreC Development Team *) |
4 |
(* Copyright 2012 - -- ONERA - CNRS - INPT *) |
5 |
(* *) |
6 |
(* LustreC is free software, distributed WITHOUT ANY WARRANTY *) |
7 |
(* under the terms of the GNU Lesser General Public License *) |
8 |
(* version 2.1. *) |
9 |
(* *) |
10 |
(********************************************************************) |
11 |
|
12 |
open LustreSpec |
13 |
open Corelang |
14 |
open Machine_code |
15 |
open Format |
16 |
open C_backend_common |
17 |
|
18 |
module type MODIFIERS_MAINSRC = |
19 |
sig |
20 |
end |
21 |
|
22 |
module EmptyMod = |
23 |
struct |
24 |
end |
25 |
|
26 |
module Main = functor (Mod: MODIFIERS_MAINSRC) -> |
27 |
struct |
28 |
|
29 |
(********************************************************************************************) |
30 |
(* Main related functions *) |
31 |
(********************************************************************************************) |
32 |
|
33 |
let print_get_inputs fmt m = |
34 |
let pi fmt (v', v) = |
35 |
match (Types.unclock_type v.var_type).Types.tdesc with |
36 |
| Types.Tint -> fprintf fmt "%s = _get_int(\"%s\")" v.var_id v'.var_id |
37 |
| Types.Tbool -> fprintf fmt "%s = _get_bool(\"%s\")" v.var_id v'.var_id |
38 |
| Types.Treal when !Options.mpfr -> fprintf fmt "mpfr_set_d(%s, _get_double(\"%s\"), %i)" v.var_id v'.var_id (Mpfr.mpfr_prec ()) |
39 |
| Types.Treal -> fprintf fmt "%s = _get_double(\"%s\")" v.var_id v'.var_id |
40 |
| _ -> |
41 |
begin |
42 |
Global.main_node := !Options.main_node; |
43 |
Format.eprintf "Code generation error: %a%a@." |
44 |
pp_error Main_wrong_kind |
45 |
Location.pp_loc v'.var_loc; |
46 |
raise (Error (v'.var_loc, Main_wrong_kind)) |
47 |
end |
48 |
in |
49 |
List.iter2 (fun v' v -> fprintf fmt "@ %a;" pi (v', v)) m.mname.node_inputs m.mstep.step_inputs |
50 |
|
51 |
let print_put_outputs fmt m = |
52 |
let po fmt (o', o) = |
53 |
match (Types.unclock_type o.var_type).Types.tdesc with |
54 |
| Types.Tint -> fprintf fmt "_put_int(\"%s\", %s)" o'.var_id o.var_id |
55 |
| Types.Tbool -> fprintf fmt "_put_bool(\"%s\", %s)" o'.var_id o.var_id |
56 |
| Types.Treal when !Options.mpfr -> fprintf fmt "_put_double(\"%s\", mpfr_get_d(%s, %s))" o'.var_id o.var_id (Mpfr.mpfr_rnd ()) |
57 |
| Types.Treal -> fprintf fmt "_put_double(\"%s\", %s)" o'.var_id o.var_id |
58 |
| _ -> assert false |
59 |
in |
60 |
List.iter2 (fun v' v -> fprintf fmt "@ %a;" po (v', v)) m.mname.node_outputs m.mstep.step_outputs |
61 |
|
62 |
let print_main_inout_declaration fmt m = |
63 |
begin |
64 |
fprintf fmt "/* Declaration of inputs/outputs variables */@ "; |
65 |
List.iter |
66 |
(fun v -> fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type |
67 |
) m.mstep.step_inputs; |
68 |
List.iter |
69 |
(fun v -> fprintf fmt "%a;@ " (pp_c_type v.var_id) v.var_type |
70 |
) m.mstep.step_outputs |
71 |
end |
72 |
|
73 |
let print_main_memory_allocation mname main_mem fmt m = |
74 |
if not (fst (get_stateless_status m)) then |
75 |
begin |
76 |
fprintf fmt "@ /* Main memory allocation */@ "; |
77 |
if (!Options.static_mem && !Options.main_node <> "") |
78 |
then (fprintf fmt "%a(static,main_mem);@ " pp_machine_static_alloc_name mname) |
79 |
else (fprintf fmt "%a *main_mem = %a();@ " pp_machine_memtype_name mname pp_machine_alloc_name mname); |
80 |
fprintf fmt "@ /* Initialize the main memory */@ "; |
81 |
fprintf fmt "%a(%s);@ " pp_machine_reset_name mname main_mem; |
82 |
end |
83 |
|
84 |
let print_global_initialize fmt basename = |
85 |
let mNAME = file_to_module_name basename in |
86 |
fprintf fmt "@ /* Initialize global constants */@ %a();@ " |
87 |
pp_global_init_name mNAME |
88 |
|
89 |
let print_global_clear fmt basename = |
90 |
let mNAME = file_to_module_name basename in |
91 |
fprintf fmt "@ /* Clear global constants */@ %a();@ " |
92 |
pp_global_clear_name mNAME |
93 |
|
94 |
let print_main_initialize mname main_mem fmt m = |
95 |
if not (fst (get_stateless_status m)) |
96 |
then |
97 |
fprintf fmt "@ /* Initialize inputs, outputs and memories */@ %a%t%a%t%a(%s);@ " |
98 |
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
99 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
100 |
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
101 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
102 |
pp_machine_init_name mname |
103 |
main_mem |
104 |
else |
105 |
fprintf fmt "@ /* Initialize inputs and outputs */@ %a%t%a@ " |
106 |
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
107 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
108 |
(Utils.fprintf_list ~sep:"@ " (pp_initialize m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
109 |
|
110 |
let print_main_clear mname main_mem fmt m = |
111 |
if not (fst (get_stateless_status m)) |
112 |
then |
113 |
fprintf fmt "@ /* Clear inputs, outputs and memories */@ %a%t%a%t%a(%s);@ " |
114 |
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
115 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
116 |
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
117 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
118 |
pp_machine_clear_name mname |
119 |
main_mem |
120 |
else |
121 |
fprintf fmt "@ /* Clear inputs and outputs */@ %a%t%a@ " |
122 |
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_inputs |
123 |
(Utils.pp_newline_if_non_empty m.mstep.step_inputs) |
124 |
(Utils.fprintf_list ~sep:"@ " (pp_clear m main_mem (pp_c_var_read m))) m.mstep.step_outputs |
125 |
|
126 |
let print_main_loop mname main_mem fmt m = |
127 |
let input_values = |
128 |
List.map (fun v -> mk_val (LocalVar v) v.var_type) |
129 |
m.mstep.step_inputs in |
130 |
begin |
131 |
fprintf fmt "@ ISATTY = isatty(0);@ "; |
132 |
fprintf fmt "@ /* Infinite loop */@ "; |
133 |
fprintf fmt "@[<v 2>while(1){@ "; |
134 |
fprintf fmt "fflush(stdout);@ "; |
135 |
fprintf fmt "%a@ %t%a" |
136 |
print_get_inputs m |
137 |
(fun fmt -> pp_main_call mname main_mem fmt m input_values m.mstep.step_outputs) |
138 |
print_put_outputs m |
139 |
end |
140 |
|
141 |
let print_main_code fmt basename m = |
142 |
let mname = m.mname.node_id in |
143 |
let main_mem = |
144 |
if (!Options.static_mem && !Options.main_node <> "") |
145 |
then "&main_mem" |
146 |
else "main_mem" in |
147 |
fprintf fmt "@[<v 2>int main (int argc, char *argv[]) {@ "; |
148 |
print_main_inout_declaration fmt m; |
149 |
print_main_memory_allocation mname main_mem fmt m; |
150 |
if !Options.mpfr then |
151 |
begin |
152 |
print_global_initialize fmt basename; |
153 |
print_main_initialize mname main_mem fmt m; |
154 |
end; |
155 |
print_main_loop mname main_mem fmt m; |
156 |
if Scopes.Plugin.is_active () then |
157 |
begin |
158 |
fprintf fmt "@ %t" Scopes.Plugin.pp |
159 |
end; |
160 |
fprintf fmt "@]@ }@ @ "; |
161 |
if !Options.mpfr then |
162 |
begin |
163 |
print_main_clear mname main_mem fmt m; |
164 |
print_global_clear fmt basename; |
165 |
end; |
166 |
fprintf fmt "@ return 1;"; |
167 |
fprintf fmt "@]@ }@." |
168 |
|
169 |
let print_main_header fmt = |
170 |
fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/io_frontend.h\"@." Version.include_path |
171 |
|
172 |
|
173 |
let print_main_c main_fmt main_machine basename prog machines _ (*dependencies*) = |
174 |
print_main_header main_fmt; |
175 |
fprintf main_fmt "#include <stdlib.h>@.#include <assert.h>@."; |
176 |
print_import_alloc_prototype main_fmt (Dep (true, basename, [], true (* assuming it is stateful*) )); |
177 |
pp_print_newline main_fmt (); |
178 |
|
179 |
(* Print the svn version number and the supported C standard (C90 or C99) *) |
180 |
print_version main_fmt; |
181 |
print_main_code main_fmt basename main_machine |
182 |
end |
183 |
|
184 |
(* Local Variables: *) |
185 |
(* compile-command:"make -C ../../.." *) |
186 |
(* End: *) |