From 1c768ee3ff91e826f52cf08e1aaa8c4d637240f5 Mon Sep 17 00:00:00 2001 From: xleroy Date: Fri, 20 Dec 2013 13:13:29 +0000 Subject: 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 --- cparser/Machine.ml | 27 ++++-- cparser/Machine.mli | 3 +- cparser/StructReturn.ml | 179 +++++++++++++++++++++++++++------------- test/regression/Results/struct8 | 3 + test/regression/struct8.c | 17 ++++ 5 files changed, 162 insertions(+), 67 deletions(-) diff --git a/cparser/Machine.ml b/cparser/Machine.ml index 7696444c..374e1bb9 100644 --- a/cparser/Machine.ml +++ b/cparser/Machine.ml @@ -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 *) diff --git a/cparser/Machine.mli b/cparser/Machine.mli index b621d4ca..0381bfce 100644 --- a/cparser/Machine.mli +++ b/cparser/Machine.mli @@ -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 diff --git a/cparser/StructReturn.ml b/cparser/StructReturn.ml index ef3e591d..647e27ab 100644 --- a/cparser/StructReturn.ml +++ b/cparser/StructReturn.ml @@ -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} diff --git a/test/regression/Results/struct8 b/test/regression/Results/struct8 index 19ec15d2..ed5690bf 100644 --- a/test/regression/Results/struct8 +++ b/test/regression/Results/struct8 @@ -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' } diff --git a/test/regression/struct8.c b/test/regression/struct8.c index a100cbe3..00a3f7c3 100644 --- a/test/regression/struct8.c +++ b/test/regression/struct8.c @@ -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; } -- cgit