From 7e378c0215c99d7f8bd38341081ec04fd202fd0a Mon Sep 17 00:00:00 2001 From: xleroy Date: Sun, 16 Oct 2011 07:37:28 +0000 Subject: Revised emulation of packed structs git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1729 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e --- cparser/Cutil.ml | 4 +- cparser/PackedStructs.ml | 105 ++++++++++++++++------------------ ia32/CBuiltins.ml | 8 +-- ia32/PrintAsm.ml | 8 +-- powerpc/CBuiltins.ml | 8 +-- powerpc/PrintAsm.ml | 8 +-- test/regression/Results/packedstruct1 | 4 +- test/regression/packedstruct1.c | 14 ++++- 8 files changed, 83 insertions(+), 76 deletions(-) diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml index 448f488e..40b55e9c 100644 --- a/cparser/Cutil.ml +++ b/cparser/Cutil.ml @@ -731,11 +731,13 @@ let eassign e1 e2 = { edesc = EBinop(Oassign, e1, e2, e1.etyp); etyp = e1.etyp } let ecomma e1 e2 = { edesc = EBinop(Ocomma, e1, e2, e2.etyp); etyp = e2.etyp } (* Construct an address-of expression. Can be applied not just to - an l-value but also to a sequence. *) + an l-value but also to a sequence or a conditional of l-values. *) let rec eaddrof e = match e.edesc with | EBinop(Ocomma, e1, e2, _) -> ecomma e1 (eaddrof e2) + | EConditional(e1, e2, e3) -> + { edesc = EConditional(e1, eaddrof e2, eaddrof e3); etyp = TPtr(e.etyp, []) } | _ -> { edesc = EUnop(Oaddrof, e); etyp = TPtr(e.etyp, []) } (* Construct a sequence *) diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml index 4b5d0e1d..5e0a0329 100644 --- a/cparser/PackedStructs.ml +++ b/cparser/PackedStructs.ml @@ -16,6 +16,7 @@ (* Emulation of #pragma pack (experimental) *) open Printf +open Machine open C open Cutil open Env @@ -24,7 +25,7 @@ open Transform type field_info = { fi_offset: int; (* byte offset within struct *) - fi_swap: ikind option (* Some ik if byte-swapped *) + fi_swap: bool (* true if byte-swapped *) } (* Mapping from (struct name, field name) to field_info. @@ -59,22 +60,12 @@ let layout_struct mfa msa swapped loc env struct_id fields = if f.fld_bitfield <> None then error "%a: Error: bitfields in packed structs not allowed" formatloc loc; - let swap = - if swapped then begin - match unroll env f.fld_typ with - | TInt(ik, _) -> - if sizeof_ikind ik = 1 then None else Some ik - | _ -> - error "%a: Error: byte-swapped fields must have integer type" - formatloc loc; - None - end else - None in let (sz, al) = match sizeof env f.fld_typ, alignof env f.fld_typ with | Some s, Some a -> (s, a) | _, _ -> error "%a: struct field has incomplete type" formatloc loc; (0, 1) in + let swap = swapped && sz > 1 in let al1 = min al mfa in let pos1 = align pos al1 in Hashtbl.add packed_fields @@ -123,9 +114,22 @@ let lookup_function loc env name = with Env.Error msg -> fatal_error "%a: Error: %s" formatloc loc (Env.error_message msg) +(* Type for the access *) + +let accessor_type loc env ty = + match unroll env ty with + | TInt(ik,_) -> (8 * sizeof_ikind ik, TInt(unsigned_ikind_of ik,[])) + | TPtr _ -> (8 * !config.sizeof_ptr, TInt(ptr_t_ikind,[])) + | _ -> + error "%a: unsupported type for byte-swapped field access" formatloc loc; + (32, TVoid []) + (* (ty) e *) let ecast ty e = {edesc = ECast(ty, e); etyp = ty} +let ecast_opt env ty e = + if compatible_types env ty e.etyp then e else ecast ty e + (* *e *) let ederef ty e = {edesc = EUnop(Oderef, e); etyp = ty} @@ -148,32 +152,26 @@ let arrow_packed_field base pf ty = etyp = TArray(TInt(IChar,[]),None,[]) } in ederef ty (ecast (TPtr(ty, [])) (eoffset payload pf.fi_offset)) -(* (ty) __builtin_read_intNN_reversed(&lval) *) -let bswap_read loc env lval ik = - let uik = unsigned_ikind_of ik in - let bsize = sizeof_ikind ik * 8 in +(* (ty) __builtin_read_NN_reversed(&lval) *) +let bswap_read loc env lval ty = + let (bsize, aty) = + accessor_type loc env ty in let (id, fty) = - lookup_function loc env (sprintf "__builtin_read_int%d_reversed" bsize) in + lookup_function loc env (sprintf "__builtin_read%d_reversed" bsize) in let fn = {edesc = EVar id; etyp = fty} in - let args = - if uik = ik - then [eaddrof lval] - else [ecast (TPtr(TInt(uik,[]),[])) (eaddrof lval)] in - let call = {edesc = ECall(fn, args); etyp = TInt(uik, [])} in - if ik = uik then call else ecast (TInt(ik,[])) call + let args = [ecast (TPtr(aty,[])) (eaddrof lval)] in + let call = {edesc = ECall(fn, args); etyp = aty} in + ecast_opt env ty call (* __builtin_write_intNN_reversed(&lhs,rhs) *) -let bswap_write loc env lhs rhs ik = - let uik = unsigned_ikind_of ik in - let bsize = sizeof_ikind ik * 8 in +let bswap_write loc env lhs rhs ty = + let (bsize, aty) = + accessor_type loc env ty in let (id, fty) = - lookup_function loc env (sprintf "__builtin_write_int%d_reversed" bsize) in + lookup_function loc env (sprintf "__builtin_write%d_reversed" bsize) in let fn = {edesc = EVar id; etyp = fty} in - let args = - if uik = ik - then [eaddrof lhs; rhs] - else [ecast (TPtr(TInt(uik,[]),[])) (eaddrof lhs); - ecast (TInt(uik,[])) rhs] in + let args = [ecast_opt env (TPtr(aty,[])) (eaddrof lhs); + ecast_opt env aty rhs] in {edesc = ECall(fn, args); etyp = TVoid[]} (* Expressions *) @@ -193,15 +191,14 @@ let transf_expr loc env ctx e = | _ -> None in (* Transformation of l-values. Return transformed expr plus - [Some ik] if l-value is a byte-swapped field of kind [ik] - or [None] otherwise. *) + [true] if l-value is a byte-swapped field and [false] otherwise. *) let rec lvalue e = match e.edesc with | EUnop(Odot fieldname, e1) -> let e1' = texp Val e1 in begin match is_packed_access e1.etyp fieldname with | None -> - ({edesc = EUnop(Odot fieldname, e1'); etyp = e.etyp}, None) + ({edesc = EUnop(Odot fieldname, e1'); etyp = e.etyp}, false) | Some pf -> (dot_packed_field e1' pf e.etyp, pf.fi_swap) end @@ -209,12 +206,15 @@ let transf_expr loc env ctx e = let e1' = texp Val e1 in begin match is_packed_access_ptr e1.etyp fieldname with | None -> - ({edesc = EUnop(Oarrow fieldname, e1'); etyp = e.etyp}, None) + ({edesc = EUnop(Oarrow fieldname, e1'); etyp = e.etyp}, false) | Some pf -> (arrow_packed_field e1' pf e.etyp, pf.fi_swap) end + | EBinop(Oindex, e1, e2, tyres) -> + let (e1', swap) = lvalue e1 in + ({edesc = EBinop(Oindex, e1', e2, tyres); etyp = e.etyp}, swap) | _ -> - (texp Val e, None) + (texp Val e, false) and texp ctx e = match e.edesc with @@ -222,17 +222,14 @@ let transf_expr loc env ctx e = | ESizeof _ -> e | EVar _ -> e - | EUnop(Odot _, _) | EUnop(Oarrow _, _) -> + | EUnop(Odot _, _) | EUnop(Oarrow _, _) | EBinop(Oindex, _, _, _) -> let (e', swap) = lvalue e in - begin match swap with - | None -> e' - | Some ik -> bswap_read loc env e' ik - end + if swap then bswap_read loc env e' e'.etyp else e' | EUnop((Oaddrof|Opreincr|Opredecr|Opostincr|Opostdecr as op), e1) -> let (e1', swap) = lvalue e1 in - if swap <> None then - error "%a: Error: &, ++ and -- over byte-swap field are not supported" + if swap then + error "%a: Error: &, ++ and -- over byte-swapped field are not supported" formatloc loc; {edesc = EUnop(op, e1'); etyp = e.etyp} @@ -242,23 +239,21 @@ let transf_expr loc env ctx e = | EBinop(Oassign, e1, e2, ty) -> let (e1', swap) = lvalue e1 in let e2' = texp Val e2 in - begin match swap with - | None -> - {edesc = EBinop(Oassign, e1', e2', ty); etyp = e.etyp} - | Some ik -> - if ctx <> Effects then - error "%a: Error: assignment over byte-swapped field in value context is not supported" - formatloc loc; - bswap_write loc env e1' e2' ik - end + if swap then begin + if ctx <> Effects then + error "%a: Error: assignment over byte-swapped field in value context is not supported" + formatloc loc; + bswap_write loc env e1' e2' e1'.etyp + end else + {edesc = EBinop(Oassign, e1', e2', ty); etyp = e.etyp} | EBinop((Oadd_assign|Osub_assign|Omul_assign|Odiv_assign|Omod_assign| Oand_assign|Oor_assign|Oxor_assign|Oshl_assign|Oshr_assign as op), e1, e2, ty) -> let (e1', swap) = lvalue e1 in let e2' = texp Val e2 in - if swap <> None then - error "%a: Error: op-assignment over byte-swapped field in value context is not supported" + if swap then + error "%a: Error: op-assignment over byte-swapped field is not supported" formatloc loc; {edesc = EBinop(op, e1', e2', ty); etyp = e.etyp} diff --git a/ia32/CBuiltins.ml b/ia32/CBuiltins.ml index 3b94744c..c2fd06d9 100644 --- a/ia32/CBuiltins.ml +++ b/ia32/CBuiltins.ml @@ -32,13 +32,13 @@ let builtins = { "__builtin_fmin", (TFloat(FDouble, []), [TFloat(FDouble, []); TFloat(FDouble, [])], false); (* Memory accesses *) - "__builtin_read_int16_reversed", + "__builtin_read16_reversed", (TInt(IUShort, []), [TPtr(TInt(IUShort, [AConst]), [])], false); - "__builtin_read_int32_reversed", + "__builtin_read32_reversed", (TInt(IUInt, []), [TPtr(TInt(IUInt, [AConst]), [])], false); - "__builtin_write_int16_reversed", + "__builtin_write16_reversed", (TVoid [], [TPtr(TInt(IUShort, []), []); TInt(IUShort, [])], false); - "__builtin_write_int32_reversed", + "__builtin_write32_reversed", (TVoid [], [TPtr(TInt(IUInt, []), []); TInt(IUInt, [])], false); ] } diff --git a/ia32/PrintAsm.ml b/ia32/PrintAsm.ml index ec3db779..f48b8080 100644 --- a/ia32/PrintAsm.ml +++ b/ia32/PrintAsm.ml @@ -405,22 +405,22 @@ let print_builtin_inline oc name args res = fprintf oc "%s begin builtin %s\n" comment name; begin match name, args, res with (* Memory accesses *) - | "__builtin_read_int16_reversed", [IR a1], IR res -> + | "__builtin_read16_reversed", [IR a1], IR res -> let tmp = if Asmgen.low_ireg res then res else ECX in fprintf oc " movzwl 0(%a), %a\n" ireg a1 ireg tmp; fprintf oc " xchg %a, %a\n" ireg8 tmp high_ireg8 tmp; if tmp <> res then fprintf oc " movl %a, %a\n" ireg tmp ireg res - | "__builtin_read_int32_reversed", [IR a1], IR res -> + | "__builtin_read32_reversed", [IR a1], IR res -> fprintf oc " movl 0(%a), %a\n" ireg a1 ireg res; fprintf oc " bswap %a\n" ireg res - | "__builtin_write_int16_reversed", [IR a1; IR a2], _ -> + | "__builtin_write16_reversed", [IR a1; IR a2], _ -> let tmp = if a1 = ECX then EDX else ECX in if a2 <> tmp then fprintf oc " movl %a, %a\n" ireg a2 ireg tmp; fprintf oc " xchg %a, %a\n" ireg8 tmp high_ireg8 tmp; fprintf oc " movw %a, 0(%a)\n" ireg16 tmp ireg a1 - | "__builtin_write_int32_reversed", [IR a1; IR a2], _ -> + | "__builtin_write32_reversed", [IR a1; IR a2], _ -> let tmp = if a1 = ECX then EDX else ECX in if a2 <> tmp then fprintf oc " movl %a, %a\n" ireg a2 ireg tmp; diff --git a/powerpc/CBuiltins.ml b/powerpc/CBuiltins.ml index 6b683806..076288ed 100644 --- a/powerpc/CBuiltins.ml +++ b/powerpc/CBuiltins.ml @@ -50,13 +50,13 @@ let builtins = { [TFloat(FDouble, []); TFloat(FDouble, []); TFloat(FDouble, [])], false); (* Memory accesses *) - "__builtin_read_int16_reversed", + "__builtin_read16_reversed", (TInt(IUShort, []), [TPtr(TInt(IUShort, [AConst]), [])], false); - "__builtin_read_int32_reversed", + "__builtin_read32_reversed", (TInt(IUInt, []), [TPtr(TInt(IUInt, [AConst]), [])], false); - "__builtin_write_int16_reversed", + "__builtin_write16_reversed", (TVoid [], [TPtr(TInt(IUShort, []), []); TInt(IUShort, [])], false); - "__builtin_write_int32_reversed", + "__builtin_write32_reversed", (TVoid [], [TPtr(TInt(IUInt, []), []); TInt(IUInt, [])], false); (* Synchronization *) "__builtin_eieio", diff --git a/powerpc/PrintAsm.ml b/powerpc/PrintAsm.ml index 68e607b9..3b90ada8 100644 --- a/powerpc/PrintAsm.ml +++ b/powerpc/PrintAsm.ml @@ -450,13 +450,13 @@ let print_builtin_inline oc name args res = | "__builtin_fsel", [FR a1; FR a2; FR a3], FR res -> fprintf oc " fsel %a, %a, %a, %a\n" freg res freg a1 freg a2 freg a3 (* Memory accesses *) - | "__builtin_read_int16_reversed", [IR a1], IR res -> + | "__builtin_read16_reversed", [IR a1], IR res -> fprintf oc " lhbrx %a, %a, %a\n" ireg res ireg_or_zero GPR0 ireg a1 - | "__builtin_read_int32_reversed", [IR a1], IR res -> + | "__builtin_read32_reversed", [IR a1], IR res -> fprintf oc " lwbrx %a, %a, %a\n" ireg res ireg_or_zero GPR0 ireg a1 - | "__builtin_write_int16_reversed", [IR a1; IR a2], _ -> + | "__builtin_write16_reversed", [IR a1; IR a2], _ -> fprintf oc " sthbrx %a, %a, %a\n" ireg a2 ireg_or_zero GPR0 ireg a1 - | "__builtin_write_int32_reversed", [IR a1; IR a2], _ -> + | "__builtin_write32_reversed", [IR a1; IR a2], _ -> fprintf oc " stwbrx %a, %a, %a\n" ireg a2 ireg_or_zero GPR0 ireg a1 (* Synchronization *) | "__builtin_eieio", [], _ -> diff --git a/test/regression/Results/packedstruct1 b/test/regression/Results/packedstruct1 index fe19bffc..75491328 100644 --- a/test/regression/Results/packedstruct1 +++ b/test/regression/Results/packedstruct1 @@ -7,8 +7,8 @@ sizeof(struct s2) = 16 offsetof(x) = 0, offsetof(y) = 2, offsetof(z) = 6 s2 = {x = 57, y = -456, z = 3.14159} -sizeof(struct s3) = 13 -s3 = {x = 123, y = 45678, z = 2147483649, v = -456, w = -1234567} +sizeof(struct s3) = 29 +s3 = {x = 123, y = 45678, z = 2147483649, v = -456, w = -1234567, p is ok, t = {111,222,333}} sizeof(struct s4) = 16 offsetof(x) = 0, offsetof(y) = 4, offsetof(z) = 8 diff --git a/test/regression/packedstruct1.c b/test/regression/packedstruct1.c index 1bde780e..cecd1f30 100644 --- a/test/regression/packedstruct1.c +++ b/test/regression/packedstruct1.c @@ -50,20 +50,30 @@ struct s3 { unsigned int z; signed short v; signed int w; + char * p; + unsigned int t[3]; }; struct s3 s3; void test3(void) { + char xx; + printf("sizeof(struct s3) = %d\n", sizeof(struct s3)); s3.x = 123; s3.y = 45678; s3.z = 0x80000001U; s3.v = -456; s3.w = -1234567; - printf("s3 = {x = %u, y = %u, z = %u, v = %d, w = %d}\n\n", - s3.x, s3.y, s3.z, s3.v, s3.w); + s3.p = &xx; + s3.t[0] = 111; + s3.t[1] = 222; + s3.t[2] = 333; + printf("s3 = {x = %u, y = %u, z = %u, v = %d, w = %d, p is %s, t = {%d,%d,%d}}\n\n", + s3.x, s3.y, s3.z, s3.v, s3.w, + (s3.p == &xx ? "ok" : "BAD"), + s3.t[0], s3.t[1], s3.t[2]); } /* Back to normal */ -- cgit