source: Deliverables/D2.3/8051-memoryspaces-branch/cparser/StructByValue.ml @ 460

Last change on this file since 460 was 460, checked in by campbell, 9 years ago

Port memory spaces changes to latest prototype compiler.

File size: 8.6 KB
Line 
1(* *********************************************************************)
2(*                                                                     *)
3(*              The Compcert verified compiler                         *)
4(*                                                                     *)
5(*          Xavier Leroy, INRIA Paris-Rocquencourt                     *)
6(*                                                                     *)
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.     *)
13(*                                                                     *)
14(* *********************************************************************)
15
16(* Eliminate by-value passing of structs and unions. *)
17
18(* Assumes: nothing.
19   Preserves: simplified code, unblocked code *)
20
21open C
22open Cutil
23open Transform
24
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.
28*)
29
30let 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'),
35           None, vararg, attr)
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(Any, tres', [])) :: args'), vararg, attr)
42      end else
43        TFun(tres', Some args', vararg, attr)
44  | TPtr(sp, t1, attr) ->
45      let t1' = transf_type env t1 in
46      if t1' = t1 then t else TPtr(sp, transf_type env t1, attr)
47  | TArray(sp, t1, sz, attr) ->
48      let t1' = transf_type env t1 in
49      if t1' = t1 then t else TArray(sp, transf_type env t1, sz, attr)
50  | _ -> t
51
52and transf_funarg env (id, t) =
53  let t = transf_type env t in
54  if is_composite_type env t
55  then (id, TPtr(Any, add_attributes_type [AConst] t, []))
56  else (id, t)
57
58(* Simple exprs: no change in structure, since calls cannot occur within,
59   but need to rewrite the types. *)
60
61let rec transf_expr env e =
62  { etyp = transf_type env e.etyp;
63    espace = e.espace;
64    edesc = match e.edesc with
65      | EConst c -> EConst c
66      | ESizeof ty -> ESizeof (transf_type env ty)
67      | EVar x -> EVar x
68      | EUnop(op, e1) -> EUnop(op, transf_expr env e1)
69      | EBinop(op, e1, e2, ty) ->
70          EBinop(op, transf_expr env e1, transf_expr env e2, transf_type env ty)
71      | EConditional(e1, e2, e3) ->
72          assert (not (is_composite_type env e.etyp));
73          EConditional(transf_expr env e1, transf_expr env e2, transf_expr env e3)
74      | ECast(ty, e1) -> ECast(transf_type env ty, transf_expr env e1)
75      | ECall(e1, el) -> assert false
76  }
77
78(* Initializers *)
79
80let rec transf_init env = function
81  | Init_single e ->
82      Init_single (transf_expr env e)
83  | Init_array il ->
84      Init_array (List.map (transf_init env) il)
85  | Init_struct(id, fil) ->
86      Init_struct (id, List.map (fun (fld, i) -> (fld, transf_init env i)) fil)
87  | Init_union(id, fld, i) ->
88      Init_union(id, fld, transf_init env i)
89
90(* Declarations *)
91
92let transf_decl env (sto, id, ty, init) =
93  (sto, id, transf_type env ty,
94   match init with None -> None | Some i -> Some (transf_init env i))
95
96(* Transformation of statements and function bodies *)
97
98let transf_funbody env body optres =
99
100let transf_type t = transf_type env t
101and transf_expr e = transf_expr env e in
102
103(* Function arguments: pass by reference those having struct/union type *)
104
105let transf_arg e =
106  let e' = transf_expr e in
107  if is_composite_type env e'.etyp
108  then {edesc = EUnop(Oaddrof, e'); etyp = TPtr(Any, e'.etyp, []); espace = Any} (* XXX: this might require a cast? *)
109  else e'
110in
111
112(* Function calls: if return type is struct or union,
113     lv = f(...)   -> f(&lv, ...)
114     f(...)        -> f(&newtemp, ...)
115   Returns: if return type is struct or union,
116     return x      -> _res = x; return
117*)
118
119let rec transf_stmt s =
120  match s.sdesc with
121  | Sskip -> s
122  | Sdo {edesc = ECall(fn, args); etyp = ty; espace = space} ->
123      let fn = transf_expr fn in
124      let args = List.map transf_arg args in
125      if is_composite_type env ty then begin
126        let tmp = new_temp ~name:"_res" ty in
127        let arg0 = {edesc = EUnop(Oaddrof, tmp); etyp = TPtr(Any, ty, []); espace = Any} in
128        {s with sdesc = Sdo {edesc = ECall(fn, arg0 :: args); etyp = TVoid []; espace = Any}}
129      end else
130        {s with sdesc = Sdo {edesc = ECall(fn, args); etyp = ty; espace = space}}
131  | Sdo {edesc = EBinop(Oassign, dst, {edesc = ECall(fn, args); etyp = ty; espace = space}, _)} ->
132      let dst = transf_expr dst in
133      let fn = transf_expr fn in
134      let args = List.map transf_arg args in
135      let ty = transf_type ty in
136      if is_composite_type env ty then begin
137        let arg0 = {edesc = EUnop(Oaddrof, dst); etyp = TPtr(Any, dst.etyp, []); espace = Any} in
138        {s with sdesc = Sdo {edesc = ECall(fn, arg0 :: args); etyp = TVoid []; espace = Any}}
139      end else
140        sassign s.sloc dst {edesc = ECall(fn, args); etyp = ty; espace = space}
141  | Sdo e ->
142      {s with sdesc = Sdo(transf_expr e)}
143  | Sseq(s1, s2) ->
144      {s with sdesc = Sseq(transf_stmt s1, transf_stmt s2)}
145  | Sif(e, s1, s2) ->
146      {s with sdesc = Sif(transf_expr e, transf_stmt s1, transf_stmt s2)}
147  | Swhile(e, s1) ->
148      {s with sdesc = Swhile(transf_expr e, transf_stmt s1)}
149  | Sdowhile(s1, e) ->
150      {s with sdesc = Sdowhile(transf_stmt s1, transf_expr e)}
151  | Sfor(s1, e, s2, s3) ->
152      {s with sdesc = Sfor(transf_stmt s1, transf_expr e,
153                           transf_stmt s2, transf_stmt s3)}
154  | Sbreak -> s
155  | Scontinue -> s
156  | Sswitch(e, s1) ->
157      {s with sdesc = Sswitch(transf_expr e, transf_stmt s1)}
158  | Slabeled(lbl, s1) ->
159      {s with sdesc = Slabeled(lbl, transf_stmt s1)}
160  | Sgoto lbl -> s
161  | Sreturn None -> s
162  | Sreturn(Some e) ->
163      let e = transf_expr e in
164      begin match optres with
165      | None ->
166          {s with sdesc = Sreturn(Some e)}
167      | Some dst ->
168          sseq s.sloc
169            (sassign s.sloc dst e)
170            {sdesc = Sreturn None; sloc = s.sloc}
171      end
172  | Sblock sl ->
173      {s with sdesc = Sblock(List.map transf_stmt sl)}
174  | Sdecl d ->
175      {s with sdesc = Sdecl(transf_decl env d)}
176
177in
178  transf_stmt body
179
180let transf_params loc env params =
181  let rec transf_prm = function
182  | [] ->
183      ([], [], sskip)
184  | (id, ty) :: params ->
185      let ty = transf_type env ty in
186      if is_composite_type env ty then begin
187        let id' = Env.fresh_ident id.name in
188        let ty' = TPtr(Any, add_attributes_type [AConst] ty, []) in
189        let (params', decls, init) = transf_prm params in
190        ((id', ty') :: params',
191         (Storage_default, id, ty, None) :: decls,
192         sseq loc
193          (sassign loc {edesc = EVar id; etyp = ty; espace = Any}
194                       {edesc = EUnop(Oderef, {edesc = EVar id'; etyp = ty'; espace = Any});
195                        etyp = ty;
196                        espace = Any})
197          init)
198      end else begin
199        let (params', decls, init) = transf_prm params in
200        ((id, ty) :: params', decls, init)
201      end
202  in transf_prm params
203
204let transf_fundef env f =
205  reset_temps();
206  let ret = transf_type env f.fd_ret in
207  let (params, newdecls, init) = transf_params f.fd_body.sloc env f.fd_params in
208  let (ret1, params1, body1) =
209    if is_composite_type env ret then begin
210      let vres = Env.fresh_ident "_res" in
211      let tres = TPtr(Any, ret, []) in
212      let eres = {edesc = EVar vres; etyp = tres; espace = Any} in
213      let eeres = {edesc = EUnop(Oderef, eres); etyp = ret; espace = Any} in
214      (TVoid [],
215       (vres, tres) :: params,
216       transf_funbody env f.fd_body (Some eeres))
217    end else
218      (ret, params, transf_funbody env f.fd_body None) in
219  let body2 = sseq body1.sloc init body1 in
220  let temps = get_temps() in
221  {f with fd_ret = ret1; fd_params = params1;
222          fd_locals = newdecls @ f.fd_locals @ temps; fd_body = body2}
223
224(* Composites *)
225
226let transf_composite env su id fl =
227  List.map (fun f -> {f with fld_typ = transf_type env f.fld_typ}) fl
228
229(* Entry point *)
230
231let program p =
232  Transform.program
233    ~decl:transf_decl
234    ~fundef:transf_fundef
235    ~composite:transf_composite
236    ~typedef:(fun env id ty -> transf_type env ty)
237    p
Note: See TracBrowser for help on using the repository browser.