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

3 files changed, 41 insertions, 10 deletions

diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml
index 1a2a453..14e345b 100644
--- a/cfrontend/C2C.ml
+++ b/cfrontend/C2C.ml
@@ -342,8 +342,6 @@ let convertTyp env t =
   and convertFieldList seen = function
     | [] -> Fnil
     | f :: fl ->
-        if f.fld_bitfield <> None then
-          unsupported "bit field in struct or union";
         Fcons(intern_string f.fld_name, convertTyp seen f.fld_typ,
               convertFieldList seen fl)
 
@@ -784,6 +782,17 @@ let convertGlobvar env (sto, id, ty, optinit) =
   (id', {gvar_info = ty'; gvar_init = init';
          gvar_readonly = readonly; gvar_volatile = volatile})
 
+(** Sanity checks on composite declarations. *)
+
+let checkComposite env si id attr flds =
+  let checkField f =
+    if f.fld_bitfield <> None then
+      unsupported "bit field in struct or union";
+    if Cutil.find_custom_attributes ["aligned"; "__aligned__"] 
+          (Cutil.attributes_of_type env f.fld_typ) <> [] then
+      warning ("ignoring 'aligned' attribute on field " ^ f.fld_name)
+  in List.iter checkField flds
+
 (** Convert a list of global declarations.
   Result is a pair [(funs, vars)] where [funs] are 
   the function definitions (internal and external)
@@ -812,11 +821,14 @@ let rec convertGlobdecls env funs vars gl =
           end
       | C.Gfundef fd ->
           convertGlobdecls env (convertFundef env fd :: funs) vars gl'
-      | C.Gcompositedecl _ | C.Gcompositedef _
-      | C.Gtypedef _ | C.Genumdef _ ->
+      | C.Gcompositedecl _ | C.Gtypedef _ | C.Genumdef _ ->
           (* typedefs are unrolled, structs are expanded inline, and
              enum tags are folded.  So we just skip their declarations. *)
           convertGlobdecls env funs vars gl'
+      | C.Gcompositedef(su, id, attr, flds) ->
+          (* sanity checks on fields *)
+          checkComposite env su id attr flds;
+          convertGlobdecls env funs vars gl'
       | C.Gpragma s ->
           if not (!process_pragma_hook s) then
             warning ("'#pragma " ^ s ^ "' directive ignored");
diff --git a/cparser/Cprint.mli b/cparser/Cprint.mli
index ce5fb18..d63e341 100644
--- a/cparser/Cprint.mli
+++ b/cparser/Cprint.mli
@@ -17,6 +17,7 @@ val print_idents_in_full : bool ref
 val print_line_numbers : bool ref
 
 val location : Format.formatter -> C.location -> unit
+val attributes : Format.formatter -> C.attributes -> unit
 val typ : Format.formatter -> C.typ -> unit
 val simple_decl : Format.formatter -> C.ident * C.typ -> unit
 val full_decl: Format.formatter -> C.decl -> unit
diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml
index ebdd86b..f926ece 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