cparser/*: refactoring of the expansion of read-modify-write operators

cparser/PackedStructs: treat r-m-w operations over byte-swapped fields
cparser/PackedStructs: allow static initialization of packed structs
test/regression: more packedstruct tests


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

8 files changed, 342 insertions, 225 deletions

diff --git a/cparser/.depend b/cparser/.depend
index 2d6b280..51f3b5e 100644
--- a/cparser/.depend
+++ b/cparser/.depend
@@ -1,88 +1,90 @@
-AddCasts.cmi: C.cmi 
-Bitfields.cmi: C.cmi 
-Builtins.cmi: Env.cmi C.cmi 
-C.cmi: 
-Ceval.cmi: Env.cmi C.cmi 
-Cleanup.cmi: C.cmi 
-Cprint.cmi: C.cmi 
-Cutil.cmi: Env.cmi C.cmi 
-Elab.cmi: C.cmi 
-Env.cmi: C.cmi 
-Errors.cmi: 
-GCC.cmi: Builtins.cmi 
-Lexer.cmi: Parser.cmi 
-Machine.cmi: 
-PackedStructs.cmi: C.cmi 
-Parse.cmi: C.cmi 
-Parse_aux.cmi: 
-Parser.cmi: Cabs.cmo 
-Rename.cmi: C.cmi 
-SimplExpr.cmi: C.cmi 
-StructAssign.cmi: C.cmi 
-StructByValue.cmi: C.cmi 
-Transform.cmi: Env.cmi C.cmi 
-Unblock.cmi: C.cmi 
-AddCasts.cmo: Transform.cmi Cutil.cmi C.cmi AddCasts.cmi 
-AddCasts.cmx: Transform.cmx Cutil.cmx C.cmi AddCasts.cmi 
-Bitfields.cmo: Transform.cmi Machine.cmi Cutil.cmi C.cmi Bitfields.cmi 
-Bitfields.cmx: Transform.cmx Machine.cmx Cutil.cmx C.cmi Bitfields.cmi 
-Builtins.cmo: Env.cmi Cutil.cmi C.cmi Builtins.cmi 
-Builtins.cmx: Env.cmx Cutil.cmx C.cmi Builtins.cmi 
-Cabs.cmo: 
-Cabs.cmx: 
-Cabshelper.cmo: Cabs.cmo 
-Cabshelper.cmx: Cabs.cmx 
-Ceval.cmo: Machine.cmi Cutil.cmi C.cmi Ceval.cmi 
-Ceval.cmx: Machine.cmx Cutil.cmx C.cmi Ceval.cmi 
-Cleanup.cmo: Cutil.cmi C.cmi Cleanup.cmi 
-Cleanup.cmx: Cutil.cmx C.cmi Cleanup.cmi 
-Cprint.cmo: C.cmi Cprint.cmi 
-Cprint.cmx: C.cmi Cprint.cmi 
-Cutil.cmo: Machine.cmi Errors.cmi Env.cmi Cprint.cmi C.cmi Cutil.cmi 
-Cutil.cmx: Machine.cmx Errors.cmx Env.cmx Cprint.cmx C.cmi Cutil.cmi 
+AddCasts.cmi: C.cmi
+Bitfields.cmi: C.cmi
+Builtins.cmi: Env.cmi C.cmi
+C.cmi:
+Ceval.cmi: Env.cmi C.cmi
+Cleanup.cmi: C.cmi
+Cprint.cmi: C.cmi
+Cutil.cmi: Env.cmi C.cmi
+Elab.cmi: C.cmi
+Env.cmi: C.cmi
+Errors.cmi:
+GCC.cmi: Builtins.cmi
+Lexer.cmi: Parser.cmi
+Machine.cmi:
+PackedStructs.cmi: C.cmi
+Parse.cmi: C.cmi
+Parse_aux.cmi:
+Parser.cmi: Cabs.cmo
+Rename.cmi: C.cmi
+SimplExpr.cmi: C.cmi
+StructAssign.cmi: C.cmi
+StructByValue.cmi: C.cmi
+Transform.cmi: Env.cmi C.cmi
+Unblock.cmi: C.cmi
+AddCasts.cmo: Transform.cmi Cutil.cmi C.cmi AddCasts.cmi
+AddCasts.cmx: Transform.cmx Cutil.cmx C.cmi AddCasts.cmi
+Bitfields.cmo: Transform.cmi Machine.cmi Cutil.cmi C.cmi Bitfields.cmi
+Bitfields.cmx: Transform.cmx Machine.cmx Cutil.cmx C.cmi Bitfields.cmi
+Builtins.cmo: Env.cmi Cutil.cmi C.cmi Builtins.cmi
+Builtins.cmx: Env.cmx Cutil.cmx C.cmi Builtins.cmi
+Cabs.cmo:
+Cabs.cmx:
+Cabshelper.cmo: Cabs.cmo
+Cabshelper.cmx: Cabs.cmx
+Ceval.cmo: Machine.cmi Cutil.cmi C.cmi Ceval.cmi
+Ceval.cmx: Machine.cmx Cutil.cmx C.cmi Ceval.cmi
+Cleanup.cmo: Cutil.cmi C.cmi Cleanup.cmi
+Cleanup.cmx: Cutil.cmx C.cmi Cleanup.cmi
+Cprint.cmo: C.cmi Cprint.cmi
+Cprint.cmx: C.cmi Cprint.cmi
+Cutil.cmo: Machine.cmi Errors.cmi Env.cmi Cprint.cmi C.cmi Cutil.cmi
+Cutil.cmx: Machine.cmx Errors.cmx Env.cmx Cprint.cmx C.cmi Cutil.cmi
 Elab.cmo: Parser.cmi Machine.cmi Lexer.cmi Errors.cmi Env.cmi Cutil.cmi \
     Cprint.cmi Cleanup.cmi Ceval.cmi Cabshelper.cmo Cabs.cmo C.cmi \
-    Builtins.cmi Elab.cmi 
+    Builtins.cmi Elab.cmi
 Elab.cmx: Parser.cmx Machine.cmx Lexer.cmx Errors.cmx Env.cmx Cutil.cmx \
     Cprint.cmx Cleanup.cmx Ceval.cmx Cabshelper.cmx Cabs.cmx C.cmi \
-    Builtins.cmx Elab.cmi 
-Env.cmo: C.cmi Env.cmi 
-Env.cmx: C.cmi Env.cmi 
-Errors.cmo: Errors.cmi 
-Errors.cmx: Errors.cmi 
-GCC.cmo: Cutil.cmi C.cmi Builtins.cmi GCC.cmi 
-GCC.cmx: Cutil.cmx C.cmi Builtins.cmx GCC.cmi 
-Lexer.cmo: Parser.cmi Parse_aux.cmi Cabshelper.cmo Lexer.cmi 
-Lexer.cmx: Parser.cmx Parse_aux.cmx Cabshelper.cmx Lexer.cmi 
-Machine.cmo: Machine.cmi 
-Machine.cmx: Machine.cmi 
-Main.cmo: Parse.cmi GCC.cmi Cprint.cmi Builtins.cmi 
-Main.cmx: Parse.cmx GCC.cmx Cprint.cmx Builtins.cmx 
-PackedStructs.cmo: Errors.cmi Env.cmi Cutil.cmi C.cmi Builtins.cmi \
-    PackedStructs.cmi 
-PackedStructs.cmx: Errors.cmx Env.cmx Cutil.cmx C.cmi Builtins.cmx \
-    PackedStructs.cmi 
-Parse.cmo: Unblock.cmi StructByValue.cmi StructAssign.cmi SimplExpr.cmi \
-    Rename.cmi PackedStructs.cmi Errors.cmi Elab.cmi Bitfields.cmi \
-    AddCasts.cmi Parse.cmi 
-Parse.cmx: Unblock.cmx StructByValue.cmx StructAssign.cmx SimplExpr.cmx \
-    Rename.cmx PackedStructs.cmx Errors.cmx Elab.cmx Bitfields.cmx \
-    AddCasts.cmx Parse.cmi 
-Parse_aux.cmo: Errors.cmi Cabshelper.cmo Parse_aux.cmi 
-Parse_aux.cmx: Errors.cmx Cabshelper.cmx Parse_aux.cmi 
-Parser.cmo: Parse_aux.cmi Cabshelper.cmo Cabs.cmo Parser.cmi 
-Parser.cmx: Parse_aux.cmx Cabshelper.cmx Cabs.cmx Parser.cmi 
-Rename.cmo: Errors.cmi Cutil.cmi C.cmi Builtins.cmi Rename.cmi 
-Rename.cmx: Errors.cmx Cutil.cmx C.cmi Builtins.cmx Rename.cmi 
-SimplExpr.cmo: Transform.cmi Errors.cmi Cutil.cmi C.cmi SimplExpr.cmi 
-SimplExpr.cmx: Transform.cmx Errors.cmx Cutil.cmx C.cmi SimplExpr.cmi 
+    Builtins.cmx Elab.cmi
+Env.cmo: C.cmi Env.cmi
+Env.cmx: C.cmi Env.cmi
+Errors.cmo: Errors.cmi
+Errors.cmx: Errors.cmi
+GCC.cmo: Cutil.cmi C.cmi Builtins.cmi GCC.cmi
+GCC.cmx: Cutil.cmx C.cmi Builtins.cmx GCC.cmi
+Lexer.cmo: Parser.cmi Parse_aux.cmi Cabshelper.cmo Lexer.cmi
+Lexer.cmx: Parser.cmx Parse_aux.cmx Cabshelper.cmx Lexer.cmi
+Machine.cmo: Machine.cmi
+Machine.cmx: Machine.cmi
+Main.cmo: Parse.cmi GCC.cmi Cprint.cmi Builtins.cmi
+Main.cmx: Parse.cmx GCC.cmx Cprint.cmx Builtins.cmx
+PackedStructs.cmo: Transform.cmi Machine.cmi Errors.cmi Env.cmi Cutil.cmi \
+    C.cmi Builtins.cmi PackedStructs.cmi
+PackedStructs.cmx: Transform.cmx Machine.cmx Errors.cmx Env.cmx Cutil.cmx \
+    C.cmi Builtins.cmx PackedStructs.cmi
+Parse.cmo: Unblock.cmi StructByValue.cmi StructAssign.cmi SimplVolatile.cmo \
+    SimplExpr.cmi Rename.cmi PackedStructs.cmi Errors.cmi Elab.cmi \
+    Bitfields.cmi AddCasts.cmi Parse.cmi
+Parse.cmx: Unblock.cmx StructByValue.cmx StructAssign.cmx SimplVolatile.cmx \
+    SimplExpr.cmx Rename.cmx PackedStructs.cmx Errors.cmx Elab.cmx \
+    Bitfields.cmx AddCasts.cmx Parse.cmi
+Parse_aux.cmo: Errors.cmi Cabshelper.cmo Parse_aux.cmi
+Parse_aux.cmx: Errors.cmx Cabshelper.cmx Parse_aux.cmi
+Parser.cmo: Parse_aux.cmi Cabshelper.cmo Cabs.cmo Parser.cmi
+Parser.cmx: Parse_aux.cmx Cabshelper.cmx Cabs.cmx Parser.cmi
+Rename.cmo: Errors.cmi Cutil.cmi C.cmi Builtins.cmi Rename.cmi
+Rename.cmx: Errors.cmx Cutil.cmx C.cmi Builtins.cmx Rename.cmi
+SimplExpr.cmo: Transform.cmi Errors.cmi Cutil.cmi C.cmi SimplExpr.cmi
+SimplExpr.cmx: Transform.cmx Errors.cmx Cutil.cmx C.cmi SimplExpr.cmi
+SimplVolatile.cmo: Transform.cmi Cutil.cmi C.cmi
+SimplVolatile.cmx: Transform.cmx Cutil.cmx C.cmi
 StructAssign.cmo: Transform.cmi Machine.cmi Errors.cmi Env.cmi Cutil.cmi \
-    C.cmi StructAssign.cmi 
+    C.cmi StructAssign.cmi
 StructAssign.cmx: Transform.cmx Machine.cmx Errors.cmx Env.cmx Cutil.cmx \
-    C.cmi StructAssign.cmi 
-StructByValue.cmo: Transform.cmi Env.cmi Cutil.cmi C.cmi StructByValue.cmi 
-StructByValue.cmx: Transform.cmx Env.cmx Cutil.cmx C.cmi StructByValue.cmi 
-Transform.cmo: Env.cmi Cutil.cmi C.cmi Builtins.cmi Transform.cmi 
-Transform.cmx: Env.cmx Cutil.cmx C.cmi Builtins.cmx Transform.cmi 
-Unblock.cmo: Transform.cmi Errors.cmi Cutil.cmi C.cmi Unblock.cmi 
-Unblock.cmx: Transform.cmx Errors.cmx Cutil.cmx C.cmi Unblock.cmi 
+    C.cmi StructAssign.cmi
+StructByValue.cmo: Transform.cmi Env.cmi Cutil.cmi C.cmi StructByValue.cmi
+StructByValue.cmx: Transform.cmx Env.cmx Cutil.cmx C.cmi StructByValue.cmi
+Transform.cmo: Env.cmi Cutil.cmi C.cmi Builtins.cmi Transform.cmi
+Transform.cmx: Env.cmx Cutil.cmx C.cmi Builtins.cmx Transform.cmi
+Unblock.cmo: Transform.cmi Errors.cmi Cutil.cmi C.cmi Unblock.cmi
+Unblock.cmx: Transform.cmx Errors.cmx Cutil.cmx C.cmi Unblock.cmi
diff --git a/cparser/Bitfields.ml b/cparser/Bitfields.ml
index d16f91f..c1b83cb 100644
--- a/cparser/Bitfields.ml
+++ b/cparser/Bitfields.ml
@@ -201,28 +201,6 @@ let bitfield_assign bf carrier newval =
   {edesc = EBinop(Oor,  oldval_masked, newval_masked,  TInt(IUInt,[]));
    etyp =  TInt(IUInt,[])}
 
-(* Transformation of operators *)
-
-let op_for_incr_decr = function
-  | Opreincr -> Oadd
-  | Opredecr -> Osub
-  | Opostincr -> Oadd
-  | Opostdecr -> Osub
-  | _ -> assert false
-
-let op_for_assignop = function
-  | Oadd_assign -> Oadd
-  | Osub_assign -> Osub
-  | Omul_assign -> Omul
-  | Odiv_assign -> Odiv
-  | Omod_assign -> Omod
-  | Oand_assign -> Oand
-  | Oor_assign -> Oor 
-  | Oxor_assign -> Oxor
-  | Oshl_assign -> Oshl
-  | Oshr_assign -> Oshr
-  | _ -> assert false
-
 (* Check whether a field access (e.f or e->f) is a bitfield access.
    If so, return carrier expression (e and *e, respectively)
    and bitfield_info *)
@@ -356,7 +334,7 @@ let transf_expr env ctx e =
       bind_lvalue env (texp Val e1) (fun base ->
         let carrier =
           {edesc = EUnop(Odot bf.bf_carrier, base); etyp = bf.bf_carrier_typ} in
-        let temp = new_temp tyfield in
+        let temp = mk_temp env tyfield in
         let tyres = unary_conversion env tyfield in
         let settemp = eassign temp (bitfield_extract bf carrier) in
         let rhs =
diff --git a/cparser/Machine.ml b/cparser/Machine.ml
index ffff5fb..0300582 100644
--- a/cparser/Machine.ml
+++ b/cparser/Machine.ml
@@ -40,6 +40,7 @@ type t = {
   alignof_longdouble: int;
   alignof_void: int option;
   alignof_fun: int option;
+  bigendian: bool;
   bitfields_msb_first: bool
 }
 
@@ -68,6 +69,7 @@ let ilp32ll64 = {
   alignof_longdouble = 16;
   alignof_void = None;
   alignof_fun = None;
+  bigendian = false;
   bitfields_msb_first = false
 }
 
@@ -96,6 +98,7 @@ let i32lpll64 = {
   alignof_longdouble = 16;
   alignof_void = None;
   alignof_fun = None;
+  bigendian = false;
   bitfields_msb_first = false
 }
 
@@ -124,6 +127,7 @@ let il32pll64 = {
   alignof_longdouble = 16;
   alignof_void = None;
   alignof_fun = None;
+  bigendian = false;
   bitfields_msb_first = false
 }
 
@@ -132,7 +136,7 @@ let il32pll64 = {
 let x86_32 = { ilp32ll64 with char_signed = true }
 let x86_64 = { i32lpll64 with char_signed = true }
 let win64 = { il32pll64 with char_signed = true }
-let ppc_32_bigendian = { ilp32ll64 with bitfields_msb_first = true }
+let ppc_32_bigendian = { ilp32ll64 with bigendian = true; bitfields_msb_first = true }
 let arm_littleendian = ilp32ll64
 
 (* Add GCC extensions re: sizeof and alignof *)
diff --git a/cparser/Machine.mli b/cparser/Machine.mli
index f1d3567..3becce3 100644
--- a/cparser/Machine.mli
+++ b/cparser/Machine.mli
@@ -40,8 +40,8 @@ type t = {
   alignof_longdouble: int;
   alignof_void: int option;
   alignof_fun: int option;
+  bigendian: bool;
   bitfields_msb_first: bool
-
 }
 
 val ilp32ll64 : t
diff --git a/cparser/PackedStructs.ml b/cparser/PackedStructs.ml
index 7fc0067..30466cb 100644
--- a/cparser/PackedStructs.ml
+++ b/cparser/PackedStructs.ml
@@ -28,6 +28,11 @@ type field_info = {
   fi_swap: bool                         (* true if byte-swapped *)
 }
 
+(* 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. *)
 
@@ -50,6 +55,15 @@ let align x boundary =
   assert (is_pow2 boundary);
   (x + boundary - 1) land (lnot (boundary - 1))
 
+(* What are the types that can be byte-swapped? *)
+
+let rec can_byte_swap env ty =
+  match unroll env ty with
+  | TInt(ik, _) -> (true, sizeof_ikind ik > 1)
+  | TPtr(_, _) -> (true, true)          (* tolerance? *)
+  | TArray(ty_elt, _, _) -> can_byte_swap env ty_elt
+  | _ -> (false, false)
+
 (* Layout algorithm *)
 
 let layout_struct mfa msa swapped loc env struct_id fields =
@@ -63,13 +77,21 @@ let layout_struct mfa msa swapped loc env struct_id fields =
       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;
+        | _, _ -> error "%a: Error: struct field has incomplete type" formatloc loc;
                   (0, 1) 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 = swapped};
+         {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
@@ -80,6 +102,11 @@ let layout_struct mfa msa swapped loc env struct_id fields =
 
 (* Rewriting of struct declarations *)
 
+let payload_field sz =
+  { fld_name = "__payload";
+    fld_typ = TArray(TInt(IUChar, []), Some(Int64.of_int sz), []);
+    fld_bitfield = None}
+
 let transf_composite loc env su id attrs ml =
   match su with
   | Union -> (attrs, ml)
@@ -93,13 +120,12 @@ let transf_composite loc env su id attrs ml =
           (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 =
-          {fld_name = "__payload";
-           fld_typ = TArray(TInt(IChar, []), Some(Int64.of_int sz), []);
-           fld_bitfield = None}
+          payload_field sz
         in (attrs, [field])
       end
 
@@ -152,7 +178,8 @@ let arrow_packed_field base pf ty =
   ederef ty (ecast (TPtr(ty, [])) (eoffset payload pf.fi_offset))
 
 (*  (ty) __builtin_read_NN_reversed(&lval)  *)
-let bswap_read loc env lval ty =
+let bswap_read loc env lval =
+  let ty = lval.etyp in
   let (bsize, aty) =
     accessor_type loc env ty in
   if bsize = 8 then lval else begin
@@ -165,7 +192,8 @@ let bswap_read loc env lval ty =
   end
 
 (*  __builtin_write_intNN_reversed(&lhs,rhs)  *)
-let bswap_write loc env lhs rhs ty =
+let bswap_write loc env lhs rhs =
+  let ty = lhs.etyp in
   let (bsize, aty) =
     accessor_type loc env ty in
   if bsize = 8 then eassign lhs rhs else begin
@@ -227,14 +255,31 @@ let transf_expr loc env ctx e =
 
     | EUnop(Odot _, _) | EUnop(Oarrow _, _) | EBinop(Oindex, _, _, _) ->
         let (e', swap) = lvalue e in
-        if swap then bswap_read loc env e' e'.etyp else e'
+        if swap then bswap_read loc env e' else e'
 
-    | EUnop((Oaddrof|Opreincr|Opredecr|Opostincr|Opostdecr as op), e1) ->
+    | EUnop(Oaddrof, e1) ->
         let (e1', swap) = lvalue e1 in
         if swap then
-          error "%a: Error: &, ++ and -- over byte-swapped field are not supported"
-                formatloc loc;
-        {edesc = EUnop(op, e1'); etyp = e.etyp}
+          error "%a: Error: & over byte-swapped field" formatloc loc;
+        {edesc = EUnop(Oaddrof, e1'); etyp = e.etyp}
+
+    | EUnop((Opreincr|Opredecr) as op, e1) ->
+        let (e1', swap) = lvalue e1 in
+        if swap then
+          expand_preincrdecr
+            ~read:(bswap_read loc env) ~write:(bswap_write loc env)
+            env ctx op e1'
+        else
+          {edesc = EUnop(op, e1'); etyp = e.etyp}
+
+    | EUnop((Opostincr|Opostdecr as op), e1) ->
+        let (e1', swap) = lvalue e1 in
+        if swap then
+          expand_postincrdecr
+            ~read:(bswap_read loc env) ~write:(bswap_write loc env)
+            env ctx op e1'
+        else
+          {edesc = EUnop(op, e1'); etyp = e.etyp}
 
     | EUnop(op, e1) ->
         {edesc = EUnop(op, texp Val e1); etyp = e.etyp}
@@ -242,12 +287,9 @@ let transf_expr loc env ctx e =
     | EBinop(Oassign, e1, e2, ty) ->
         let (e1', swap) = lvalue e1 in
         let e2' = texp Val e2 in
-        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
+        if swap then
+          expand_assign ~write:(bswap_write loc env) env ctx e1' e2'
+        else
           {edesc = EBinop(Oassign, e1', e2', ty); etyp = e.etyp}
 
     | EBinop((Oadd_assign|Osub_assign|Omul_assign|Odiv_assign|Omod_assign|
@@ -256,9 +298,11 @@ let transf_expr loc env ctx e =
         let (e1', swap) = lvalue e1 in
         let e2' = texp Val e2 in
         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}
+          expand_assignop
+            ~read:(bswap_read loc env) ~write:(bswap_write loc env)
+            env ctx op e1' e2' ty
+        else
+          {edesc = EBinop(op, e1', e2', ty); etyp = e.etyp}
 
     | EBinop(Ocomma, e1, e2, ty) ->
         {edesc = EBinop(Ocomma, texp Effects e1, texp Val e2, ty);
@@ -291,29 +335,80 @@ let transf_fundef env f =
 
 (* Initializers *)
 
-let rec check_init i =
-  match i with
-  | Init_single e -> true
-  | Init_array il -> List.for_all check_init il
+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
+    | (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 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) ->
-      List.for_all
-        (fun (f, i) ->
-          not (Hashtbl.mem packed_fields (id, f.fld_name)))
-        fld_init_list
-  | Init_union(id, fld, i) ->
-      check_init i
+      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)
+      end
+  | Init_union(id, fld, i) -> Init_union(id, fld, trinit i)
+  in trinit i
 
 (* Declarations *)
 
-let transf_decl loc env (sto, id, ty, init_opt as decl) =
-  begin match init_opt with
-  | None -> () 
-  | Some i ->
-      if not (check_init i) then
-        error "%a: Error: Initialization of packed structs is not supported"
-              formatloc loc
-  end;
-  decl
+let transf_decl loc env (sto, id, ty, init_opt) =
+  (sto, id, ty,
+   match init_opt with
+   | None -> None
+   | Some i -> Some (transf_init loc env i))
 
 (* Pragmas *)
 
diff --git a/cparser/SimplVolatile.ml b/cparser/SimplVolatile.ml
index b155a3c..ef7a3a0 100644
--- a/cparser/SimplVolatile.ml
+++ b/cparser/SimplVolatile.ml
@@ -21,69 +21,6 @@ open C
 open Cutil
 open Transform
 
-(* Expansion of read-write-modify constructs. *)
-
-(* Temporaries must not be [const] because we assign into them,
-   and should not be [volatile] because they are private. *)
-
-let mk_temp env ty =
-  new_temp (erase_attributes_type env ty)
-
-(** [l = r]. *)
-
-let mk_assign env ctx l r =
-  match ctx with
-  | Effects ->
-      eassign l r
-  | Val ->
-      let tmp = mk_temp env l.etyp in
-      ecomma (eassign tmp r) (ecomma (eassign l tmp) tmp)
-
-(** [l op= r].  Warning: [l] is evaluated twice. *)
-
-let mk_assignop env ctx op l r ty =
-  let op' =
-    match op with
-    | Oadd_assign -> Oadd | Osub_assign -> Osub
-    | Omul_assign -> Omul | Odiv_assign -> Odiv | Omod_assign -> Omod
-    | Oand_assign -> Oand | Oor_assign -> Oor   | Oxor_assign -> Oxor
-    | Oshl_assign -> Oshl | Oshr_assign -> Oshr
-    | _ -> assert false in
-  let res = {edesc = EBinop(op', l, r, ty); etyp = ty} in
-  match ctx with
-  | Effects ->
-      eassign l res
-  | Val ->
-      let tmp = mk_temp env l.etyp in
-      ecomma (eassign tmp res) (ecomma (eassign l tmp) tmp)
-
-(** [++l] or [--l].  Warning: [l] is evaluated twice. *)
-
-let mk_preincrdecr env ctx op l ty =
-  let op' =
-    match op with
-    | Opreincr -> Oadd_assign
-    | Opredecr -> Osub_assign
-    | _ -> assert false in  
-  mk_assignop env ctx op' l (intconst 1L IInt) ty
-
-(** [l++] or [l--].  Warning: [l] is evaluated twice. *)
-
-let mk_postincrdecr env ctx op l ty =
-  let op' =
-    match op with
-    | Opostincr -> Oadd
-    | Opostdecr -> Osub
-    | _ -> assert false in  
-  match ctx with
-  | Effects ->
-      let newval = {edesc = EBinop(op', l, intconst 1L IInt, ty); etyp = ty} in
-      eassign l newval
-  | Val ->
-      let tmp = mk_temp env l.etyp in
-      let newval = {edesc = EBinop(op', tmp, intconst 1L IInt, ty); etyp = ty} in
-      ecomma (eassign tmp l) (ecomma (eassign l newval) tmp)
-
 (* Rewriting of expressions *)
 
 let transf_expr loc env ctx e =
@@ -97,22 +34,22 @@ let transf_expr loc env ctx e =
     | ESizeof _ -> e
     | EVar _ -> e
     | EUnop((Opreincr|Opredecr as op), e1) when is_volatile e1.etyp ->
-        bind_lvalue env (texp Val e1)
-          (fun l -> mk_preincrdecr env ctx op l (unary_conversion env l.etyp))
+        expand_preincrdecr ~read:(fun e -> e) ~write:eassign
+                           env ctx op (texp Val e1)
     | EUnop((Opostincr|Opostdecr as op), e1) when is_volatile e1.etyp ->
-        bind_lvalue env (texp Val e1)
-          (fun l -> mk_postincrdecr env ctx op l (unary_conversion env l.etyp))
+        expand_postincrdecr ~read:(fun e -> e) ~write:eassign
+                            env ctx op (texp Val e1)
     | EUnop(op, e1) ->
         {edesc = EUnop(op, texp Val e1); etyp = e.etyp}
     | EBinop(Oassign, e1, e2, ty) when is_volatile e1.etyp ->
-        mk_assign env ctx (texp Val e1) (texp Val e2)
+        expand_assign ~write:eassign env ctx (texp Val e1) (texp Val e2)
     | 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)
       when is_volatile e1.etyp ->
-        bind_lvalue env (texp Val e1)
-          (fun l -> mk_assignop env ctx op l (texp Val e2) ty)
+        expand_assignop ~read:(fun e -> e) ~write:eassign
+                        env ctx op (texp Val e1) (texp Val e2) ty
     | EBinop(Ocomma, e1, e2, ty) ->
         {edesc = EBinop(Ocomma, texp Effects e1, texp ctx e2, ty);
          etyp = e.etyp}
diff --git a/cparser/Transform.ml b/cparser/Transform.ml
index 8bdf2e2..0e7357b 100644
--- a/cparser/Transform.ml
+++ b/cparser/Transform.ml
@@ -26,6 +26,11 @@ let temporaries = ref ([]: decl list)
 let reset_temps () =
   temporaries := []
 
+let get_temps () =
+  let temps = !temporaries in
+  temporaries := [];
+  List.rev temps
+
 let new_temp_var ?(name = "t") ty =
   let id = Env.fresh_ident name in
   temporaries := (Storage_default, id, ty, None) :: !temporaries;
@@ -35,10 +40,13 @@ let new_temp ?(name = "t") ty =
   let id = new_temp_var ~name ty in
   { edesc = EVar id; etyp = ty }
 
-let get_temps () =
-  let temps = !temporaries in
-  temporaries := [];
-  List.rev temps
+(* Temporaries should not be [const] because we assign into them
+   and not be [volatile] because they are local and not observable *)
+
+let attributes_to_remove_from_temp = add_attributes [AConst] [AVolatile]
+
+let mk_temp env ?(name = "t") ty =
+  new_temp (remove_attributes_type env attributes_to_remove_from_temp ty)
 
 (* Bind a l-value to a temporary variable if it is not invariant. *)
 
@@ -57,11 +65,81 @@ let bind_lvalue env e fn =
            (fn {edesc = EUnop(Oderef, tmp); etyp = e.etyp})
   end
 
-(* Generic transformation of a statement, transforming expressions within
-   and preserving the statement structure.  Applies only to unblocked code. *)
+(* Most transformations over expressions can be optimized if the
+   value of the expression is not needed and it is evaluated only
+   for its side-effects.  The type [context] records whether
+   we are in a side-effects-only position ([Effects]) or not ([Val]). *)
 
 type context = Val | Effects
 
+(* Expansion of assignment expressions *)
+
+let op_for_assignop = function
+  | Oadd_assign -> Oadd
+  | Osub_assign -> Osub
+  | Omul_assign -> Omul
+  | Odiv_assign -> Odiv
+  | Omod_assign -> Omod
+  | Oand_assign -> Oand
+  | Oor_assign -> Oor 
+  | Oxor_assign -> Oxor
+  | Oshl_assign -> Oshl
+  | Oshr_assign -> Oshr
+  | _ -> assert false
+
+let op_for_incr_decr = function
+  | Opreincr -> Oadd
+  | Opredecr -> Osub
+  | Opostincr -> Oadd
+  | Opostdecr -> Osub
+  | _ -> assert false
+
+let assignop_for_incr_decr = function
+  | Opreincr -> Oadd_assign
+  | Opredecr -> Osub_assign
+  | _ -> assert false
+
+let expand_assign ~write env ctx l r =
+  match ctx with
+  | Effects ->
+      write l r
+  | Val ->
+      let tmp = mk_temp env l.etyp in
+      ecomma (eassign tmp r) (ecomma (write l tmp) tmp)
+
+let expand_assignop ~read ~write env ctx op l r ty =
+  bind_lvalue env l (fun l ->
+    let res = {edesc = EBinop(op_for_assignop op, read l, r, ty); etyp = ty} in
+    match ctx with
+    | Effects ->
+        write l res
+    | Val ->
+        let tmp = mk_temp env l.etyp in
+        ecomma (eassign tmp res) (ecomma (write l tmp) tmp))
+
+let expand_preincrdecr ~read ~write env ctx op l =
+  expand_assignop ~read ~write env ctx (assignop_for_incr_decr op) 
+              l (intconst 1L IInt) (unary_conversion env l.etyp)
+
+let expand_postincrdecr ~read ~write env ctx op l =
+  bind_lvalue env l (fun l ->
+    let ty = unary_conversion env l.etyp in
+    match ctx with
+    | Effects ->
+        let newval =
+          {edesc = EBinop(op_for_incr_decr op, read l, intconst 1L IInt, ty);
+           etyp = ty} in
+        write l newval
+    | Val ->
+        let tmp = mk_temp env l.etyp in
+        let newval =
+          {edesc = EBinop(op_for_incr_decr op, tmp, intconst 1L IInt, ty);
+           etyp = ty} in
+        ecomma (eassign tmp (read l)) (ecomma (write l newval) tmp))
+
+(* Generic transformation of a statement, transforming expressions within
+   and preserving the statement structure.  Applies only to unblocked code. *)
+
 let stmt trexpr env s =
   let rec stm s =
   match s.sdesc with
diff --git a/cparser/Transform.mli b/cparser/Transform.mli
index 8215997..5736abc 100644
--- a/cparser/Transform.mli
+++ b/cparser/Transform.mli
@@ -15,18 +15,41 @@
 
 (** Creation of fresh temporary variables. *)
 val reset_temps : unit -> unit
+val get_temps : unit -> C.decl list
 val new_temp_var : ?name:string -> C.typ -> C.ident
 val new_temp : ?name:string -> C.typ -> C.exp
-val get_temps : unit -> C.decl list
+val mk_temp : Env.t -> ?name:string -> C.typ -> C.exp
 
 (** Avoiding repeated evaluation of a l-value *)
 
 val bind_lvalue: Env.t -> C.exp -> (C.exp -> C.exp) -> C.exp
 
-(** Generic transformation of a statement *)
+(* Most transformations over expressions can be optimized if the
+   value of the expression is not needed and it is evaluated only
+   for its side-effects.  The type [context] records whether
+   we are in a side-effects-only position ([Effects]) or not ([Val]). *)
 
 type context = Val | Effects
 
+(** Expansion of assignment expressions *)
+val op_for_assignop : C.binary_operator -> C.binary_operator
+val op_for_incr_decr : C.unary_operator -> C.binary_operator
+val assignop_for_incr_decr : C.unary_operator -> C.binary_operator
+val expand_assign :
+  write:(C.exp -> C.exp -> C.exp) ->
+  Env.t -> context -> C.exp -> C.exp -> C.exp
+val expand_assignop :
+  read:(C.exp -> C.exp) -> write:(C.exp -> C.exp -> C.exp) ->
+  Env.t -> context -> C.binary_operator -> C.exp -> C.exp -> C.typ -> C.exp
+val expand_preincrdecr :
+  read:(C.exp -> C.exp) -> write:(C.exp -> C.exp -> C.exp) ->
+  Env.t -> context -> C.unary_operator -> C.exp -> C.exp
+val expand_postincrdecr :
+  read:(C.exp -> C.exp) -> write:(C.exp -> C.exp -> C.exp) ->
+  Env.t -> context -> C.unary_operator -> C.exp -> C.exp
+
+(** Generic transformation of a statement *)
+
 val stmt : (C.location -> Env.t -> context -> C.exp -> C.exp) ->
            Env.t -> C.stmt -> C.stmt