Commit 1c768ee3 authored by xleroy's avatar xleroy
Browse files

Hack StructReturn to better adhere to PowerPC and ARM calling conventions.


git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@2382 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e
parent 7698300c
......@@ -42,7 +42,8 @@ type t = {
alignof_void: int option;
alignof_fun: int option;
bigendian: bool;
bitfields_msb_first: bool
bitfields_msb_first: bool;
struct_return_as_int: int
}
let ilp32ll64 = {
......@@ -72,7 +73,8 @@ let ilp32ll64 = {
alignof_void = None;
alignof_fun = None;
bigendian = false;
bitfields_msb_first = false
bitfields_msb_first = false;
struct_return_as_int = 0
}
let i32lpll64 = {
......@@ -102,7 +104,8 @@ let i32lpll64 = {
alignof_void = None;
alignof_fun = None;
bigendian = false;
bitfields_msb_first = false
bitfields_msb_first = false;
struct_return_as_int = 0
}
let il32pll64 = {
......@@ -132,20 +135,26 @@ let il32pll64 = {
alignof_void = None;
alignof_fun = None;
bigendian = false;
bitfields_msb_first = false
bitfields_msb_first = false;
struct_return_as_int = 0
}
(* Canned configurations for some ABIs *)
let x86_32 =
{ ilp32ll64 with char_signed = true; name = "x86_32" }
{ ilp32ll64 with name = "x86_32"; char_signed = true }
let x86_64 =
{ i32lpll64 with char_signed = true; name = "x86_64" }
{ i32lpll64 with name = "x86_64"; char_signed = true }
let win64 =
{ il32pll64 with char_signed = true; name = "x86_64" }
{ il32pll64 with name = "x86_64"; char_signed = true }
let ppc_32_bigendian =
{ ilp32ll64 with bigendian = true; bitfields_msb_first = true; name = "powerpc" }
let arm_littleendian = { ilp32ll64 with name = "arm" }
{ ilp32ll64 with name = "powerpc";
bigendian = true;
bitfields_msb_first = true;
struct_return_as_int = 8 }
let arm_littleendian =
{ ilp32ll64 with name = "arm";
struct_return_as_int = 4 }
(* Add GCC extensions re: sizeof and alignof *)
......
......@@ -42,7 +42,8 @@ type t = {
alignof_void: int option;
alignof_fun: int option;
bigendian: bool;
bitfields_msb_first: bool
bitfields_msb_first: bool;
struct_return_as_int: int
}
val ilp32ll64 : t
......
......@@ -14,13 +14,36 @@
(* *********************************************************************)
(* Eliminate structs and unions being returned by value as function results *)
(* This is a simpler special case of [StructByValue]. *)
open Machine
open C
open Cutil
open Transform
(* In function result types, struct s -> void + add 1st parameter struct s *
(* Classification of function return types. *)
type return_kind =
| Ret_scalar (**r a scalar type, returned as usual *)
| Ret_ref (**r a composite type, returned by reference *)
| Ret_value of typ (**r a small composite type, returned as an integer *)
let classify_return env ty =
if is_composite_type env ty then begin
match sizeof env ty with
| None -> Ret_ref (* should not happen *)
| Some sz ->
if (!config).struct_return_as_int >= 4 && sz <= 4 then
Ret_value (TInt(IUInt, []))
else if (!config).struct_return_as_int >= 8 && sz <= 8 then
Ret_value (TInt(IULongLong, []))
else Ret_ref
end else
Ret_scalar
(* Rewriting of function types.
return kind scalar -> no change
return kind ref -> return type void + add 1st parameter struct s *
return kind value(t) -> return type t.
Try to preserve original typedef names when no change.
*)
......@@ -28,16 +51,24 @@ let rec transf_type env t =
match unroll env t with
| TFun(tres, None, vararg, attr) ->
let tres' = transf_type env tres in
TFun((if is_composite_type env tres then TVoid [] else tres'),
None, vararg, attr)
let tres'' =
match classify_return env tres with
| Ret_scalar -> tres'
| Ret_ref -> TVoid []
| Ret_value ty -> ty in
TFun(tres'', None, vararg, attr)
| TFun(tres, Some args, vararg, attr) ->
let args' = List.map (transf_funarg env) args in
let tres' = transf_type env tres in
if is_composite_type env tres then begin
let res = Env.fresh_ident "_res" in
TFun(TVoid [], Some((res, TPtr(tres', [])) :: args'), vararg, attr)
end else
TFun(tres', Some args', vararg, attr)
begin match classify_return env tres with
| Ret_scalar ->
TFun(tres', Some args', vararg, attr)
| Ret_ref ->
let res = Env.fresh_ident "_res" in
TFun(TVoid [], Some((res, TPtr(tres', [])) :: args'), vararg, attr)
| Ret_value ty ->
TFun(ty, Some args', vararg, attr)
end
| TPtr(t1, attr) ->
let t1' = transf_type env t1 in
if t1' = t1 then t else TPtr(transf_type env t1, attr)
......@@ -50,6 +81,9 @@ and transf_funarg env (id, t) = (id, transf_type env t)
(* Expressions: transform calls + rewrite the types *)
let ereinterpret ty e =
{ edesc = EUnop(Oderef, ecast (TPtr(ty, [])) (eaddrof e)); etyp = ty }
let rec transf_expr env ctx e =
let newty = transf_type env e.etyp in
match e.edesc with
......@@ -63,9 +97,8 @@ let rec transf_expr env ctx e =
{edesc = EVar x; etyp = newty}
| EUnop(op, e1) ->
{edesc = EUnop(op, transf_expr env Val e1); etyp = newty}
| EBinop(Oassign, lhs, {edesc = ECall(fn, args)}, ty)
when is_composite_type env ty ->
transf_composite_call env ctx (Some lhs) fn args ty
| EBinop(Oassign, lhs, {edesc = ECall(fn, args)}, ty) ->
transf_call env ctx (Some lhs) fn args ty
| EBinop(Ocomma, e1, e2, ty) ->
ecomma (transf_expr env Effects e1) (transf_expr env ctx e2)
| EBinop(op, e1, e2, ty) ->
......@@ -81,39 +114,59 @@ let rec transf_expr env ctx e =
| ECast(ty, e1) ->
{edesc = ECast(transf_type env ty, transf_expr env Val e1); etyp = newty}
| ECall(fn, args) ->
if is_composite_type env e.etyp then
transf_composite_call env ctx None fn args e.etyp
else
{edesc = ECall(transf_expr env Val fn,
List.map (transf_expr env Val) args);
etyp = newty}
(* Function calls returning a composite: add first argument.
transf_call env ctx None fn args e.etyp
(* Function calls returning a composite by reference: add first argument.
ctx = Effects: lv = f(...) -> f(&lv, ...) [copy optimization]
f(...) -> f(&newtemp, ...)
ctx = Val: lv = f(...) -> f(&newtemp, ...), lv = newtemp
f(...) -> f(&newtemp, ...), newtemp
Function calls returning a composite by value:
ctx = Effects: lv = f(...) -> newtemp = f(...), lv = newtemp
f(...) -> f(...)
ctx = Val: lv = f(...) -> newtemp = f(...), lv = newtemp
f(...) -> newtemp = f(...), newtemp
*)
and transf_composite_call env ctx opt_lhs fn args ty =
let ty = transf_type env ty in
let fn = transf_expr env Val fn in
let args = List.map (transf_expr env Val) args in
match ctx, opt_lhs with
| Effects, None ->
let tmp = new_temp ~name:"_res" ty in
{edesc = ECall(fn, eaddrof tmp :: args); etyp = TVoid []}
| Effects, Some lhs ->
let lhs = transf_expr env Val lhs in
{edesc = ECall(fn, eaddrof lhs :: args); etyp = TVoid []}
| Val, None ->
let tmp = new_temp ~name:"_res" ty in
ecomma {edesc = ECall(fn, eaddrof tmp :: args); etyp = TVoid []} tmp
| Val, Some lhs ->
let lhs = transf_expr env Val lhs in
let tmp = new_temp ~name:"_res" ty in
ecomma {edesc = ECall(fn, eaddrof tmp :: args); etyp = TVoid []}
(eassign lhs tmp)
and transf_call env ctx opt_lhs fn args ty =
let ty' = transf_type env ty in
let fn' = transf_expr env Val fn in
let args' = List.map (transf_expr env Val) args in
let opt_eassign e =
match opt_lhs with
| None -> e
| Some lhs -> eassign (transf_expr env Val lhs) e in
match classify_return env ty with
| Ret_scalar ->
opt_eassign {edesc = ECall(fn', args'); etyp = ty'}
| Ret_ref ->
begin match ctx, opt_lhs with
| Effects, None ->
let tmp = new_temp ~name:"_res" ty in
{edesc = ECall(fn', eaddrof tmp :: args'); etyp = TVoid []}
| Effects, Some lhs ->
let lhs' = transf_expr env Val lhs in
{edesc = ECall(fn', eaddrof lhs' :: args'); etyp = TVoid []}
| Val, None ->
let tmp = new_temp ~name:"_res" ty in
ecomma {edesc = ECall(fn', eaddrof tmp :: args'); etyp = TVoid []} tmp
| Val, Some lhs ->
let lhs' = transf_expr env Val lhs in
let tmp = new_temp ~name:"_res" ty in
ecomma {edesc = ECall(fn', eaddrof tmp :: args'); etyp = TVoid []}
(eassign lhs' tmp)
end
| Ret_value ty_ret ->
let ecall = {edesc = ECall(fn', args'); etyp = ty_ret} in
begin match ctx, opt_lhs with
| Effects, None ->
ecall
| _, _ ->
let tmp = new_temp ~name:"_res" ty_ret in
opt_eassign
(ecomma (eassign tmp ecall)
(ereinterpret ty' tmp))
end
(* Initializers *)
......@@ -139,8 +192,10 @@ let transf_funbody env body optres =
let transf_expr ctx e = transf_expr env ctx e in
(* Function returns: if return type is struct or union,
return x -> _res = x; return
(* Function returns:
return kind scalar -> return e
return kind ref -> _res = x; return
return kind value ty -> *((struct s * )_res) = x; return _res
*)
let rec transf_stmt s =
......@@ -169,14 +224,20 @@ let rec transf_stmt s =
| Sgoto lbl -> s
| Sreturn None -> s
| Sreturn(Some e) ->
let e = transf_expr Val e in
begin match optres with
| None ->
{s with sdesc = Sreturn(Some e)}
| Some dst ->
let e' = transf_expr Val e in
begin match classify_return env e'.etyp, optres with
| Ret_scalar, None ->
{s with sdesc = Sreturn(Some e')}
| Ret_ref, Some dst ->
sseq s.sloc
(sassign s.sloc dst e)
(sassign s.sloc dst e')
{sdesc = Sreturn None; sloc = s.sloc}
| Ret_value ty, Some dst ->
sseq s.sloc
(sassign s.sloc (ereinterpret e'.etyp dst) e')
{sdesc = Sreturn (Some dst); sloc = s.sloc}
| _, _ ->
assert false
end
| Sblock sl ->
{s with sdesc = Sblock(List.map transf_stmt sl)}
......@@ -193,16 +254,20 @@ let transf_fundef env f =
let params =
List.map (fun (id, ty) -> (id, transf_type env ty)) f.fd_params in
let (ret1, params1, body1) =
if is_composite_type env ret then begin
let vres = Env.fresh_ident "_res" in
let tres = TPtr(ret, []) in
let eres = {edesc = EVar vres; etyp = tres} in
let eeres = {edesc = EUnop(Oderef, eres); etyp = ret} in
(TVoid [],
(vres, tres) :: params,
transf_funbody env f.fd_body (Some eeres))
end else
(ret, params, transf_funbody env f.fd_body None) in
match classify_return env f.fd_ret with
| Ret_scalar ->
(ret, params, transf_funbody env f.fd_body None)
| Ret_ref ->
let vres = Env.fresh_ident "_res" in
let tres = TPtr(ret, []) in
let eres = {edesc = EVar vres; etyp = tres} in
let eeres = {edesc = EUnop(Oderef, eres); etyp = ret} in
(TVoid [],
(vres, tres) :: params,
transf_funbody env f.fd_body (Some eeres))
| Ret_value ty ->
let eres = new_temp ~name:"_res" ty in
(ty, params, transf_funbody env f.fd_body (Some eres)) in
let temps = get_temps() in
{f with fd_ret = ret1; fd_params = params1;
fd_locals = f.fd_locals @ temps; fd_body = body1}
......
......@@ -3,3 +3,6 @@ b = { 125, 5.436000, 'f' }
c = { 128, 16.308000, 'f' }
d = { 125, 5.436000, 'f' }
e = { 128, 16.308000, 'f' }
x = { 'x', 'y' }
y = { 'y', 'x' }
z = { 'x', 'y' }
......@@ -13,17 +13,34 @@ struct S f(struct S s, int scale)
return r;
}
struct T { char a, b; };
struct T g(struct T s)
{
struct T r;
r.a = s.b;
r.b = s.a;
return r;
}
int main()
{
struct S a = { 123, 2.718, 'a' };
struct S b, c, d, e;
struct T x = { 'x', 'y' };
struct T y, z;
b = f(a, 2);
c = f(f(a, 2), 3);
e = f((d = f(a, 2)), 3);
y = g(x);
z = g(g(x));
printf("a = { %d, %f, '%c' }\n", a.x, a.d, a.c);
printf("b = { %d, %f, '%c' }\n", b.x, b.d, b.c);
printf("c = { %d, %f, '%c' }\n", c.x, c.d, c.c);
printf("d = { %d, %f, '%c' }\n", d.x, d.d, d.c);
printf("e = { %d, %f, '%c' }\n", e.x, e.d, e.c);
printf("x = { '%c', '%c' }\n", x.a, x.b);
printf("y = { '%c', '%c' }\n", y.a, y.b);
printf("z = { '%c', '%c' }\n", z.a, z.b);
return 0;
}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment