Revision 1147e80a
Added by Pierre-Loïc Garoche almost 5 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 |
(*open Machine_code_common*)
|
|
| 17 | 17 |
|
| 18 | 18 |
|
| 19 | 19 |
let print_version fmt = |
| ... | ... | |
| 244 | 244 |
| Cst c -> pp_c_const fmt c |
| 245 | 245 |
| Array vl -> fprintf fmt "{%a}" (Utils.fprintf_list ~sep:", " pp_c_val) vl
|
| 246 | 246 |
| Access (t, i) -> fprintf fmt "%a[%a]" pp_c_val t pp_c_val i |
| 247 |
| Power (v, n) -> (Format.eprintf "internal error: C_backend_common.pp_c_val %a@." (pp_val m) v; assert false) |
|
| 247 |
| Power (v, n) -> (Format.eprintf "internal error: C_backend_common.pp_c_val %a@." (Machine_code_common.pp_val m) v; assert false)
|
|
| 248 | 248 |
| Var v -> |
| 249 |
if is_memory m v then ( |
|
| 249 |
if Machine_code_common.is_memory m v then (
|
|
| 250 | 250 |
(* array memory vars are represented by an indirection to a local var with the right type, |
| 251 | 251 |
in order to avoid casting everywhere. *) |
| 252 | 252 |
if Types.is_array_type v.var_type && not (Types.is_real_type v.var_type && !Options.mpfr) |
| ... | ... | |
| 267 | 267 |
(* mpfr_t is a static array, not treated as general arrays *) |
| 268 | 268 |
if Types.is_address_type id.var_type |
| 269 | 269 |
then |
| 270 |
if is_memory m id && not (Types.is_real_type id.var_type && !Options.mpfr) |
|
| 270 |
if Machine_code_common.is_memory m id && not (Types.is_real_type id.var_type && !Options.mpfr)
|
|
| 271 | 271 |
then fprintf fmt "(*%s)" id.var_id |
| 272 | 272 |
else fprintf fmt "%s" id.var_id |
| 273 | 273 |
else |
| 274 |
if is_output m id |
|
| 274 |
if Machine_code_common.is_output m id
|
|
| 275 | 275 |
then fprintf fmt "*%s" id.var_id |
| 276 | 276 |
else fprintf fmt "%s" id.var_id |
| 277 | 277 |
|
| ... | ... | |
| 285 | 285 |
then |
| 286 | 286 |
fprintf fmt "%s" id.var_id |
| 287 | 287 |
else |
| 288 |
if is_output m id |
|
| 288 |
if Machine_code_common.is_output m id
|
|
| 289 | 289 |
then |
| 290 | 290 |
fprintf fmt "%s" id.var_id |
| 291 | 291 |
else |
| ... | ... | |
| 322 | 322 |
then |
| 323 | 323 |
Format.fprintf fmt "%a = %a" |
| 324 | 324 |
(pp_c_type ~var_opt:(Some id) id.var_id) id.var_type |
| 325 |
(pp_c_val m "" (pp_c_var_read m)) (get_const_assign m id) |
|
| 325 |
(pp_c_val m "" (pp_c_var_read m)) (Machine_code_common.get_const_assign m id)
|
|
| 326 | 326 |
else |
| 327 | 327 |
Format.fprintf fmt "%a" |
| 328 | 328 |
(pp_c_type ~var_opt:(Some id) id.var_id) id.var_type |
| ... | ... | |
| 370 | 370 |
() |
| 371 | 371 |
|
| 372 | 372 |
let print_machine_struct machines fmt m = |
| 373 |
if fst (get_stateless_status m) then |
|
| 373 |
if fst (Machine_code_common.get_stateless_status m) then
|
|
| 374 | 374 |
begin |
| 375 | 375 |
end |
| 376 | 376 |
else |
| ... | ... | |
| 512 | 512 |
fprintf fmt "&%s" id.var_id |
| 513 | 513 |
|
| 514 | 514 |
let pp_main_call mname self fmt m (inputs: value_t list) (outputs: var_decl list) = |
| 515 |
if fst (get_stateless_status m) |
|
| 515 |
if fst (Machine_code_common.get_stateless_status m)
|
|
| 516 | 516 |
then |
| 517 | 517 |
fprintf fmt "%a (%a%t%a);" |
| 518 | 518 |
pp_machine_step_name mname |
| ... | ... | |
| 529 | 529 |
self |
| 530 | 530 |
|
| 531 | 531 |
let pp_c_var m self pp_var fmt var = |
| 532 |
pp_c_val m self pp_var fmt (mk_val (Var var) var.var_type) |
|
| 532 |
pp_c_val m self pp_var fmt (Machine_code_common.mk_val (Var var) var.var_type)
|
|
| 533 | 533 |
|
| 534 | 534 |
|
| 535 | 535 |
let pp_array_suffix fmt loop_vars = |
| ... | ... | |
| 561 | 561 |
end |
| 562 | 562 |
|
| 563 | 563 |
let pp_const_initialize m pp_var fmt const = |
| 564 |
let var = mk_val (Var (Corelang.var_decl_of_const const)) const.const_type in |
|
| 564 |
let var = Machine_code_common.mk_val (Var (Corelang.var_decl_of_const const)) const.const_type in
|
|
| 565 | 565 |
let rec aux indices value fmt typ = |
| 566 | 566 |
if Types.is_array_type typ |
| 567 | 567 |
then |
| ... | ... | |
| 616 | 616 |
end |
| 617 | 617 |
|
| 618 | 618 |
let pp_const_clear pp_var fmt const = |
| 619 |
let m = empty_machine in |
|
| 619 |
let m = Machine_code_common.empty_machine in
|
|
| 620 | 620 |
let var = Corelang.var_decl_of_const const in |
| 621 | 621 |
let rec aux indices fmt typ = |
| 622 | 622 |
if Types.is_array_type typ |
Also available in: Unified diff
Array access: solved issues in C backend when basic operations in array access dimensions. Also better handling in EMF, ie further normalization through new equations