lustrec / src / backends / C / c_backend_header.ml @ 70e1006b
History | View | Annotate | Download (13.4 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 Format |
13 |
open LustreSpec |
14 |
open Corelang |
15 |
open Machine_code |
16 |
open C_backend_common |
17 |
|
18 |
(********************************************************************************************) |
19 |
(* Header Printing functions *) |
20 |
(********************************************************************************************) |
21 |
|
22 |
|
23 |
module type MODIFIERS_HDR = |
24 |
sig |
25 |
val print_machine_decl_prefix: Format.formatter -> Machine_code.machine_t -> unit |
26 |
end |
27 |
|
28 |
module EmptyMod = |
29 |
struct |
30 |
let print_machine_decl_prefix = fun fmt x -> () |
31 |
end |
32 |
|
33 |
module Main = functor (Mod: MODIFIERS_HDR) -> |
34 |
struct |
35 |
|
36 |
let print_import_standard fmt = |
37 |
fprintf fmt "#include \"%s/include/lustrec/arrow.h\"@.@." Version.prefix |
38 |
|
39 |
let print_static_declare_instance attr fmt (i, (m, static)) = |
40 |
fprintf fmt "%a(%s, %a%t%s)" |
41 |
pp_machine_static_declare_name (node_name m) |
42 |
attr |
43 |
(Utils.fprintf_list ~sep:", " Dimension.pp_dimension) static |
44 |
(Utils.pp_final_char_if_non_empty ", " static) |
45 |
i |
46 |
|
47 |
let print_static_declare_macro fmt m = |
48 |
let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in |
49 |
let inst = mk_instance m in |
50 |
let attr = mk_attribute m in |
51 |
fprintf fmt "@[<v 2>#define %a(%s, %a%t%s)\\@,%s %a %s;\\@,%a%t%a;@,@]" |
52 |
pp_machine_static_declare_name m.mname.node_id |
53 |
attr |
54 |
(Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic |
55 |
(Utils.pp_final_char_if_non_empty ", " m.mstatic) |
56 |
inst |
57 |
attr |
58 |
pp_machine_memtype_name m.mname.node_id |
59 |
inst |
60 |
(Utils.fprintf_list ~sep:";\\@," pp_c_decl_local_var) array_mem |
61 |
(Utils.pp_final_char_if_non_empty ";\\@," array_mem) |
62 |
(Utils.fprintf_list ~sep:";\\@," |
63 |
(fun fmt (i',m') -> |
64 |
let path = sprintf "inst ## _%s" i' in |
65 |
fprintf fmt "%a" |
66 |
(print_static_declare_instance attr) (path,m') |
67 |
)) m.minstances |
68 |
|
69 |
|
70 |
let print_static_link_instance fmt (i, (m, _)) = |
71 |
fprintf fmt "%a(%s)" pp_machine_static_link_name (node_name m) i |
72 |
|
73 |
(* Allocation of a node struct: |
74 |
- if node memory is an array/matrix/etc, we cast it to a pointer (see pp_registers_struct) |
75 |
*) |
76 |
let print_static_link_macro fmt m = |
77 |
let array_mem = List.filter (fun v -> Types.is_array_type v.var_type) m.mmemory in |
78 |
fprintf fmt "@[<v>@[<v 2>#define %a(inst) do {\\@,%a%t%a;\\@]@,} while (0)@.@]" |
79 |
pp_machine_static_link_name m.mname.node_id |
80 |
(Utils.fprintf_list ~sep:";\\@," |
81 |
(fun fmt v -> |
82 |
fprintf fmt "inst._reg.%s = (%a*) &%s" |
83 |
v.var_id |
84 |
(fun fmt v -> pp_c_type "" fmt (Types.array_base_type v.var_type)) v |
85 |
v.var_id |
86 |
)) array_mem |
87 |
(Utils.pp_final_char_if_non_empty ";\\@," array_mem) |
88 |
(Utils.fprintf_list ~sep:";\\@," |
89 |
(fun fmt (i',m') -> |
90 |
let path = sprintf "inst ## _%s" i' in |
91 |
fprintf fmt "%a;\\@,inst.%s = &%s" |
92 |
print_static_link_instance (path,m') |
93 |
i' |
94 |
path |
95 |
)) m.minstances |
96 |
|
97 |
let print_static_alloc_macro fmt m = |
98 |
fprintf fmt "@[<v>@[<v 2>#define %a(attr,%a%tinst)\\@,%a(attr,%a%tinst);\\@,%a(inst);@]@,@]@." |
99 |
pp_machine_static_alloc_name m.mname.node_id |
100 |
(Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic |
101 |
(Utils.pp_final_char_if_non_empty ", " m.mstatic) |
102 |
pp_machine_static_declare_name m.mname.node_id |
103 |
(Utils.fprintf_list ~sep:", " (pp_c_var_read m)) m.mstatic |
104 |
(Utils.pp_final_char_if_non_empty ", " m.mstatic) |
105 |
pp_machine_static_link_name m.mname.node_id |
106 |
|
107 |
|
108 |
let print_machine_decl fmt m = |
109 |
Mod.print_machine_decl_prefix fmt m; |
110 |
if fst (get_stateless_status m) then |
111 |
begin |
112 |
fprintf fmt "extern %a;@.@." |
113 |
print_stateless_prototype |
114 |
(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs) |
115 |
end |
116 |
else |
117 |
begin |
118 |
(* Static allocation *) |
119 |
if !Options.static_mem |
120 |
then ( |
121 |
fprintf fmt "%a@.%a@.%a@." |
122 |
print_static_declare_macro m |
123 |
print_static_link_macro m |
124 |
print_static_alloc_macro m |
125 |
) |
126 |
else ( |
127 |
(* Dynamic allocation *) |
128 |
fprintf fmt "extern %a;@.@." |
129 |
print_alloc_prototype (m.mname.node_id, m.mstatic) |
130 |
); |
131 |
let self = mk_self m in |
132 |
fprintf fmt "extern %a;@.@." |
133 |
(print_reset_prototype self) (m.mname.node_id, m.mstatic); |
134 |
|
135 |
fprintf fmt "extern %a;@.@." |
136 |
(print_step_prototype self) |
137 |
(m.mname.node_id, m.mstep.step_inputs, m.mstep.step_outputs) |
138 |
end |
139 |
|
140 |
let print_machine_alloc_decl fmt m = |
141 |
Mod.print_machine_decl_prefix fmt m; |
142 |
if fst (get_stateless_status m) then |
143 |
begin |
144 |
end |
145 |
else |
146 |
begin |
147 |
if !Options.static_mem |
148 |
then |
149 |
begin |
150 |
(* Static allocation *) |
151 |
fprintf fmt "%a@.%a@.%a@." |
152 |
print_static_declare_macro m |
153 |
print_static_link_macro m |
154 |
print_static_alloc_macro m |
155 |
end |
156 |
else |
157 |
begin |
158 |
(* Dynamic allocation *) |
159 |
fprintf fmt "extern %a;@." |
160 |
print_alloc_prototype (m.mname.node_id, m.mstatic) |
161 |
end |
162 |
end |
163 |
|
164 |
let print_machine_decl_from_header fmt inode = |
165 |
(*Mod.print_machine_decl_prefix fmt m;*) |
166 |
if inode.nodei_stateless then |
167 |
begin |
168 |
fprintf fmt "extern %a;@.@." |
169 |
print_stateless_prototype |
170 |
(inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs) |
171 |
end |
172 |
else |
173 |
begin |
174 |
let static_inputs = List.filter (fun v -> v.var_dec_const) inode.nodei_inputs in |
175 |
let self = mk_new_name (inode.nodei_inputs@inode.nodei_outputs) "self" in |
176 |
fprintf fmt "extern %a;@.@." |
177 |
(print_reset_prototype self) (inode.nodei_id, static_inputs); |
178 |
|
179 |
fprintf fmt "extern %a;@.@." |
180 |
(print_step_prototype self) |
181 |
(inode.nodei_id, inode.nodei_inputs, inode.nodei_outputs) |
182 |
end |
183 |
|
184 |
let print_const_decl fmt cdecl = |
185 |
fprintf fmt "extern %a;@." |
186 |
(pp_c_type cdecl.const_id) cdecl.const_type |
187 |
|
188 |
let rec pp_c_struct_type_field filename cpt fmt (label, tdesc) = |
189 |
fprintf fmt "%a;" (pp_c_type_decl filename cpt label) tdesc |
190 |
and pp_c_type_decl filename cpt var fmt tdecl = |
191 |
match tdecl with |
192 |
| Tydec_any -> assert false |
193 |
| Tydec_int -> fprintf fmt "int %s" var |
194 |
| Tydec_real -> fprintf fmt "double %s" var |
195 |
| Tydec_float -> fprintf fmt "float %s" var |
196 |
| Tydec_bool -> fprintf fmt "_Bool %s" var |
197 |
| Tydec_clock ty -> pp_c_type_decl filename cpt var fmt ty |
198 |
| Tydec_const c -> fprintf fmt "%s %s" c var |
199 |
| Tydec_array (d, ty) -> fprintf fmt "%a[%a]" (pp_c_type_decl filename cpt var) ty pp_c_dimension d |
200 |
| Tydec_enum tl -> |
201 |
begin |
202 |
incr cpt; |
203 |
fprintf fmt "enum _enum_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:", " pp_print_string) tl var |
204 |
end |
205 |
| Tydec_struct fl -> |
206 |
begin |
207 |
incr cpt; |
208 |
fprintf fmt "struct _struct_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:" " (pp_c_struct_type_field filename cpt)) fl var |
209 |
end |
210 |
|
211 |
let print_type_definitions fmt filename = |
212 |
let cpt_type = ref 0 in |
213 |
Hashtbl.iter (fun typ decl -> |
214 |
match typ with |
215 |
| Tydec_const var -> |
216 |
(match decl.top_decl_desc with |
217 |
| TypeDef tdef -> |
218 |
fprintf fmt "typedef %a;@.@." |
219 |
(pp_c_type_decl filename cpt_type var) tdef.tydef_desc |
220 |
| _ -> assert false) |
221 |
| _ -> ()) type_table |
222 |
|
223 |
let reset_type_definitions, print_type_definition_from_header = |
224 |
let cpt_type =ref 0 in |
225 |
((fun () -> cpt_type := 0), |
226 |
(fun fmt typ filename -> |
227 |
fprintf fmt "typedef %a;@.@." |
228 |
(pp_c_type_decl filename cpt_type typ.tydef_id) typ.tydef_desc)) |
229 |
|
230 |
(********************************************************************************************) |
231 |
(* MAIN Header Printing functions *) |
232 |
(********************************************************************************************) |
233 |
let print_header header_fmt basename prog machines dependencies = |
234 |
(* Include once: start *) |
235 |
let baseNAME = String.uppercase basename in |
236 |
let baseNAME = Str.global_replace (Str.regexp "\\.\\|\\ ") "_" baseNAME in |
237 |
begin |
238 |
(* Print the svn version number and the supported C standard (C90 or C99) *) |
239 |
print_version header_fmt; |
240 |
fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME; |
241 |
pp_print_newline header_fmt (); |
242 |
fprintf header_fmt "/* Imports standard library */@."; |
243 |
(* imports standard library definitions (arrow) *) |
244 |
print_import_standard header_fmt; |
245 |
pp_print_newline header_fmt (); |
246 |
(* imports dependencies *) |
247 |
fprintf header_fmt "/* Import Dependencies */@."; |
248 |
fprintf header_fmt "@[<v>"; |
249 |
List.iter (print_import_prototype header_fmt) dependencies; |
250 |
fprintf header_fmt "@]@."; |
251 |
fprintf header_fmt "/* Types definitions */@."; |
252 |
(* Print the type definitions from the type table *) |
253 |
print_type_definitions header_fmt basename; |
254 |
pp_print_newline header_fmt (); |
255 |
(* Print the global constant declarations. *) |
256 |
fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@."; |
257 |
List.iter (fun c -> print_const_decl header_fmt (const_of_top c)) (get_consts prog); |
258 |
pp_print_newline header_fmt (); |
259 |
(* Print the struct declarations of all machines. *) |
260 |
fprintf header_fmt "/* Struct declarations */@."; |
261 |
List.iter (print_machine_struct header_fmt) machines; |
262 |
pp_print_newline header_fmt (); |
263 |
(* Print the prototypes of all machines *) |
264 |
fprintf header_fmt "/* Nodes declarations */@."; |
265 |
List.iter (print_machine_decl header_fmt) machines; |
266 |
pp_print_newline header_fmt (); |
267 |
(* Include once: end *) |
268 |
fprintf header_fmt "#endif@."; |
269 |
pp_print_newline header_fmt () |
270 |
end |
271 |
|
272 |
let print_alloc_header header_fmt basename prog machines dependencies = |
273 |
(* Include once: start *) |
274 |
let baseNAME = String.uppercase basename in |
275 |
let baseNAME = Str.global_replace (Str.regexp "\\.\\|\\ ") "_" baseNAME in |
276 |
begin |
277 |
(* Print the svn version number and the supported C standard (C90 or C99) *) |
278 |
print_version header_fmt; |
279 |
fprintf header_fmt "#ifndef _%s_alloc@.#define _%s_alloc@." baseNAME baseNAME; |
280 |
pp_print_newline header_fmt (); |
281 |
(* Import the header *) |
282 |
fprintf header_fmt "/* Import header from %s */@." basename; |
283 |
fprintf header_fmt "@[<v>"; |
284 |
print_import_prototype header_fmt (true, basename, []); |
285 |
fprintf header_fmt "@]@."; |
286 |
fprintf header_fmt "/* Import dependencies */@."; |
287 |
fprintf header_fmt "@[<v>"; |
288 |
List.iter (print_import_alloc_prototype header_fmt) dependencies; |
289 |
fprintf header_fmt "@]@."; |
290 |
(* Print the struct definitions of all machines. *) |
291 |
fprintf header_fmt "/* Struct definitions */@."; |
292 |
List.iter (print_machine_struct header_fmt) machines; |
293 |
pp_print_newline header_fmt (); |
294 |
(* Print the prototypes of all machines *) |
295 |
fprintf header_fmt "/* Node allocation function/macro prototypes */@."; |
296 |
List.iter (print_machine_alloc_decl header_fmt) machines; |
297 |
pp_print_newline header_fmt (); |
298 |
(* Include once: end *) |
299 |
fprintf header_fmt "#endif@."; |
300 |
pp_print_newline header_fmt () |
301 |
end |
302 |
|
303 |
let print_header_from_header header_fmt basename header = |
304 |
(* Include once: start *) |
305 |
let baseNAME = String.uppercase basename in |
306 |
let baseNAME = Str.global_replace (Str.regexp "\\.\\|\\ ") "_" baseNAME in |
307 |
let types = get_typedefs header in |
308 |
let consts = get_consts header in |
309 |
let nodes = get_imported_nodes header in |
310 |
let dependencies = get_dependencies header in |
311 |
begin |
312 |
(* Print the svn version number and the supported C standard (C90 or C99) *) |
313 |
print_version header_fmt; |
314 |
fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME; |
315 |
pp_print_newline header_fmt (); |
316 |
fprintf header_fmt "/* Imports standard library */@."; |
317 |
(* imports standard library definitions (arrow) *) |
318 |
print_import_standard header_fmt; |
319 |
pp_print_newline header_fmt (); |
320 |
(* imports dependencies *) |
321 |
fprintf header_fmt "/* Import dependencies */@."; |
322 |
fprintf header_fmt "@[<v>"; |
323 |
List.iter |
324 |
(fun dep -> let (local, s) = dependency_of_top dep in print_import_prototype header_fmt (local, s, [])) |
325 |
dependencies; |
326 |
fprintf header_fmt "@]@."; |
327 |
fprintf header_fmt "/* Types definitions */@."; |
328 |
(* Print the type definitions from the type table *) |
329 |
reset_type_definitions (); |
330 |
List.iter (fun typ -> print_type_definition_from_header header_fmt (typedef_of_top typ) basename) types; |
331 |
pp_print_newline header_fmt (); |
332 |
(* Print the global constant declarations. *) |
333 |
fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@."; |
334 |
List.iter (fun c -> print_const_decl header_fmt (const_of_top c)) consts; |
335 |
pp_print_newline header_fmt (); |
336 |
(* Print the struct declarations of all machines. *) |
337 |
fprintf header_fmt "/* Struct declarations */@."; |
338 |
List.iter (fun node -> print_machine_struct_from_header header_fmt (imported_node_of_top node)) nodes; |
339 |
pp_print_newline header_fmt (); |
340 |
(* Print the prototypes of all machines *) |
341 |
fprintf header_fmt "/* Nodes declarations */@."; |
342 |
List.iter (fun node -> print_machine_decl_from_header header_fmt (imported_node_of_top node)) nodes; |
343 |
pp_print_newline header_fmt (); |
344 |
(* Include once: end *) |
345 |
fprintf header_fmt "#endif@."; |
346 |
pp_print_newline header_fmt () |
347 |
end |
348 |
|
349 |
end |
350 |
(* Local Variables: *) |
351 |
(* compile-command:"make -C ../../.." *) |
352 |
(* End: *) |