Revised emulation of packed structs

git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1729 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e

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 */