Revision 1147e80a
Added by Pierre-Loïc Garoche almost 5 years ago
| src/backends/C/c_backend_src.ml | ||
|---|---|---|
| 112 | 112 |
var_loops @ int_loops |
| 113 | 113 |
|
| 114 | 114 |
(* Prints a one loop variable suffix for arrays *) |
| 115 |
let pp_loop_var m fmt lv = |
|
| 115 |
let pp_loop_var m pp_val fmt lv =
|
|
| 116 | 116 |
match snd lv with |
| 117 | 117 |
| LVar v -> fprintf fmt "[%s]" v |
| 118 | 118 |
| LInt r -> fprintf fmt "[%d]" !r |
| 119 |
| LAcc i -> fprintf fmt "[%a]" (pp_val m) i
|
|
| 119 |
| LAcc i -> fprintf fmt "[%a]" pp_val i
|
|
| 120 | 120 |
|
| 121 | 121 |
(* Prints a suffix of loop variables for arrays *) |
| 122 |
let pp_suffix m fmt loop_vars = |
|
| 123 |
Utils.fprintf_list ~sep:"" (pp_loop_var m) fmt loop_vars |
|
| 122 |
let pp_suffix m pp_val fmt loop_vars =
|
|
| 123 |
Utils.fprintf_list ~sep:"" (pp_loop_var m pp_val) fmt loop_vars
|
|
| 124 | 124 |
|
| 125 | 125 |
(* Prints a value expression [v], with internal function calls only. |
| 126 | 126 |
[pp_var] is a printer for variables (typically [pp_c_var_read]), |
| ... | ... | |
| 140 | 140 |
|
| 141 | 141 |
|
| 142 | 142 |
(* Prints a [value] of type [var_type] indexed by the suffix list [loop_vars] *) |
| 143 |
let rec pp_value_suffix m self var_type loop_vars pp_value fmt value =
|
|
| 143 |
let rec pp_value_suffix m self var_type loop_vars pp_var fmt value =
|
|
| 144 | 144 |
(*Format.eprintf "pp_value_suffix: %a %a %a@." Types.print_ty var_type Machine_code.pp_val value pp_suffix loop_vars;*) |
| 145 |
let pp_suffix = pp_suffix m in |
|
| 145 |
let pp_suffix = pp_suffix m (pp_value_suffix m self var_type [] pp_var) in
|
|
| 146 | 146 |
( |
| 147 | 147 |
match loop_vars, value.value_desc with |
| 148 | 148 |
| (x, LAcc i) :: q, _ when is_const_index i -> |
| 149 | 149 |
let r = ref (Dimension.size_const_dimension (dimension_of_value i)) in |
| 150 |
pp_value_suffix m self var_type ((x, LInt r)::q) pp_value fmt value
|
|
| 150 |
pp_value_suffix m self var_type ((x, LInt r)::q) pp_var fmt value
|
|
| 151 | 151 |
| (_, LInt r) :: q, Cst (Const_array cl) -> |
| 152 | 152 |
let var_type = Types.array_element_type var_type in |
| 153 |
pp_value_suffix m self var_type q pp_value fmt (mk_val (Cst (List.nth cl !r)) Type_predef.type_int)
|
|
| 153 |
pp_value_suffix m self var_type q pp_var fmt (mk_val (Cst (List.nth cl !r)) Type_predef.type_int)
|
|
| 154 | 154 |
| (_, LInt r) :: q, Array vl -> |
| 155 | 155 |
let var_type = Types.array_element_type var_type in |
| 156 |
pp_value_suffix m self var_type q pp_value fmt (List.nth vl !r)
|
|
| 156 |
pp_value_suffix m self var_type q pp_var fmt (List.nth vl !r)
|
|
| 157 | 157 |
| loop_var :: q, Array vl -> |
| 158 | 158 |
let var_type = Types.array_element_type var_type in |
| 159 |
Format.fprintf fmt "(%a[]){%a }%a" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_value_suffix m self var_type q pp_value)) vl pp_suffix [loop_var]
|
|
| 159 |
Format.fprintf fmt "(%a[]){%a }%a" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_value_suffix m self var_type q pp_var)) vl pp_suffix [loop_var]
|
|
| 160 | 160 |
| [] , Array vl -> |
| 161 | 161 |
let var_type = Types.array_element_type var_type in |
| 162 |
Format.fprintf fmt "(%a[]){%a }" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_value_suffix m self var_type [] pp_value)) vl
|
|
| 162 |
Format.fprintf fmt "(%a[]){%a }" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_value_suffix m self var_type [] pp_var)) vl
|
|
| 163 | 163 |
| _ :: q, Power (v, n) -> |
| 164 |
pp_value_suffix m self var_type q pp_value fmt v
|
|
| 164 |
pp_value_suffix m self var_type q pp_var fmt v
|
|
| 165 | 165 |
| _ , Fun (n, vl) -> |
| 166 |
pp_basic_lib_fun (Types.is_int_type value.value_type) n (pp_value_suffix m self var_type loop_vars pp_value) fmt vl
|
|
| 166 |
pp_basic_lib_fun (Types.is_int_type value.value_type) n (pp_value_suffix m self var_type loop_vars pp_var) fmt vl
|
|
| 167 | 167 |
| _ , Access (v, i) -> |
| 168 | 168 |
let var_type = Type_predef.type_array (Dimension.mkdim_var ()) var_type in |
| 169 |
pp_value_suffix m self var_type ((Dimension.mkdim_var (), LAcc i) :: loop_vars) pp_value fmt v
|
|
| 169 |
pp_value_suffix m self var_type ((Dimension.mkdim_var (), LAcc i) :: loop_vars) pp_var fmt v
|
|
| 170 | 170 |
| _ , Var v -> |
| 171 | 171 |
if is_memory m v then ( |
| 172 | 172 |
(* array memory vars are represented by an indirection to a local var with the right type, |
| 173 | 173 |
in order to avoid casting everywhere. *) |
| 174 | 174 |
if Types.is_array_type v.var_type |
| 175 |
then Format.fprintf fmt "%a%a" pp_value v pp_suffix loop_vars
|
|
| 176 |
else Format.fprintf fmt "%s->_reg.%a%a" self pp_value v pp_suffix loop_vars
|
|
| 175 |
then Format.fprintf fmt "%a%a" pp_var v pp_suffix loop_vars
|
|
| 176 |
else Format.fprintf fmt "%s->_reg.%a%a" self pp_var v pp_suffix loop_vars
|
|
| 177 | 177 |
) |
| 178 | 178 |
else ( |
| 179 |
Format.fprintf fmt "%a%a" pp_value v pp_suffix loop_vars
|
|
| 179 |
Format.fprintf fmt "%a%a" pp_var v pp_suffix loop_vars
|
|
| 180 | 180 |
) |
| 181 | 181 |
| _ , Cst cst -> pp_c_const_suffix var_type fmt cst |
| 182 | 182 |
| _ , _ -> (Format.eprintf "internal error: C_backend_src.pp_value_suffix %a %a %a@." Types.print_ty var_type (pp_val m) value pp_suffix loop_vars; assert false) |
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