Cprint: export Cprint.attributes

PackedStructs: honor 'aligned' attribute on packed struct fields
C2C: warn for ignored 'aligned' attributes


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

1 files changed, 24 insertions, 6 deletions

diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml
index ebdd86b6..f926ece2 100644
--- a/cparser/PackedStructs.ml
+++ b/cparser/PackedStructs.ml
@@ -49,7 +49,7 @@ let byte_swap_fields = ref false
 (* Alignment *)
 
 let is_pow2 n =
-  n > 0 && n land (n - 1) == 0
+  n > 0 && n land (n - 1) = 0
 
 let align x boundary =
   assert (is_pow2 boundary);
@@ -64,6 +64,28 @@ let rec can_byte_swap env ty =
   | TArray(ty_elt, _, _) -> can_byte_swap env ty_elt
   | _ -> (false, false)
 
+(* Compute size and alignment of a type, taking "aligned" attributes
+   into account *)
+
+let sizeof_alignof loc env ty =
+  match sizeof env ty, alignof env ty with
+  | Some sz, Some al ->
+      begin match find_custom_attributes ["aligned"; "__aligned__"]
+                                      (attributes_of_type env ty) with
+      | [] ->
+          (sz, al)
+      | [[AInt n]] when is_pow2 (Int64.to_int n) ->
+          let al' = max al (Int64.to_int n) in
+          (align sz al', al')
+      | _ ->
+          warning "%a: Warning: Ill-formed 'aligned' attribute, ignored"
+                  formatloc loc;
+          (sz, al)
+      end
+  | _, _ ->
+      error "%a: Error: struct field has incomplete type" formatloc loc;
+      (0, 1)
+
 (* Layout algorithm *)
 
 let layout_struct mfa msa swapped loc env struct_id fields =
@@ -74,11 +96,7 @@ 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 (sz, al) =
-        match sizeof env f.fld_typ, alignof env f.fld_typ with
-        | Some s, Some a -> (s, a)
-        | _, _ -> error "%a: Error: struct field has incomplete type" formatloc loc;
-                  (0, 1) in
+      let (sz, al) = sizeof_alignof loc env f.fld_typ in
       let swap =
         if swapped then begin
           let (can_swap, must_swap) = can_byte_swap env f.fld_typ in