Merge of the "alignas" branch.

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

8 files changed, 211 insertions, 257 deletions

diff --git a/cparser/C.mli b/cparser/C.mli
index ce58504..5d90407 100644
--- a/cparser/C.mli
+++ b/cparser/C.mli
@@ -77,6 +77,7 @@ type attribute =
   | AConst
   | AVolatile
   | ARestrict
+  | AAlignas of int                     (* always a power of 2 *)
   | Attr of string * attr_arg list
 
 type attributes = attribute list
diff --git a/cparser/Cprint.ml b/cparser/Cprint.ml
index e97f041..c6864ff 100644
--- a/cparser/Cprint.ml
+++ b/cparser/Cprint.ml
@@ -91,6 +91,7 @@ let attribute pp = function
   | AConst -> fprintf pp "const"
   | AVolatile -> fprintf pp "volatile"
   | ARestrict -> fprintf pp "restrict"
+  | AAlignas n -> fprintf pp "_Alignas(%d)" n
   | Attr(name, []) -> fprintf pp "__attribute__((%s))" name
   | Attr(name, arg1 :: args) ->
       fprintf pp "__attribute__((%s(" name;
diff --git a/cparser/Cutil.ml b/cparser/Cutil.ml
index 2fc269c..982bf78 100644
--- a/cparser/Cutil.ml
+++ b/cparser/Cutil.ml
@@ -71,6 +71,14 @@ let rec find_custom_attributes (names: string list)  (al: attributes) =
   | _ :: tl ->
       find_custom_attributes names tl
 
+let rec remove_custom_attributes (names: string list)  (al: attributes) =
+  match al with
+  | [] -> []
+  | Attr(name, args) :: tl when List.mem name names ->
+      remove_custom_attributes names tl
+  | a :: tl ->
+      a :: remove_custom_attributes names tl
+
 (* Adding top-level attributes to a type.  Doesn't need to unroll defns. *)
 (* Array types cannot carry attributes, so add them to the element type. *)
 
@@ -147,6 +155,15 @@ let attr_is_type_related = function
   | Attr(("packed" | "__packed__"), _) -> true
   | _ -> false
 
+(* Extracting alignment value from a set of attributes.  Return 0 if none. *)
+
+let alignas_attribute al =
+  let rec alignas_attr accu = function
+  | [] -> accu
+  | AAlignas n :: al -> alignas_attr (max n accu) al
+  | a :: al -> alignas_attr accu al
+  in alignas_attr 0 al
+
 (* Type compatibility *)
 
 exception Incompat
@@ -266,6 +283,8 @@ let alignof_fkind = function
 let enum_ikind = IInt
 
 let rec alignof env t =
+  let a = alignas_attribute (attributes_of_type env t) in
+  if a > 0 then Some a else
   match t with
   | TVoid _ -> !config.alignof_void
   | TInt(ik, _) -> Some(alignof_ikind ik)
@@ -325,6 +344,13 @@ let cautious_mul (a: int64) (b: int) =
 (* Return size of type, in bytes, or [None] if the type is incomplete *)
 
 let rec sizeof env t =
+  match sizeof_aux env t with
+  | None -> None
+  | Some sz ->
+      let a = alignas_attribute (attributes_of_type env t) in
+      Some (if a > 0 then align sz a else sz)
+
+and sizeof_aux env t =      
   match t with
   | TVoid _ -> !config.sizeof_void
   | TInt(ik, _) -> Some(sizeof_ikind ik)
diff --git a/cparser/Cutil.mli b/cparser/Cutil.mli
index 7e23a72..98ab54e 100644
--- a/cparser/Cutil.mli
+++ b/cparser/Cutil.mli
@@ -33,9 +33,15 @@ val remove_attributes : attributes -> attributes -> attributes
   (* Difference [attr1 \ attr2] between two sets of attributes *)
 val incl_attributes : attributes -> attributes -> bool
   (* Check that first set of attributes is a subset of second set. *)
+val alignas_attribute : attributes -> int
+  (* Extract the value of the [_Alignas] attributes, if any.
+     Return 0 if none, a (positive) power of two alignment if some. *)
 val find_custom_attributes : string list -> attributes -> attr_arg list list
   (* Extract arguments of custom [Attr] attributes whose names appear
      in the given list of names. *)
+val remove_custom_attributes : string list -> attributes -> attributes
+  (* Remove all [Attr] attributes whose names appear
+     in the given list of names. *)
 val attributes_of_type : Env.t -> typ -> attributes
   (* Return the attributes of the given type, expanding typedefs if needed. *)
 val add_attributes_type : attributes -> typ -> typ
@@ -44,6 +50,8 @@ val remove_attributes_type : Env.t -> attributes -> typ -> typ
   (* Remove the given set of attributes to those of the given type. *)
 val erase_attributes_type : Env.t -> typ -> typ
   (* Erase the attributes of the given type. *)
+val change_attributes_type : Env.t -> (attributes -> attributes) -> typ -> typ
+  (* Apply the given function to the top-level attributes of the given type *)
 val attr_is_type_related: attribute -> bool
 (* Is an attribute type-related (true) or variable-related (false)? *)
 
diff --git a/cparser/Elab.ml b/cparser/Elab.ml
index fa9fd24..b25ad55 100644
--- a/cparser/Elab.ml
+++ b/cparser/Elab.ml
@@ -280,12 +280,31 @@ let elab_gcc_attr loc env = function
   | _ ->
       warning loc "ill-formed attribute, ignored"; []
 
+let is_power_of_two n = n > 0L && Int64.(logand n (pred n)) = 0L
+
+let extract_alignas loc a =
+  match a with
+  | Attr(("aligned"|"__aligned__"), args) ->
+      begin match args with
+      | [AInt n] when is_power_of_two n -> AAlignas (Int64.to_int n)
+      | _ -> warning loc "bad 'aligned' attribute, ignored"; a
+      end
+  | _ -> a
+
 let elab_attribute loc env = function
   | ("const", []) -> [AConst]
   | ("restrict", []) -> [ARestrict]
   | ("volatile", []) -> [AVolatile]
+  | ("_Alignas", [a]) ->
+      begin match elab_attr_arg loc env a with
+      | AInt n when is_power_of_two n -> [AAlignas (Int64.to_int n)]
+      | _ -> warning loc "bad _Alignas value, ignored"; []
+      end
   | (("__attribute" | "__attribute__"), l) ->
-        List.flatten (List.map (elab_gcc_attr loc env) l)
+        List.map (extract_alignas loc)
+          (List.flatten (List.map (elab_gcc_attr loc env) l))
+  | ("__packed__", args) ->
+        [Attr("__packed__", List.map (elab_attr_arg loc env) args)]
   | ("__asm__", _) -> []    (* MacOS X noise *)
   | (name, _) -> warning loc "`%s' annotation ignored" name; []
 
diff --git a/cparser/Lexer.mll b/cparser/Lexer.mll
index 0820e4e..90e4d3c 100644
--- a/cparser/Lexer.mll
+++ b/cparser/Lexer.mll
@@ -123,6 +123,7 @@ let init_lexicon _ =
       ("for", fun loc -> FOR loc);
       ("if", fun loc -> IF loc);
       ("else", fun _ -> ELSE);
+      ("sizeof", fun loc -> SIZEOF loc);
       (*** Implementation specific keywords ***)
       ("__signed__", fun loc -> SIGNED loc);
       ("__inline__", fun loc -> INLINE loc);
@@ -150,6 +151,7 @@ let init_lexicon _ =
       ("_Alignof", fun loc -> ALIGNOF loc);
       ("__alignof", fun loc -> ALIGNOF loc);
       ("__alignof__", fun loc -> ALIGNOF loc);
+      ("_Alignas", fun loc -> ALIGNAS loc);
       ("__volatile__", fun loc -> VOLATILE loc);
       ("__volatile", fun loc -> VOLATILE loc);
 
@@ -160,6 +162,7 @@ let init_lexicon _ =
       (*** weimer: GCC arcana ***)
       ("__restrict", fun loc -> RESTRICT loc);
       ("restrict", fun loc -> RESTRICT loc);
+      ("__packed__", fun loc -> PACKED loc);
 (*      ("__extension__", EXTENSION); *)
       (**** MS VC ***)
       ("__int64", fun loc -> INT64 loc);
@@ -487,7 +490,9 @@ rule initial =
 |		';'		       { (SEMICOLON (currentLoc lexbuf)) }
 |		','				{COMMA}
 |		'.'				{DOT}
+(* XL: redundant? 
 |		"sizeof"		{SIZEOF (currentLoc lexbuf)}
+*)
 |               "__asm"                 { if !msvcMode then 
                                              MSASM (msasm lexbuf, currentLoc lexbuf) 
                                           else (ASM (currentLoc lexbuf)) }
diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml
index 13a00ce..5d0bac9 100644
--- a/cparser/PackedStructs.ml
+++ b/cparser/PackedStructs.ml
@@ -23,37 +23,11 @@ open Env
 open Cerrors
 open Transform
 
-type field_info = {
-  fi_offset: int;                       (* byte offset within struct *)
-  fi_swap: bool                         (* true if byte-swapped *)
-}
+(* The set of struct fields that are byte-swapped.
+   A field is identified by a pair (struct name, field name). *)
 
-(* Mapping from struct name to size.
-   Only packed structs are mentioned in this table. *)
-
-let packed_structs : (ident, int) Hashtbl.t = Hashtbl.create 17
-
-(* Mapping from (struct name, field name) to field_info.
-   Only fields of packed structs are mentioned in this table. *)
-
-let packed_fields : (ident * string, field_info) Hashtbl.t
-                  = Hashtbl.create 57
-
-(* The current packing parameters.  The first two are 0 if packing is
-   turned off. *)
-
-let max_field_align = ref 0
-let min_struct_align = ref 0
-let byte_swap_fields = ref false
-
-(* Alignment *)
-
-let is_pow2 n =
-  n > 0 && n land (n - 1) = 0
-
-let align x boundary =
-  assert (is_pow2 boundary);
-  (x + boundary - 1) land (lnot (boundary - 1))
+let byteswapped_fields : (ident * string, unit) Hashtbl.t
+                       = Hashtbl.create 57
 
 (* What are the types that can be byte-swapped? *)
 
@@ -65,88 +39,87 @@ 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 =
-  let rec layout max_al pos = function
-  | [] ->
-      (max_al, pos)
-  | f :: rem -> 
-      if f.fld_bitfield <> None then
-        error "%a: Error: bitfields in packed structs not allowed"
-              formatloc loc;
-      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
-          if not can_swap then
-            error "%a: Error: cannot byte-swap field of type '%a'"
-                  formatloc loc Cprint.typ f.fld_typ;
-          must_swap
-        end else false in
-      let al1 = min al mfa in
-      let pos1 = align pos al1 in
-      Hashtbl.add packed_fields
-         (struct_id, f.fld_name)
-         {fi_offset = pos1; fi_swap = swap};
-      let pos2 = pos1 + sz in
-      layout (max max_al al1) pos2 rem in
-  let (al, sz) = layout 1 0 fields in
-  if al >= msa then
-    (0, sz)
+(* "Safe" [alignof] function, with detection of incomplete types. *)
+
+let safe_alignof loc env ty =
+  match alignof env ty with
+  | Some al -> al
+  | None ->
+      error "%a: Error: incomplete type for a struct field" formatloc loc; 1
+
+(* Remove existing [_Alignas] attributes and add the given [_Alignas] attr. *)
+
+let remove_alignas_attr attrs =
+  List.filter (function AAlignas _ -> false | _ -> true) attrs
+let set_alignas_attr al attrs =
+  add_attributes [AAlignas al] (remove_alignas_attr attrs)
+
+(* Rewriting field declarations *)
+
+let transf_field_decl mfa swapped loc env struct_id f =
+  if f.fld_bitfield <> None then
+    error "%a: Error: bitfields in packed structs not allowed"
+          formatloc loc;
+  (* Register as byte-swapped if needed *)
+  if swapped then begin
+    let (can_swap, must_swap) = can_byte_swap env f.fld_typ in
+    if not can_swap then
+      error "%a: Error: cannot byte-swap field of type '%a'"
+            formatloc loc Cprint.typ f.fld_typ;
+    if must_swap then
+      Hashtbl.add byteswapped_fields (struct_id, f.fld_name) ()
+  end;
+  (* Reduce alignment if requested *)
+  if mfa = 0 then f else begin
+    let al = safe_alignof loc env f.fld_typ in
+    { f with fld_typ =
+         change_attributes_type env (set_alignas_attr (min mfa al)) f.fld_typ }
+  end
+
+(* Rewriting struct declarations *)
+
+let transf_struct_decl mfa msa swapped loc env struct_id attrs ml =
+  let ml' =
+    List.map (transf_field_decl mfa swapped loc env struct_id) ml in
+  if msa = 0 then (attrs, ml') else begin
+    let al' = (* natural alignment of the transformed struct *)
+      List.fold_left
+        (fun a f' -> max a (safe_alignof loc env f'.fld_typ))
+        1 ml' in
+      (set_alignas_attr (max msa al') attrs, ml')
+  end
+
+(* Rewriting composite declarations *)
+
+let is_pow2 n = n > 0 && n land (n - 1) = 0
+
+let packed_param_value loc n =
+  let m = Int64.to_int n in
+  if n <> Int64.of_int m then
+    (error "%a: __packed__ parameter `%Ld' is too large" formatloc loc n; 0)
+  else if m = 0 || is_pow2 m then
+    m
   else
-    (msa, align sz msa)
-
-(* Rewriting of struct declarations *)
-
-let payload_field sz =
-  { fld_name = "__payload";
-    fld_typ = TArray(TInt(IUChar, []), Some(Int64.of_int sz), []);
-    fld_bitfield = None}
+    (error "%a: __packed__ parameter `%Ld' must be a power of 2" formatloc loc n; 0)
 
 let transf_composite loc env su id attrs ml =
   match su with
   | Union -> (attrs, ml)
   | Struct ->
       let (mfa, msa, swapped) =
-        if !max_field_align > 0 then
-          (!max_field_align, !min_struct_align, !byte_swap_fields)
-        else if find_custom_attributes ["packed";"__packed__"] attrs <> [] then
-          (1, 0, false)
-        else
-          (0, 0, false) in
-      if mfa = 0 then (attrs, ml) else begin
-        let (al, sz) = layout_struct mfa msa swapped loc env id ml in
-        Hashtbl.add packed_structs id sz;
-        let attrs =
-          if al = 0 then attrs else
-            add_attributes [Attr("__aligned__", [AInt(Int64.of_int al)])] attrs
-        and field =
-          payload_field sz
-        in (attrs, [field])
-      end
+        match find_custom_attributes ["packed";"__packed__"] attrs with
+        | [] -> (0L, 0L, false)
+        | [[]] -> (1L, 0L, false)
+        | [[AInt n]] -> (n, 0L, false)
+        | [[AInt n; AInt p]] -> (n, p, false)
+        | [[AInt n; AInt p; AInt q]] -> (n, p, q <> 0L)
+        | _ ->
+          error "%a: ill-formed or ambiguous __packed__ attribute"
+                formatloc loc;
+          (0L, 0L, false) in
+      let mfa = packed_param_value loc mfa in
+      let msa = packed_param_value loc msa in
+      transf_struct_decl mfa msa swapped loc env id attrs ml
 
 (* Accessor functions *)
 
@@ -172,28 +145,6 @@ 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}
-
-(*  e + n *)
-let eoffset e n =
-  {edesc = EBinop(Oadd, e, intconst (Int64.of_int n) IInt, e.etyp);
-   etyp = e.etyp}
-
-(*  *((ty * ) (base.__payload + offset))  *)
-let dot_packed_field base pf ty =
-  let payload =
-    {edesc = EUnop(Odot "__payload", base);
-     etyp = TArray(TInt(IChar,[]),None,[]) } in
-  ederef ty (ecast (TPtr(ty, [])) (eoffset payload pf.fi_offset))
-
-(*  *((ty * ) (base->__payload + offset))  *)
-let arrow_packed_field base pf ty =
-  let payload =
-    {edesc = EUnop(Oarrow "__payload", base);
-     etyp = TArray(TInt(IChar,[]),None,[]) } in
-  ederef ty (ecast (TPtr(ty, [])) (eoffset payload pf.fi_offset))
-
 (*  (ty) __builtin_readNN_reversed(&lval)
  or (ty) __builtin_bswapNN(lval) *)
 
@@ -256,38 +207,26 @@ let bswap_write loc env lhs rhs =
 
 let transf_expr loc env ctx e =
 
-  let is_packed_access ty fieldname =
+  let is_byteswapped ty fieldname =
     match unroll env ty with
-    | TStruct(id, _) ->
-        (try Some(Hashtbl.find packed_fields (id, fieldname))
-         with Not_found -> None)
-    | _ -> None in
+    | TStruct(id, _) -> Hashtbl.mem byteswapped_fields (id, fieldname)
+    | _ -> false in
 
-  let is_packed_access_ptr ty fieldname =
+  let is_byteswapped_ptr ty fieldname =
     match unroll env ty with
-    | TPtr(ty', _) -> is_packed_access ty' fieldname
-    | _ -> None in 
+    | TPtr(ty', _) -> is_byteswapped ty' fieldname
+    | _ -> false in 
 
   (* Transformation of l-values.  Return transformed expr plus
      [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}, false)
-        | Some pf ->
-            (dot_packed_field e1' pf e.etyp, pf.fi_swap)
-        end
+        ({edesc = EUnop(Odot fieldname, texp Val e1); etyp = e.etyp},
+         is_byteswapped e1.etyp fieldname)
     | EUnop(Oarrow fieldname, e1) ->
-        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}, false)
-        | Some pf ->
-            (arrow_packed_field e1' pf e.etyp, pf.fi_swap)
-        end
+        ({edesc = EUnop(Oarrow fieldname, texp Val e1); etyp = e.etyp},
+         is_byteswapped_ptr e1.etyp fieldname)
     | EBinop(Oindex, e1, e2, tyres) ->
         let (e1', swap) = lvalue e1 in
         ({edesc = EBinop(Oindex, e1', e2, tyres); etyp = e.etyp}, swap)
@@ -383,74 +322,52 @@ let transf_fundef env f =
 
 (* Initializers *)
 
-let extract_byte env e i =
-  let ty = unary_conversion env e.etyp in
-  let e1 =
-    if i = 0 then e else
-      { edesc = EBinop(Oshr, e, intconst (Int64.of_int (i*8)) IInt, ty);
-        etyp = ty } in
-  { edesc = EBinop(Oand, e1, intconst 0xFFL IInt, ty); etyp = ty }
-
-let init_packed_struct loc env struct_id struct_sz initdata =
-
-  let new_initdata = Array.make struct_sz (Init_single (intconst 0L IUChar)) in
-
-  let enter_scalar pos e sz bigendian =
-    for i = 0 to sz - 1 do
-      let bytenum = if bigendian then sz - 1 - i else i in
-      new_initdata.(pos + i) <- Init_single(extract_byte env e bytenum)
-    done in
-
-  let rec enter_init pos ty init bigendian =
-    match (unroll env ty, init) with
-    | (TInt(ik, _), Init_single e) ->
-        enter_scalar pos e (sizeof_ikind ik) bigendian
-    | (TEnum(_, _), Init_single e) ->
-        enter_scalar pos e (sizeof_ikind enum_ikind) bigendian
-    | (TPtr _, Init_single e) ->
-        enter_scalar pos e ((!Machine.config).sizeof_ptr) bigendian
-    | (TArray(ty_elt, _, _), Init_array il) ->
-        begin match sizeof env ty_elt with
-        | Some sz -> enter_init_array pos ty_elt sz il bigendian
-        | None -> fatal_error "%a: Internal error: incomplete type in init data" formatloc loc
-        end
-    | (_, _) ->
-        error "%a: Unsupported initializer for packed struct" formatloc loc
-  and enter_init_array pos ty sz il bigendian =
-    match il with
-    | [] -> ()
-    | i1 :: il' ->
-        enter_init pos ty i1 bigendian;
-        enter_init_array (pos + sz) ty sz il' bigendian in
-
-  let enter_field (fld, init) =
-    let finfo =
-      try Hashtbl.find packed_fields (struct_id, fld.fld_name)
-      with Not_found ->
-        fatal_error "%a: Internal error: non-packed field in packed struct"
-                    formatloc loc in
-    enter_init finfo.fi_offset fld.fld_typ init
-               ((!Machine.config).bigendian <> finfo.fi_swap) in
-
-  List.iter enter_field initdata;
-
-  Init_struct(struct_id, [
-    (payload_field struct_sz, Init_array (Array.to_list new_initdata))
-  ])
+let extract_byte n i =
+  Int64.(logand (shift_right_logical n (i * 8)) 0xFFL)
+
+let byteswap_int nbytes n =
+  let res = ref 0L in
+  for i = 0 to nbytes - 1 do
+    res := Int64.(logor (shift_left !res 8) (extract_byte n i))
+  done;
+  !res
 
 let transf_init loc env i =
-  let rec trinit = function
-  | Init_single e as i -> i
-  | Init_array il -> Init_array (List.map trinit il)
-  | Init_struct(id, fld_init_list) ->
-      begin try
-        let sz = Hashtbl.find packed_structs id in
-        init_packed_struct loc env id sz fld_init_list
-      with Not_found ->
-        Init_struct(id, List.map (fun (f,i) -> (f, trinit i)) fld_init_list)
+  (* [swap] is [None] if no byte swapping needed, [Some ty] if
+     byte-swapping is needed, with target type [ty] *)
+  let rec trinit swap = function
+  | Init_single e as i ->
+      begin match swap with
+      | None -> i
+      | Some ty ->
+          match Ceval.constant_expr env ty e with
+          | Some(CInt(n, ik, _)) ->
+              let n' = byteswap_int (sizeof_ikind ik) n in
+              Init_single {edesc = EConst(CInt(n', ik, "")); etyp = e.etyp}
+          | _ ->
+              error "%a: Error: initializer for byte-swapped field is not \
+                         a compile-time integer constant" formatloc loc; i
       end
-  | Init_union(id, fld, i) -> Init_union(id, fld, trinit i)
-  in trinit i
+  | Init_array il ->
+      let swap_elt =
+        match swap with
+        | None -> None
+        | Some ty ->
+            match unroll env ty with
+            | TArray(ty_elt, _, _) -> Some ty_elt
+            | _ -> assert false in
+      Init_array (List.map (trinit swap_elt) il)
+  | Init_struct(id, fld_init_list) ->
+      let trinit_field (f, i) =
+        let swap_f =
+          if Hashtbl.mem byteswapped_fields (id, f.fld_name)
+          then Some f.fld_typ
+          else None in
+        (f, trinit swap_f i) in
+      Init_struct(id, List.map trinit_field fld_init_list)
+  | Init_union(id, fld, i) ->
+      Init_union(id, fld, trinit None i)
+  in trinit None i
 
 (* Declarations *)
 
@@ -460,39 +377,6 @@ let transf_decl loc env (sto, id, ty, init_opt) =
    | None -> None
    | Some i -> Some (transf_init loc env i))
 
-(* Pragmas *)
-
-let re_pack = Str.regexp "pack\\b"
-let re_pack_1 = Str.regexp "pack[ \t]*(\\([ \t0-9,]*\\))[ \t]*$"
-let re_comma = Str.regexp ",[ \t]*"
-
-let process_pragma loc s =
-  if Str.string_match re_pack s 0 then begin
-    if Str.string_match re_pack_1 s 0 then begin
-      let arg = Str.matched_group 1 s in
-      let (mfa, msa, bs) =
-        match List.map int_of_string (Str.split re_comma arg) with
-        | [] -> (0, 0, false)
-        | [x] -> (x, 0, false)
-        | [x;y] -> (x, y, false)
-        | x :: y :: z :: _ -> (x, y, z = 1) in
-      if mfa = 0 || is_pow2 mfa then
-        max_field_align := mfa
-      else
-        error "%a: Error: In #pragma pack, max field alignment must be a power of 2" formatloc loc;
-      if msa = 0 || is_pow2 msa then
-        min_struct_align := msa
-      else
-        error "%a: Error: In #pragma pack, min struct alignment must be a power of 2" formatloc loc;
-      byte_swap_fields := bs;
-      true
-    end else begin
-      warning "%a: Warning: Ill-formed #pragma pack, ignored" formatloc loc;
-      false
-    end
-  end else
-    false
-
 (* Global declarations *)
 
 let rec transf_globdecls env accu = function
@@ -531,14 +415,10 @@ let rec transf_globdecls env accu = function
             (g :: accu)
             gl
       | Gpragma p ->
-          if process_pragma g.gloc p
-          then transf_globdecls env accu gl
-          else transf_globdecls env (g :: accu) gl
+          transf_globdecls env (g :: accu) gl
 
 (* Program *)
 
 let program p =
-  min_struct_align := 0;
-  max_field_align := 0;
-  byte_swap_fields := false;
+  Hashtbl.clear byteswapped_fields;
   transf_globdecls (Builtins.environment()) [] p
diff --git a/cparser/Parser.mly b/cparser/Parser.mly
index 83b1984..cd515de 100644
--- a/cparser/Parser.mly
+++ b/cparser/Parser.mly
@@ -220,7 +220,7 @@ let transformOffsetOf (speclist, dtype) member =
 %token<Cabs.cabsloc> VOLATILE EXTERN STATIC CONST RESTRICT AUTO REGISTER
 %token<Cabs.cabsloc> THREAD
 
-%token<Cabs.cabsloc> SIZEOF ALIGNOF
+%token<Cabs.cabsloc> SIZEOF ALIGNOF ALIGNAS
 
 %token EQ PLUS_EQ MINUS_EQ STAR_EQ SLASH_EQ PERCENT_EQ
 %token AND_EQ PIPE_EQ CIRC_EQ INF_INF_EQ SUP_SUP_EQ
@@ -252,7 +252,7 @@ let transformOffsetOf (speclist, dtype) member =
 
 %token<Cabs.cabsloc> ATTRIBUTE INLINE ASM TYPEOF FUNCTION__ PRETTY_FUNCTION__
 %token LABEL__
-%token<Cabs.cabsloc> BUILTIN_VA_ARG ATTRIBUTE_USED
+%token<Cabs.cabsloc> BUILTIN_VA_ARG ATTRIBUTE_USED PACKED
 %token BUILTIN_VA_LIST
 %token BLOCKATTRIBUTE 
 %token<Cabs.cabsloc> BUILTIN_TYPES_COMPAT BUILTIN_OFFSETOF
@@ -1244,6 +1244,13 @@ attribute_nocv:
 |   ATTRIBUTE_USED                      { ("__attribute__", 
                                              [ VARIABLE "used" ]), $1 }
 *)*/
+|   ALIGNAS paren_comma_expression
+          { ("_Alignas", [smooth_expression(fst $2)]), $1 }
+|   ALIGNAS LPAREN type_name RPAREN
+          { let (b, d) = $3 in
+            ("_Alignas", [TYPE_ALIGNOF(b, d)]), $1 }
+|   PACKED LPAREN attr_list RPAREN      { ("__packed__", $3), $1 }
+|   PACKED                              { ("__packed__", []), $1 }
 |   DECLSPEC paren_attr_list_ne         { ("__declspec", $2), $1 }
 |   MSATTR                              { (fst $1, []), snd $1 }
                                         /* ISO 6.7.3 */
@@ -1265,10 +1272,17 @@ attribute:
 
 /* (* sm: I need something that just includes __attribute__ and nothing more,
  *  to support them appearing between the 'struct' keyword and the type name. 
- * Actually, a declspec can appear there as well (on MSVC) *)  */
+ * Actually, a declspec can appear there as well (on MSVC).
+ * XL: ... and so does _Alignas(). *)  */
 just_attribute:
     ATTRIBUTE LPAREN paren_attr_list RPAREN
                                         { ("__attribute__", $3) }
+|   ALIGNAS paren_comma_expression
+          { ("_Alignas", [smooth_expression(fst $2)]) }
+|   ALIGNAS LPAREN type_name RPAREN
+          { let (b, d) = $3 in ("_Alignas", [TYPE_ALIGNOF(b, d)]) }
+|   PACKED LPAREN attr_list RPAREN      { ("__packed__", $3) }
+|   PACKED                              { ("__packed__", []) }
 |   DECLSPEC paren_attr_list_ne         { ("__declspec", $2) }
 ;