Project

General

Profile

Revision 79614a15 src/backends/C/c_backend_src.ml

View differences:

src/backends/C/c_backend_src.ml
30 30
(*                    Instruction Printing functions                                        *)
31 31
(********************************************************************************************)
32 32

  
33

  
33 34
(* Computes the depth to which multi-dimension array assignments should be expanded.
34 35
   It equals the maximum number of nested static array constructions accessible from root [v].
35 36
*)
......
101 102
    List.partition (function (d, LInt _) -> true | _ -> false) loop_vars 
102 103
  in
103 104
  var_loops @ int_loops
104
    
105

  
105 106
(* Prints a one loop variable suffix for arrays *)
106
let pp_loop_var fmt lv =
107
let pp_loop_var pp_value fmt lv =
107 108
 match snd lv with
108 109
 | LVar v -> fprintf fmt "[%s]" v
109 110
 | LInt r -> fprintf fmt "[%d]" !r
110
 | LAcc i -> fprintf fmt "[%a]" pp_val i
111
 | LAcc i -> fprintf fmt "[%a]" (pp_c_val "" pp_value) i
111 112

  
112 113
(* Prints a suffix of loop variables for arrays *)
113
let pp_suffix fmt loop_vars =
114
 Utils.fprintf_list ~sep:"" pp_loop_var fmt loop_vars
114
let pp_suffix pp_value fmt loop_vars =
115
 Utils.fprintf_list ~sep:"" (pp_loop_var pp_value) fmt loop_vars
115 116

  
116
(* Prints a [value] indexed by the suffix list [loop_vars] *)
117
let rec pp_value_suffix self loop_vars pp_value fmt value =
117
(* Prints a value expression [v], with internal function calls only.
118
   [pp_var] is a printer for variables (typically [pp_c_var_read]),
119
   but an offset suffix may be added for array variables
120
*)
121
(* Prints a constant value before a suffix (needs casting) *)
122
let rec pp_c_const_suffix var_type fmt c =
123
  match c with
124
    | Const_int i     -> pp_print_int fmt i
125
    | Const_real r    -> pp_print_string fmt r
126
    | Const_float r   -> pp_print_float fmt r
127
    | Const_tag t     -> pp_c_tag fmt t
128
    | Const_array ca  -> let var_type = Types.array_element_type var_type in
129
                         fprintf fmt "(%a[]){%a }" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_c_const_suffix var_type)) ca
130
    | Const_struct fl -> fprintf fmt "{%a }" (Utils.fprintf_list ~sep:", " (fun fmt (f, c) -> (pp_c_const_suffix (Types.struct_field_type var_type f)) fmt c)) fl
131
    | Const_string _ -> assert false (* string occurs in annotations not in C *)
132

  
133

  
134
(* Prints a [value] of type [var_type] indexed by the suffix list [loop_vars] *)
135
let rec pp_value_suffix self var_type loop_vars pp_value fmt value =
136
(*Format.eprintf "pp_value_suffix: %a %a %a@." Types.print_ty var_type Machine_code.pp_val value pp_suffix loop_vars;*)
118 137
 match loop_vars, value with
138
 | (x, LAcc i) :: q, _ when is_const_index i ->
139
   let r = ref (Dimension.size_const_dimension (Machine_code.dimension_of_value i)) in
140
   pp_value_suffix self var_type ((x, LInt r)::q) pp_value fmt value
141
 | (_, LInt r) :: q, Cst (Const_array cl) ->
142
   let var_type = Types.array_element_type var_type in
143
   pp_value_suffix self var_type q pp_value fmt (Cst (List.nth cl !r))
119 144
 | (_, LInt r) :: q, Array vl      ->
120
   pp_value_suffix self q pp_value fmt (List.nth vl !r)
145
   let var_type = Types.array_element_type var_type in
146
   pp_value_suffix self var_type q pp_value fmt (List.nth vl !r)
147
 | loop_var    :: q, Array vl      ->
148
   let var_type = Types.array_element_type var_type in
149
   Format.fprintf fmt "(%a[]){%a }%a" (pp_c_type "") var_type (Utils.fprintf_list ~sep:", " (pp_value_suffix self var_type q pp_value)) vl (pp_suffix pp_value) [loop_var]
121 150
 | _           :: q, Power (v, n)  ->
122
   pp_value_suffix self q pp_value fmt v
151
   pp_value_suffix self var_type q pp_value fmt v
123 152
 | _               , Fun (n, vl)   ->
124
   Basic_library.pp_c n (pp_value_suffix self loop_vars pp_value) fmt vl
153
   Basic_library.pp_c n (pp_value_suffix self var_type loop_vars pp_value) fmt vl
125 154
 | _               , Access (v, i) ->
126
   pp_value_suffix self ((Dimension.mkdim_var (), LAcc i) :: loop_vars) pp_value fmt v
127
 | _               , _             ->
128
   let pp_var_suffix fmt v = fprintf fmt "%a%a" pp_value v pp_suffix loop_vars in
129
   pp_c_val self pp_var_suffix fmt value
155
   let var_type = Type_predef.type_array (Dimension.mkdim_var ()) var_type in
156
   pp_value_suffix self var_type ((Dimension.mkdim_var (), LAcc i) :: loop_vars) pp_value fmt v
157
 | _               , LocalVar v    -> Format.fprintf fmt "%a%a" pp_value v (pp_suffix pp_value) loop_vars
158
 | _               , StateVar v    ->
159
    (* array memory vars are represented by an indirection to a local var with the right type,
160
       in order to avoid casting everywhere. *)
161
   if Types.is_array_type v.var_type
162
   then Format.fprintf fmt "%a%a" pp_value v (pp_suffix pp_value) loop_vars
163
   else Format.fprintf fmt "%s->_reg.%a%a" self pp_value v (pp_suffix pp_value) loop_vars
164
 | _               , Cst cst       -> pp_c_const_suffix var_type fmt cst
165
 | _               , _             -> (Format.eprintf "internal error: C_backend_src.pp_value_suffix %a %a %a@." Types.print_ty var_type Machine_code.pp_val value (pp_suffix pp_value) loop_vars; assert false)
130 166

  
131 167
(* type_directed assignment: array vs. statically sized type
132 168
   - [var_type]: type of variable to be assigned
......
157 193
    match vars with
158 194
    | [] ->
159 195
      fprintf fmt "%a = %a;" 
160
	(pp_value_suffix self loop_vars pp_var) var_name
161
	(pp_value_suffix self loop_vars pp_var) value
196
	(pp_value_suffix self var_type loop_vars pp_var) var_name
197
	(pp_value_suffix self var_type loop_vars pp_var) value
162 198
    | (d, LVar i) :: q ->
163 199
(*eprintf "pp_aux %a %s@." Dimension.pp_dimension d i;*)
164 200
      fprintf fmt "@[<v 2>{@,int %s;@,for(%s=0;%s<%a;%s++)@,%a @]@,}"

Also available in: Unified diff