Revision 2863281f
Added by Pierre-Loïc Garoche almost 7 years ago
src/backends/C/c_backend_common.ml | ||
---|---|---|
13 | 13 |
open Lustre_types |
14 | 14 |
open Corelang |
15 | 15 |
open Machine_code_types |
16 |
open Machine_code_common |
|
16 | 17 |
|
17 | 18 |
|
18 | 19 |
let print_version fmt = |
... | ... | |
194 | 195 |
but an offset suffix may be added for array variables |
195 | 196 |
*) |
196 | 197 |
let rec pp_c_val self pp_var fmt v = |
197 |
let open Machine_code_types in |
|
198 | 198 |
match v.value_desc with |
199 | 199 |
| Cst c -> pp_c_const fmt c |
200 | 200 |
| Array vl -> fprintf fmt "{%a}" (Utils.fprintf_list ~sep:", " (pp_c_val self pp_var)) vl |
201 | 201 |
| Access (t, i) -> fprintf fmt "%a[%a]" (pp_c_val self pp_var) t (pp_c_val self pp_var) i |
202 |
| Power (v, n) -> (Format.eprintf "internal error: C_backend_common.pp_c_val %a@." Machine_code.pp_val v; assert false)
|
|
202 |
| Power (v, n) -> (Format.eprintf "internal error: C_backend_common.pp_c_val %a@." pp_val v; assert false) |
|
203 | 203 |
| LocalVar v -> pp_var fmt v |
204 | 204 |
| StateVar v -> |
205 | 205 |
(* array memory vars are represented by an indirection to a local var with the right type, |
... | ... | |
219 | 219 |
(* mpfr_t is a static array, not treated as general arrays *) |
220 | 220 |
if Types.is_address_type id.var_type |
221 | 221 |
then |
222 |
if Machine_code.is_memory m id && not (Types.is_real_type id.var_type && !Options.mpfr)
|
|
222 |
if is_memory m id && not (Types.is_real_type id.var_type && !Options.mpfr) |
|
223 | 223 |
then fprintf fmt "(*%s)" id.var_id |
224 | 224 |
else fprintf fmt "%s" id.var_id |
225 | 225 |
else |
226 |
if Machine_code.is_output m id
|
|
226 |
if is_output m id |
|
227 | 227 |
then fprintf fmt "*%s" id.var_id |
228 | 228 |
else fprintf fmt "%s" id.var_id |
229 | 229 |
|
... | ... | |
237 | 237 |
then |
238 | 238 |
fprintf fmt "%s" id.var_id |
239 | 239 |
else |
240 |
if Machine_code.is_output m id
|
|
240 |
if is_output m id |
|
241 | 241 |
then |
242 | 242 |
fprintf fmt "%s" id.var_id |
243 | 243 |
else |
... | ... | |
274 | 274 |
then |
275 | 275 |
Format.fprintf fmt "%a = %a" |
276 | 276 |
(pp_c_type ~var_opt:(Some id) id.var_id) id.var_type |
277 |
(pp_c_val "" (pp_c_var_read m)) (Machine_code.get_const_assign m id)
|
|
277 |
(pp_c_val "" (pp_c_var_read m)) (get_const_assign m id) |
|
278 | 278 |
else |
279 | 279 |
Format.fprintf fmt "%a" |
280 | 280 |
(pp_c_type ~var_opt:(Some id) id.var_id) id.var_type |
... | ... | |
322 | 322 |
() |
323 | 323 |
|
324 | 324 |
let print_machine_struct fmt m = |
325 |
if fst (Machine_code.get_stateless_status m) then
|
|
325 |
if fst (get_stateless_status m) then |
|
326 | 326 |
begin |
327 | 327 |
end |
328 | 328 |
else |
... | ... | |
463 | 463 |
else |
464 | 464 |
fprintf fmt "&%s" id.var_id |
465 | 465 |
|
466 |
let pp_main_call mname self fmt m (inputs: Machine_code_types.value_t list) (outputs: var_decl list) =
|
|
467 |
if fst (Machine_code.get_stateless_status m)
|
|
466 |
let pp_main_call mname self fmt m (inputs: value_t list) (outputs: var_decl list) = |
|
467 |
if fst (get_stateless_status m) |
|
468 | 468 |
then |
469 | 469 |
fprintf fmt "%a (%a%t%a);" |
470 | 470 |
pp_machine_step_name mname |
... | ... | |
481 | 481 |
self |
482 | 482 |
|
483 | 483 |
let pp_c_var m self pp_var fmt var = |
484 |
let open Machine_code_types in |
|
485 |
if Machine_code.is_memory m var |
|
484 |
if is_memory m var |
|
486 | 485 |
then |
487 |
pp_c_val self pp_var fmt (Machine_code.mk_val (StateVar var) var.var_type)
|
|
486 |
pp_c_val self pp_var fmt (mk_val (StateVar var) var.var_type) |
|
488 | 487 |
else |
489 |
pp_c_val self pp_var fmt (Machine_code.mk_val (LocalVar var) var.var_type)
|
|
488 |
pp_c_val self pp_var fmt (mk_val (LocalVar var) var.var_type) |
|
490 | 489 |
|
491 | 490 |
|
492 | 491 |
let pp_array_suffix fmt loop_vars = |
... | ... | |
518 | 517 |
end |
519 | 518 |
|
520 | 519 |
let pp_const_initialize pp_var fmt const = |
521 |
let open Machine_code_types in |
|
522 |
let var = Machine_code.mk_val (LocalVar (Corelang.var_decl_of_const const)) const.const_type in |
|
520 |
let var = mk_val (LocalVar (Corelang.var_decl_of_const const)) const.const_type in |
|
523 | 521 |
let rec aux indices value fmt typ = |
524 | 522 |
if Types.is_array_type typ |
525 | 523 |
then |
... | ... | |
574 | 572 |
end |
575 | 573 |
|
576 | 574 |
let pp_const_clear pp_var fmt const = |
577 |
let m = Machine_code.empty_machine in
|
|
575 |
let m = empty_machine in |
|
578 | 576 |
let var = Corelang.var_decl_of_const const in |
579 | 577 |
let rec aux indices fmt typ = |
580 | 578 |
if Types.is_array_type typ |
Also available in: Unified diff
Further restructuring:
- arrow.ml* to define basic builder for arrow (node, name, ...)
- machine_code_common similar to corelang but for machine_code (printers, some builders, ...)
- machine_code restricted to the translatation from normalized nodes to machines