1 (* *********************************************************************)
3 (* The Compcert verified compiler *)
5 (* Xavier Leroy, INRIA Paris-Rocquencourt *)
7 (* Copyright Institut National de Recherche en Informatique et en *)
8 (* Automatique. All rights reserved. This file is distributed *)
9 (* under the terms of the GNU General Public License as published by *)
10 (* the Free Software Foundation, either version 2 of the License, or *)
11 (* (at your option) any later version. This file is also distributed *)
12 (* under the terms of the INRIA Non-Commercial License Agreement. *)
14 (* *********************************************************************)
16 (* Eliminate by-value passing of structs and unions. *)
19 Preserves: simplified code, unblocked code *)
25 (* In function argument types, struct s -> struct s *
26 In function result types, struct s -> void + add 1st parameter struct s *
27 Try to preserve original typedef names when no change.
30 let rec transf_type env t =
31 match unroll env t with
32 | TFun(tres, None, vararg, attr) ->
33 let tres' = transf_type env tres in
34 TFun((if is_composite_type env tres then TVoid [] else tres'),
36 | TFun(tres, Some args, vararg, attr) ->
37 let args' = List.map (transf_funarg env) args in
38 let tres' = transf_type env tres in
39 if is_composite_type env tres then begin
40 let res = Env.fresh_ident "_res" in
41 TFun(TVoid [], Some((res, TPtr(tres', [])) :: args'), vararg, attr)
43 TFun(tres', Some args', vararg, attr)
45 let t1' = transf_type env t1 in
46 if t1' = t1 then t else TPtr(transf_type env t1, attr)
47 | TArray(t1, sz, attr) ->
48 let t1' = transf_type env t1 in
49 if t1' = t1 then t else TArray(transf_type env t1, sz, attr)
52 and transf_funarg env (id, t) =
53 let t = transf_type env t in
54 if is_composite_type env t
55 then (id, TPtr(add_attributes_type [AConst] t, []))
58 (* Simple exprs: no change in structure, since calls cannot occur within,
59 but need to rewrite the types. *)
61 let rec transf_expr env e =
62 { etyp = transf_type env e.etyp;
63 edesc = match e.edesc with
64 | EConst c -> EConst c
65 | ESizeof ty -> ESizeof (transf_type env ty)
67 | EUnop(op, e1) -> EUnop(op, transf_expr env e1)
68 | EBinop(op, e1, e2, ty) ->
69 EBinop(op, transf_expr env e1, transf_expr env e2, transf_type env ty)
70 | EConditional(e1, e2, e3) ->
71 assert (not (is_composite_type env e.etyp));
72 EConditional(transf_expr env e1, transf_expr env e2, transf_expr env e3)
73 | ECast(ty, e1) -> ECast(transf_type env ty, transf_expr env e1)
74 | ECall(e1, el) -> assert false
79 let rec transf_init env = function
81 Init_single (transf_expr env e)
83 Init_array (List.map (transf_init env) il)
84 | Init_struct(id, fil) ->
85 Init_struct (id, List.map (fun (fld, i) -> (fld, transf_init env i)) fil)
86 | Init_union(id, fld, i) ->
87 Init_union(id, fld, transf_init env i)
91 let transf_decl env (sto, id, ty, init) =
92 (sto, id, transf_type env ty,
93 match init with None -> None | Some i -> Some (transf_init env i))
95 (* Transformation of statements and function bodies *)
97 let transf_funbody env body optres =
99 let transf_type t = transf_type env t
100 and transf_expr e = transf_expr env e in
102 (* Function arguments: pass by reference those having struct/union type *)
105 let e' = transf_expr e in
106 if is_composite_type env e'.etyp
107 then {edesc = EUnop(Oaddrof, e'); etyp = TPtr(e'.etyp, [])}
111 (* Function calls: if return type is struct or union,
112 lv = f(...) -> f(&lv, ...)
113 f(...) -> f(&newtemp, ...)
114 Returns: if return type is struct or union,
115 return x -> _res = x; return
118 let rec transf_stmt s =
121 | Sdo {edesc = ECall(fn, args); etyp = ty} ->
122 let fn = transf_expr fn in
123 let args = List.map transf_arg args in
124 if is_composite_type env ty then begin
125 let tmp = new_temp ~name:"_res" ty in
126 let arg0 = {edesc = EUnop(Oaddrof, tmp); etyp = TPtr(ty, [])} in
127 {s with sdesc = Sdo {edesc = ECall(fn, arg0 :: args); etyp = TVoid []}}
129 {s with sdesc = Sdo {edesc = ECall(fn, args); etyp = ty}}
130 | Sdo {edesc = EBinop(Oassign, dst, {edesc = ECall(fn, args); etyp = ty}, _)} ->
131 let dst = transf_expr dst in
132 let fn = transf_expr fn in
133 let args = List.map transf_arg args in
134 let ty = transf_type ty in
135 if is_composite_type env ty then begin
136 let arg0 = {edesc = EUnop(Oaddrof, dst); etyp = TPtr(dst.etyp, [])} in
137 {s with sdesc = Sdo {edesc = ECall(fn, arg0 :: args); etyp = TVoid []}}
139 sassign s.sloc dst {edesc = ECall(fn, args); etyp = ty}
141 {s with sdesc = Sdo(transf_expr e)}
143 {s with sdesc = Sseq(transf_stmt s1, transf_stmt s2)}
145 {s with sdesc = Sif(transf_expr e, transf_stmt s1, transf_stmt s2)}
147 {s with sdesc = Swhile(transf_expr e, transf_stmt s1)}
149 {s with sdesc = Sdowhile(transf_stmt s1, transf_expr e)}
150 | Sfor(s1, e, s2, s3) ->
151 {s with sdesc = Sfor(transf_stmt s1, transf_expr e,
152 transf_stmt s2, transf_stmt s3)}
156 {s with sdesc = Sswitch(transf_expr e, transf_stmt s1)}
157 | Slabeled(lbl, s1) ->
158 {s with sdesc = Slabeled(lbl, transf_stmt s1)}
162 let e = transf_expr e in
163 begin match optres with
165 {s with sdesc = Sreturn(Some e)}
168 (sassign s.sloc dst e)
169 {sdesc = Sreturn None; sloc = s.sloc}
172 {s with sdesc = Sblock(List.map transf_stmt sl)}
174 {s with sdesc = Sdecl(transf_decl env d)}
179 let transf_params loc env params =
180 let rec transf_prm = function
183 | (id, ty) :: params ->
184 let ty = transf_type env ty in
185 if is_composite_type env ty then begin
186 let id' = Env.fresh_ident id.name in
187 let ty' = TPtr(add_attributes_type [AConst] ty, []) in
188 let (params', decls, init) = transf_prm params in
189 ((id', ty') :: params',
190 (Storage_default, id, ty, None) :: decls,
192 (sassign loc {edesc = EVar id; etyp = ty}
193 {edesc = EUnop(Oderef, {edesc = EVar id'; etyp = ty'});
197 let (params', decls, init) = transf_prm params in
198 ((id, ty) :: params', decls, init)
202 let transf_fundef env f =
204 let ret = transf_type env f.fd_ret in
205 let (params, newdecls, init) = transf_params f.fd_body.sloc env f.fd_params in
206 let (ret1, params1, body1) =
207 if is_composite_type env ret then begin
208 let vres = Env.fresh_ident "_res" in
209 let tres = TPtr(ret, []) in
210 let eres = {edesc = EVar vres; etyp = tres} in
211 let eeres = {edesc = EUnop(Oderef, eres); etyp = ret} in
213 (vres, tres) :: params,
214 transf_funbody env f.fd_body (Some eeres))
216 (ret, params, transf_funbody env f.fd_body None) in
217 let body2 = sseq body1.sloc init body1 in
218 let temps = get_temps() in
219 {f with fd_ret = ret1; fd_params = params1;
220 fd_locals = newdecls @ f.fd_locals @ temps; fd_body = body2}
224 let transf_composite env su id fl =
225 List.map (fun f -> {f with fld_typ = transf_type env f.fld_typ}) fl
232 ~fundef:transf_fundef
233 ~composite:transf_composite
234 ~typedef:(fun env id ty -> transf_type env ty)