Native support for bit fields (#400)

This big PR adds support for bit fields in structs and unions to
the verified part of CompCert, namely the CompCert C and Clight
languages.

The compilation of bit field accesses to normal integer accesses +
shifts and masks is done and proved correct as part of the Cshmgen
pass.

The layout of bit fields in memory is done by the functions in module
Ctypes. It follows the ELF ABI layout algorithm. As a bonus, basic
soundness properties of the layout are shown, such as "two different
bit fields do not overlap" or "a bit field and a regular field do not
overlap".

All this replaces the previous emulation of bit fields by
source-to-source rewriting in the unverified front-end of CompCert
(module cparse/Bitfield.ml). This emulation was prone to errors (see
nonstandard layout instead.

The core idea for the PR is that expressions in l-value position
denote not just a block, a byte offset and a type, but also a bitfield
designator saying whether all the bits of the type are accessed
(designator Full) or only some of its bits (designator
Bits). Designators of the Bits kind appear when the l-value is a bit
field access; the bit width and bit offset in Bits are computed by the
functions in Ctypes that implement the layout algorithm.

Consequently, both in the semantics of CompCert C and Clight and in
the SimplExpr, SimplLocals and Cshmgen compilation passes, pairs of a
type and a bitfield designator are used in a number of places where a
single type was used before.

The introduction of bit fields has a big impact on static
initialization (module cfrontend/Initializers.v), which had to be
rewritten in large part, along with its soundness proof
(cfrontend/Initializersproof.v).

Both static initialization and run-time manipulation of bit fields are
tested in test/abi using differential testing against GCC and
randomly-generated structs.

This work exposed subtle interactions between bit fields and the
volatile modifier. Currently, the volatile modifier is ignored when
accessing a bit field (and a warning is printed at compile-time), just
like it is ignored when accessing a struct or union as a r-value.

Currently, the natural alignment of bit fields and their storage units
cannot be modified with the aligned attribute. _Alignas on bit fields
is rejected as per C11, and the packed modifier cannot be applied to a
struct containing bit fields.

19 files changed, 3243 insertions, 1604 deletions

diff --git a/cfrontend/C2C.ml b/cfrontend/C2C.ml
index 6fce9764..efcf8dfc 100644
--- a/cfrontend/C2C.ml
+++ b/cfrontend/C2C.ml
@@ -612,7 +612,7 @@ let checkFunctionType env tres targs =
     end
   end
 
-let rec convertTyp env t =
+let rec convertTyp env ?bitwidth t =
   match t with
   | C.TVoid a -> Tvoid
   | C.TInt(ik, a) ->
@@ -643,7 +643,21 @@ let rec convertTyp env t =
   | C.TUnion(id, a) ->
       Tunion(intern_string id.name, convertAttr a)
   | C.TEnum(id, a) ->
-      convertIkind Cutil.enum_ikind (convertAttr a)
+      let ik =
+        match bitwidth with
+        | None -> Cutil.enum_ikind
+        | Some w ->
+            let info = Env.find_enum env id in
+            let representable sg =
+              List.for_all (fun (_, v, _) -> Cutil.int_representable v w sg)
+                           info.Env.ei_members in
+            if representable false then
+              Cutil.unsigned_ikind_of Cutil.enum_ikind
+            else if representable true then
+              Cutil.signed_ikind_of Cutil.enum_ikind
+            else
+              Cutil.enum_ikind in
+      convertIkind ik (convertAttr a)
 
 and convertParams env = function
     | [] -> Tnil
@@ -679,9 +693,16 @@ let rec convertTypAnnotArgs env = function
             convertTypAnnotArgs env el)
 
 let convertField env f =
-  if f.fld_bitfield <> None then
-    unsupported "bit field in struct or union (consider adding option [-fbitfields])";
-  (intern_string f.fld_name, convertTyp env f.fld_typ)
+  let id = intern_string f.fld_name
+  and ty = convertTyp env ?bitwidth: f.fld_bitfield f.fld_typ in
+  match f.fld_bitfield with
+  | None -> Member_plain(id, ty)
+  | Some w ->
+      match ty with
+      | Tint(sz, sg, attr) ->
+          Member_bitfield(id, sz, sg, attr, Z.of_uint w, f.fld_name = "")
+      | _ ->
+          fatal_error "bitfield must have type int"
 
 let convertCompositedef env su id attr members =
   if Cutil.find_custom_attributes ["packed";"__packed__"] attr <> [] then
@@ -784,6 +805,11 @@ let convertFloat f kind =
 
 (** Expressions *)
 
+let check_volatile_bitfield env e =
+  if Cutil.is_bitfield env e
+  && List.mem AVolatile (Cutil.attributes_of_type env e.etyp) then
+    warning Diagnostics.Unnamed "access to a volatile bit field, the 'volatile' qualifier is ignored"
+
 let ezero = Eval(Vint(coqint_of_camlint 0l), type_int32s)
 
 let ewrap = function
@@ -798,6 +824,7 @@ let rec convertExpr env e =
   | C.EUnop((C.Oderef|C.Odot _|C.Oarrow _), _)
   | C.EBinop(C.Oindex, _, _, _) ->
       let l = convertLvalue env e in
+      check_volatile_bitfield env e;
       ewrap (Ctyping.evalof l)
 
   | C.EConst(C.CInt(i, k, _)) ->
@@ -867,6 +894,7 @@ let rec convertExpr env e =
       if Cutil.is_composite_type env e2.etyp
       && List.mem AVolatile (Cutil.attributes_of_type env e2.etyp) then
         warning Diagnostics.Unnamed "assignment of a value of volatile composite type, the 'volatile' qualifier is ignored";
+      check_volatile_bitfield env e1;
       ewrap (Ctyping.eassign e1' e2')
   | C.EBinop((C.Oadd_assign|C.Osub_assign|C.Omul_assign|C.Odiv_assign|
               C.Omod_assign|C.Oand_assign|C.Oor_assign|C.Oxor_assign|
@@ -887,6 +915,7 @@ let rec convertExpr env e =
         | _ -> assert false in
       let e1' = convertLvalue env e1 in
       let e2' = convertExpr env e2 in
+      check_volatile_bitfield env e1;
       ewrap (Ctyping.eassignop op' e1' e2')
   | C.EBinop(C.Ocomma, e1, e2, _) ->
       ewrap (Ctyping.ecomma (convertExpr env e1) (convertExpr env e2))
diff --git a/cfrontend/Cexec.v b/cfrontend/Cexec.v
index d763c98c..52037ac0 100644
--- a/cfrontend/Cexec.v
+++ b/cfrontend/Cexec.v
@@ -37,6 +37,10 @@ Notation "'do' X , Y , Z <- A ; B" := (match A with Some (X, Y, Z) => B | None =
   (at level 200, X ident, Y ident, Z ident, A at level 100, B at level 200)
   : option_monad_scope.
 
+Notation "'do' X , Y , Z , W <- A ; B" := (match A with Some (X, Y, Z, W) => B | None => None end)
+  (at level 200, X ident, Y ident, Z ident, W ident, A at level 100, B at level 200)
+  : option_monad_scope.
+
 Notation " 'check' A ; B" := (if A then B else None)
   (at level 200, A at level 100, B at level 200)
   : option_monad_scope.
@@ -61,14 +65,14 @@ Proof.
   intros until ty. destruct a; simpl; congruence.
 Qed.
 
-Definition is_loc (a: expr) : option (block * ptrofs * type) :=
+Definition is_loc (a: expr) : option (block * ptrofs * bitfield * type) :=
   match a with
-  | Eloc b ofs ty => Some(b, ofs, ty)
+  | Eloc b ofs bf ty => Some(b, ofs, bf, ty)
   | _ => None
   end.
 
 Lemma is_loc_inv:
-  forall a b ofs ty, is_loc a = Some(b, ofs, ty) -> a = Eloc b ofs ty.
+  forall a b ofs bf ty, is_loc a = Some(b, ofs, bf, ty) -> a = Eloc b ofs bf ty.
 Proof.
   intros until ty. destruct a; simpl; congruence.
 Qed.
@@ -209,15 +213,15 @@ Definition do_volatile_load (w: world) (chunk: memory_chunk) (m: mem) (b: block)
     Some(w, E0, v).
 
 Definition do_volatile_store (w: world) (chunk: memory_chunk) (m: mem) (b: block) (ofs: ptrofs) (v: val)
-                             : option (world * trace * mem) :=
+                             : option (world * trace * mem * val) :=
   if Genv.block_is_volatile ge b then
     do id <- Genv.invert_symbol ge b;
     do ev <- eventval_of_val (Val.load_result chunk v) (type_of_chunk chunk);
     do w' <- nextworld_vstore w chunk id ofs ev;
-    Some(w', Event_vstore chunk id ofs ev :: nil, m)
+    Some(w', Event_vstore chunk id ofs ev :: nil, m, v)
   else
     do m' <- Mem.store chunk m b (Ptrofs.unsigned ofs) v;
-    Some(w, E0, m').
+    Some(w, E0, m', v).
 
 Lemma do_volatile_load_sound:
   forall w chunk m b ofs w' t v,
@@ -244,21 +248,21 @@ Proof.
 Qed.
 
 Lemma do_volatile_store_sound:
-  forall w chunk m b ofs v w' t m',
-  do_volatile_store w chunk m b ofs v = Some(w', t, m') ->
-  volatile_store ge chunk m b ofs v t m' /\ possible_trace w t w'.
+  forall w chunk m b ofs v w' t m' v',
+  do_volatile_store w chunk m b ofs v = Some(w', t, m', v') ->
+  volatile_store ge chunk m b ofs v t m' /\ possible_trace w t w' /\ v' = v.
 Proof.
-  intros until m'. unfold do_volatile_store. mydestr.
+  intros until v'. unfold do_volatile_store. mydestr.
   split. constructor; auto. apply Genv.invert_find_symbol; auto.
   apply eventval_of_val_sound; auto.
-  econstructor. constructor; eauto. constructor.
-  split. constructor; auto. constructor.
+  split. econstructor. constructor; eauto. constructor. auto.
+  split. constructor; auto. split. constructor. auto.
 Qed.
 
 Lemma do_volatile_store_complete:
   forall w chunk m b ofs v w' t m',
   volatile_store ge chunk m b ofs v t m' -> possible_trace w t w' ->
-  do_volatile_store w chunk m b ofs v = Some(w', t, m').
+  do_volatile_store w chunk m b ofs v = Some(w', t, m', v).
 Proof.
   unfold do_volatile_store; intros. inv H; simpl in *.
   rewrite H1. rewrite (Genv.find_invert_symbol _ _ H2).
@@ -269,16 +273,31 @@ Qed.
 
 (** Accessing locations *)
 
-Definition do_deref_loc (w: world) (ty: type) (m: mem) (b: block) (ofs: ptrofs) : option (world * trace * val) :=
-  match access_mode ty with
-  | By_value chunk =>
+Definition do_deref_loc (w: world) (ty: type) (m: mem) (b: block) (ofs: ptrofs) (bf: bitfield) : option (world * trace * val) :=
+  match bf with
+  | Full =>
+    match access_mode ty with
+    | By_value chunk =>
       match type_is_volatile ty with
       | false => do v <- Mem.loadv chunk m (Vptr b ofs); Some(w, E0, v)
       | true => do_volatile_load w chunk m b ofs
       end
-  | By_reference => Some(w, E0, Vptr b ofs)
-  | By_copy => Some(w, E0, Vptr b ofs)
-  | _ => None
+    | By_reference => Some(w, E0, Vptr b ofs)
+    | By_copy => Some(w, E0, Vptr b ofs)
+    | _ => None
+    end
+  | Bits sz sg pos width =>
+    match ty with
+    | Tint sz1 sg1 _ =>
+      check (intsize_eq sz1 sz &&
+             signedness_eq sg1 (if zlt width (bitsize_intsize sz) then Signed else sg) &&
+             zle 0 pos && zlt 0 width && zle width (bitsize_intsize sz) && zle (pos + width) (bitsize_carrier sz));
+      match Mem.loadv (chunk_for_carrier sz) m (Vptr b ofs) with
+      | Some (Vint c) => Some (w, E0, Vint (bitfield_extract sz sg pos width c))
+      | _ => None
+      end
+    | _ => None
+    end
   end.
 
 Definition assign_copy_ok (ty: type) (b: block) (ofs: ptrofs) (b': block) (ofs': ptrofs) : Prop :=
@@ -310,75 +329,103 @@ Proof with try (right; intuition lia).
   destruct Y... left; intuition lia.
 Defined.
 
-Definition do_assign_loc (w: world) (ty: type) (m: mem) (b: block) (ofs: ptrofs) (v: val): option (world * trace * mem) :=
-  match access_mode ty with
-  | By_value chunk =>
-      match type_is_volatile ty with
-      | false => do m' <- Mem.storev chunk m (Vptr b ofs) v; Some(w, E0, m')
-      | true => do_volatile_store w chunk m b ofs v
-      end
-  | By_copy =>
-      match v with
-      | Vptr b' ofs' =>
-          if check_assign_copy ty b ofs b' ofs' then
-            do bytes <- Mem.loadbytes m b' (Ptrofs.unsigned ofs') (sizeof ge ty);
-            do m' <- Mem.storebytes m b (Ptrofs.unsigned ofs) bytes;
-            Some(w, E0, m')
-          else None
-      | _ => None
-      end
-  | _ => None
+Definition do_assign_loc (w: world) (ty: type) (m: mem) (b: block) (ofs: ptrofs) (bf: bitfield) (v: val): option (world * trace * mem * val) :=
+  match bf with
+  | Full =>
+    match access_mode ty with
+    | By_value chunk =>
+        match type_is_volatile ty with
+        | false => do m' <- Mem.storev chunk m (Vptr b ofs) v; Some(w, E0, m', v)
+        | true => do_volatile_store w chunk m b ofs v
+        end
+    | By_copy =>
+        match v with
+        | Vptr b' ofs' =>
+            if check_assign_copy ty b ofs b' ofs' then
+              do bytes <- Mem.loadbytes m b' (Ptrofs.unsigned ofs') (sizeof ge ty);
+              do m' <- Mem.storebytes m b (Ptrofs.unsigned ofs) bytes;
+              Some(w, E0, m', v)
+            else None
+        | _ => None
+        end
+    | _ => None
+    end
+  | Bits sz sg pos width =>
+    check (zle 0 pos && zlt 0 width && zle width (bitsize_intsize sz) && zle (pos + width) (bitsize_carrier sz));
+    match ty, v, Mem.loadv (chunk_for_carrier sz) m (Vptr b ofs) with
+    | Tint sz1 sg1 _, Vint n, Some (Vint c) =>
+        check (intsize_eq sz1 sz &&
+               signedness_eq sg1 (if zlt width (bitsize_intsize sz) then Signed else sg));
+        do m' <- Mem.storev (chunk_for_carrier sz) m (Vptr b ofs)
+                            (Vint ((Int.bitfield_insert (first_bit sz pos width) width c n)));
+        Some (w, E0, m', Vint (bitfield_normalize sz sg width n))
+    | _, _, _ => None
+    end
   end.
 
 Lemma do_deref_loc_sound:
-  forall w ty m b ofs w' t v,
-  do_deref_loc w ty m b ofs = Some(w', t, v) ->
-  deref_loc ge ty m b ofs t v /\ possible_trace w t w'.
+  forall w ty m b ofs bf w' t v,
+  do_deref_loc w ty m b ofs bf = Some(w', t, v) ->
+  deref_loc ge ty m b ofs bf t v /\ possible_trace w t w'.
 Proof.
   unfold do_deref_loc; intros until v.
-  destruct (access_mode ty) eqn:?; mydestr.
+  destruct bf.
+- destruct (access_mode ty) eqn:?; mydestr.
   intros. exploit do_volatile_load_sound; eauto. intuition. eapply deref_loc_volatile; eauto.
   split. eapply deref_loc_value; eauto. constructor.
   split. eapply deref_loc_reference; eauto. constructor.
   split. eapply deref_loc_copy; eauto. constructor.
+- mydestr. destruct ty; mydestr. InvBooleans. subst i. destruct v0; mydestr.
+  split. eapply deref_loc_bitfield; eauto. econstructor; eauto. constructor.
 Qed.
 
 Lemma do_deref_loc_complete:
-  forall w ty m b ofs w' t v,
-  deref_loc ge ty m b ofs t v -> possible_trace w t w' ->
-  do_deref_loc w ty m b ofs = Some(w', t, v).
+  forall w ty m b ofs bf w' t v,
+  deref_loc ge ty m b ofs bf t v -> possible_trace w t w' ->
+  do_deref_loc w ty m b ofs bf = Some(w', t, v).
 Proof.
   unfold do_deref_loc; intros. inv H.
-  inv H0. rewrite H1; rewrite H2; rewrite H3; auto.
-  rewrite H1; rewrite H2. apply do_volatile_load_complete; auto.
-  inv H0. rewrite H1. auto.
-  inv H0. rewrite H1. auto.
+- inv H0. rewrite H1; rewrite H2; rewrite H3; auto.
+- rewrite H1; rewrite H2. apply do_volatile_load_complete; auto.
+- inv H0. rewrite H1. auto.
+- inv H0. rewrite H1. auto.
+- inv H0. inv H1.
+  unfold proj_sumbool; rewrite ! dec_eq_true, ! zle_true, ! zlt_true by lia. cbn.
+  cbn in H4; rewrite H4. auto. 
 Qed.
 
 Lemma do_assign_loc_sound:
-  forall w ty m b ofs v w' t m',
-  do_assign_loc w ty m b ofs v = Some(w', t, m') ->
-  assign_loc ge ty m b ofs v t m' /\ possible_trace w t w'.
+  forall w ty m b ofs bf v w' t m' v',
+  do_assign_loc w ty m b ofs bf v = Some(w', t, m', v') ->
+  assign_loc ge ty m b ofs bf v t m' v' /\ possible_trace w t w'.
 Proof.
-  unfold do_assign_loc; intros until m'.
-  destruct (access_mode ty) eqn:?; mydestr.
-  intros. exploit do_volatile_store_sound; eauto. intuition. eapply assign_loc_volatile; eauto.
+  unfold do_assign_loc; intros until v'.
+  destruct bf.
+- destruct (access_mode ty) eqn:?; mydestr.
+  intros. exploit do_volatile_store_sound; eauto. intros (P & Q & R). subst v'. intuition. eapply assign_loc_volatile; eauto.
   split. eapply assign_loc_value; eauto. constructor.
   destruct v; mydestr. destruct a as [P [Q R]].
   split. eapply assign_loc_copy; eauto. constructor.
+- mydestr. InvBooleans.
+  destruct ty; mydestr. destruct v; mydestr. destruct v; mydestr. InvBooleans. subst s i.
+  split. eapply assign_loc_bitfield; eauto. econstructor; eauto. constructor.
 Qed.
 
 Lemma do_assign_loc_complete:
-  forall w ty m b ofs v w' t m',
-  assign_loc ge ty m b ofs v t m' -> possible_trace w t w' ->
-  do_assign_loc w ty m b ofs v = Some(w', t, m').
+  forall w ty m b ofs bf v w' t m' v',
+  assign_loc ge ty m b ofs bf v t m' v' -> possible_trace w t w' ->
+  do_assign_loc w ty m b ofs bf v = Some(w', t, m', v').
 Proof.
   unfold do_assign_loc; intros. inv H.
-  inv H0. rewrite H1; rewrite H2; rewrite H3; auto.
-  rewrite H1; rewrite H2. apply do_volatile_store_complete; auto.
-  rewrite H1. destruct (check_assign_copy ty b ofs b' ofs').
+- inv H0. rewrite H1; rewrite H2; rewrite H3; auto.
+- rewrite H1; rewrite H2. apply do_volatile_store_complete; auto.
+- rewrite H1. destruct (check_assign_copy ty b ofs b' ofs').
   inv H0. rewrite H5; rewrite H6; auto.
   elim n. red; tauto.
+- inv H0. inv H1. 
+  unfold proj_sumbool; rewrite ! zle_true, ! zlt_true by lia. cbn.
+  rewrite ! dec_eq_true.
+  cbn in H4; rewrite H4. cbn in H5; rewrite H5. auto.
 Qed.
 
 (** External calls *)
@@ -421,7 +468,7 @@ Definition do_ef_volatile_load (chunk: memory_chunk)
 Definition do_ef_volatile_store (chunk: memory_chunk)
        (w: world) (vargs: list val) (m: mem) : option (world * trace * val * mem) :=
   match vargs with
-  | Vptr b ofs :: v :: nil => do w',t,m' <- do_volatile_store w chunk m b ofs v; Some(w',t,Vundef,m')
+  | Vptr b ofs :: v :: nil => do w',t,m',v' <- do_volatile_store w chunk m b ofs v; Some(w',t,Vundef,m')
   | _ => None
   end.
 
@@ -564,7 +611,7 @@ Proof with try congruence.
   exploit do_volatile_load_sound; eauto. intuition. econstructor; eauto.
 - (* EF_vstore *)
   unfold do_ef_volatile_store. destruct vargs... destruct v... destruct vargs... destruct vargs...
-  mydestr. destruct p as [[w'' t''] m'']. mydestr.
+  mydestr. destruct p as [[[w'' t''] m''] v'']. mydestr.
   exploit do_volatile_store_sound; eauto. intuition. econstructor; eauto.
 - (* EF_malloc *)
   unfold do_ef_malloc. destruct vargs... destruct vargs... mydestr.
@@ -710,6 +757,10 @@ Notation "'do' X , Y , Z <- A ; B" := (match A with Some (X, Y, Z) => B | None =
   (at level 200, X ident, Y ident, Z ident, A at level 100, B at level 200)
   : reducts_monad_scope.
 
+Notation "'do' X , Y , Z , W <- A ; B" := (match A with Some (X, Y, Z, W) => B | None => stuck end)
+  (at level 200, X ident, Y ident, Z ident, W ident, A at level 100, B at level 200)
+  : reducts_monad_scope.
+
 Notation " 'check' A ; B" := (if A then B else stuck)
   (at level 200, A at level 100, B at level 200)
   : reducts_monad_scope.
@@ -718,21 +769,21 @@ Local Open Scope reducts_monad_scope.
 
 Fixpoint step_expr (k: kind) (a: expr) (m: mem): reducts expr :=
   match k, a with
-  | LV, Eloc b ofs ty =>
+  | LV, Eloc b ofs bf ty =>
       nil
   | LV, Evar x ty =>
       match e!x with
       | Some(b, ty') =>
           check type_eq ty ty';
-          topred (Lred "red_var_local" (Eloc b Ptrofs.zero ty) m)
+          topred (Lred "red_var_local" (Eloc b Ptrofs.zero Full ty) m)
       | None =>
           do b <- Genv.find_symbol ge x;
-          topred (Lred "red_var_global" (Eloc b Ptrofs.zero ty) m)
+          topred (Lred "red_var_global" (Eloc b Ptrofs.zero Full ty) m)
       end
   | LV, Ederef r ty =>
       match is_val r with
       | Some(Vptr b ofs, ty') =>
-          topred (Lred "red_deref" (Eloc b ofs ty) m)
+          topred (Lred "red_deref" (Eloc b ofs Full ty) m)
       | Some _ =>
           stuck
       | None =>
@@ -746,11 +797,14 @@ Fixpoint step_expr (k: kind) (a: expr) (m: mem): reducts expr :=
               do co <- ge.(genv_cenv)!id;
               match field_offset ge f (co_members co) with
               | Error _ => stuck
-              | OK delta => topred (Lred "red_field_struct" (Eloc b (Ptrofs.add ofs (Ptrofs.repr delta)) ty) m)
+              | OK (delta, bf) => topred (Lred "red_field_struct" (Eloc b (Ptrofs.add ofs (Ptrofs.repr delta)) bf ty) m)
               end
           | Tunion id _ =>
               do co <- ge.(genv_cenv)!id;
-              topred (Lred "red_field_union" (Eloc b ofs ty) m)
+              match union_field_offset ge f (co_members co) with
+              | Error _ => stuck
+              | OK (delta, bf) => topred (Lred "red_field_union" (Eloc b (Ptrofs.add ofs (Ptrofs.repr delta)) bf ty) m)
+              end
           | _ => stuck
           end
       | Some _ =>
@@ -762,16 +816,19 @@ Fixpoint step_expr (k: kind) (a: expr) (m: mem): reducts expr :=
       nil
   | RV, Evalof l ty =>
       match is_loc l with
-      | Some(b, ofs, ty') =>
+      | Some(b, ofs, bf, ty') =>
           check type_eq ty ty';
-          do w',t,v <- do_deref_loc w ty m b ofs;
+          do w',t,v <- do_deref_loc w ty m b ofs bf;
           topred (Rred "red_rvalof" (Eval v ty) m t)
       | None =>
           incontext (fun x => Evalof x ty) (step_expr LV l m)
       end
   | RV, Eaddrof l ty =>
       match is_loc l with
-      | Some(b, ofs, ty') => topred (Rred "red_addrof" (Eval (Vptr b ofs) ty) m E0)
+      | Some(b, ofs, bf, ty') =>
+          match bf with Full => topred (Rred "red_addrof" (Eval (Vptr b ofs) ty) m E0)
+                      | Bits _ _ _ _ => stuck
+          end
       | None => incontext (fun x => Eaddrof x ty) (step_expr LV l m)
       end
   | RV, Eunop op r1 ty =>
@@ -831,21 +888,21 @@ Fixpoint step_expr (k: kind) (a: expr) (m: mem): reducts expr :=
       topred (Rred "red_alignof" (Eval (Vptrofs (Ptrofs.repr (alignof ge ty'))) ty) m E0)
   | RV, Eassign l1 r2 ty =>
       match is_loc l1, is_val r2 with
-      | Some(b, ofs, ty1), Some(v2, ty2) =>
+      | Some(b, ofs, bf, ty1), Some(v2, ty2) =>
           check type_eq ty1 ty;
           do v <- sem_cast v2 ty2 ty1 m;
-          do w',t,m' <- do_assign_loc w ty1 m b ofs v;
-          topred (Rred "red_assign" (Eval v ty) m' t)
+          do w',t,m',v' <- do_assign_loc w ty1 m b ofs bf v;
+          topred (Rred "red_assign" (Eval v' ty) m' t)
       | _, _ =>
          incontext2 (fun x => Eassign x r2 ty) (step_expr LV l1 m)
                     (fun x => Eassign l1 x ty) (step_expr RV r2 m)
       end
   | RV, Eassignop op l1 r2 tyres ty =>
       match is_loc l1, is_val r2 with
-      | Some(b, ofs, ty1), Some(v2, ty2) =>
+      | Some(b, ofs, bf, ty1), Some(v2, ty2) =>
           check type_eq ty1 ty;
-          do w',t,v1 <- do_deref_loc w ty1 m b ofs;
-          let r' := Eassign (Eloc b ofs ty1)
+          do w',t,v1 <- do_deref_loc w ty1 m b ofs bf;
+          let r' := Eassign (Eloc b ofs bf ty1)
                            (Ebinop op (Eval v1 ty1) (Eval v2 ty2) tyres) ty1 in
           topred (Rred "red_assignop" r' m t)
       | _, _ =>
@@ -854,12 +911,12 @@ Fixpoint step_expr (k: kind) (a: expr) (m: mem): reducts expr :=
       end
   | RV, Epostincr id l ty =>
       match is_loc l with
-      | Some(b, ofs, ty1) =>
+      | Some(b, ofs, bf, ty1) =>
           check type_eq ty1 ty;
-          do w',t, v1 <- do_deref_loc w ty m b ofs;
+          do w',t, v1 <- do_deref_loc w ty m b ofs bf;
           let op := match id with Incr => Oadd | Decr => Osub end in
           let r' :=
-            Ecomma (Eassign (Eloc b ofs ty)
+            Ecomma (Eassign (Eloc b ofs bf ty)
                            (Ebinop op (Eval v1 ty) (Eval (Vint Int.one) type_int32s) (incrdecr_type ty))
                            ty)
                    (Eval v1 ty) ty in
@@ -926,8 +983,8 @@ with step_exprlist (rl: exprlist) (m: mem): reducts exprlist :=
 Inductive imm_safe_t: kind -> expr -> mem -> Prop :=
   | imm_safe_t_val: forall v ty m,
       imm_safe_t RV (Eval v ty) m
-  | imm_safe_t_loc: forall b ofs ty m,
-      imm_safe_t LV (Eloc b ofs ty) m
+  | imm_safe_t_loc: forall b ofs ty bf m,
+      imm_safe_t LV (Eloc b ofs bf ty) m
   | imm_safe_t_lred: forall to C l m l' m',
       lred ge e l m l' m' ->
       context LV to C ->
@@ -961,23 +1018,25 @@ Fixpoint exprlist_all_values (rl: exprlist) : Prop :=
 
 Definition invert_expr_prop (a: expr) (m: mem) : Prop :=
   match a with
-  | Eloc b ofs ty => False
+  | Eloc b ofs bf ty => False
   | Evar x ty =>
       exists b,
       e!x = Some(b, ty)
       \/ (e!x = None /\ Genv.find_symbol ge x = Some b)
   | Ederef (Eval v ty1) ty =>
       exists b, exists ofs, v = Vptr b ofs
+  | Eaddrof (Eloc b ofs bf ty1) ty =>
+      bf = Full
   | Efield (Eval v ty1) f ty =>
       exists b, exists ofs, v = Vptr b ofs /\
       match ty1 with
-      | Tstruct id _ => exists co delta, ge.(genv_cenv)!id = Some co /\ field_offset ge f (co_members co) = OK delta
-      | Tunion  id _ => exists co, ge.(genv_cenv)!id = Some co
+      | Tstruct id _ => exists co delta bf, ge.(genv_cenv)!id = Some co /\ field_offset ge f (co_members co) = OK (delta, bf)
+      | Tunion id _ => exists co delta bf, ge.(genv_cenv)!id = Some co /\ union_field_offset ge f (co_members co) = OK (delta, bf)
       | _ => False
       end
   | Eval v ty => False
-  | Evalof (Eloc b ofs ty') ty =>
-      ty' = ty /\ exists t, exists v, exists w', deref_loc ge ty m b ofs t v /\ possible_trace w t w'
+  | Evalof (Eloc b ofs bf ty') ty =>
+      ty' = ty /\ exists t, exists v, exists w', deref_loc ge ty m b ofs bf t v /\ possible_trace w t w'
   | Eunop op (Eval v1 ty1) ty =>
       exists v, sem_unary_operation op v1 ty1 m = Some v
   | Ebinop op (Eval v1 ty1) (Eval v2 ty2) ty =>
@@ -990,15 +1049,15 @@ Definition invert_expr_prop (a: expr) (m: mem) : Prop :=
       exists b, bool_val v1 ty1 m = Some b
   | Econdition (Eval v1 ty1) r1 r2 ty =>
       exists b, bool_val v1 ty1 m = Some b
-  | Eassign (Eloc b ofs ty1) (Eval v2 ty2) ty =>
-      exists v, exists m', exists t, exists w',
-      ty = ty1 /\ sem_cast v2 ty2 ty1 m = Some v /\ assign_loc ge ty1 m b ofs v t m' /\ possible_trace w t w'
-  | Eassignop op (Eloc b ofs ty1) (Eval v2 ty2) tyres ty =>
+  | Eassign (Eloc b ofs bf ty1) (Eval v2 ty2) ty =>
+      exists v, exists m', exists v', exists t, exists w',
+      ty = ty1 /\ sem_cast v2 ty2 ty1 m = Some v /\ assign_loc ge ty1 m b ofs bf v t m' v' /\ possible_trace w t w'
+  | Eassignop op (Eloc b ofs bf ty1) (Eval v2 ty2) tyres ty =>
       exists t, exists v1, exists w',
-      ty = ty1 /\ deref_loc ge ty1 m b ofs t v1 /\ possible_trace w t w'
-  | Epostincr id (Eloc b ofs ty1) ty =>
+      ty = ty1 /\ deref_loc ge ty1 m b ofs bf t v1 /\ possible_trace w t w'
+  | Epostincr id (Eloc b ofs bf ty1) ty =>
       exists t, exists v1, exists w',
-      ty = ty1 /\ deref_loc ge ty m b ofs t v1 /\ possible_trace w t w'
+      ty = ty1 /\ deref_loc ge ty m b ofs bf t v1 /\ possible_trace w t w'
   | Ecomma (Eval v ty1) r2 ty =>
       typeof r2 = ty
   | Eparen (Eval v1 ty1) tycast ty =>
@@ -1026,8 +1085,8 @@ Proof.
   exists b; auto.
   exists b; auto.
   exists b; exists ofs; auto.
-  exists b; exists ofs; split; auto. exists co, delta; auto.
-  exists b; exists ofs; split; auto. exists co; auto.
+  exists b; exists ofs; split; auto. exists co, delta, bf; auto.
+  exists b; exists ofs; split; auto. exists co, delta, bf; auto.
 Qed.
 
 Lemma rred_invert:
@@ -1041,7 +1100,7 @@ Proof.
   exists true; auto. exists false; auto.
   exists true; auto. exists false; auto.
   exists b; auto.
-  exists v; exists m'; exists t; exists w'; auto.
+  exists v; exists m'; exists v'; exists t; exists w'; auto.
   exists t; exists v1; exists w'; auto.
   exists t; exists v1; exists w'; auto.
   exists v; auto.
@@ -1076,7 +1135,7 @@ Proof.
   destruct (C a); auto; contradiction.
   destruct (C a); auto; contradiction.
   destruct (C a); auto; contradiction.
-  auto.
+  destruct (C a); auto; contradiction.
   destruct (C a); auto; contradiction.
   destruct (C a); auto; contradiction.
   destruct e1; auto; destruct (C a); auto; contradiction.
@@ -1102,7 +1161,7 @@ Lemma imm_safe_t_inv:
   forall k a m,
   imm_safe_t k a m ->
   match a with
-  | Eloc _ _ _ => True
+  | Eloc _ _ _ _ => True
   | Eval _ _ => True
   | _ => invert_expr_prop a m
   end.
@@ -1228,7 +1287,7 @@ Qed.
 Lemma not_invert_ok:
   forall k a m,
   match a with
-  | Eloc _ _ _ => False
+  | Eloc _ _ _ _ => False
   | Eval _ _ => False
   | _ => invert_expr_prop a m -> False
   end ->
@@ -1369,18 +1428,19 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence;
   destruct ty'...
   (* top struct *)
   destruct (ge.(genv_cenv)!i0) as [co|] eqn:?...
-  destruct (field_offset ge f (co_members co)) as [delta|] eqn:?...
+  destruct (field_offset ge f (co_members co)) as [[delta bf]|] eqn:?...
   apply topred_ok; auto. eapply red_field_struct; eauto.
   (* top union *)
   destruct (ge.(genv_cenv)!i0) as [co|] eqn:?...
+  destruct (union_field_offset ge f (co_members co)) as [[delta bf]|] eqn:?...
   apply topred_ok; auto. eapply red_field_union; eauto.
   (* in depth *)
   eapply incontext_ok; eauto.
 (* Evalof *)
-  destruct (is_loc a) as [[[b ofs] ty'] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ Heqo).
+  destruct (is_loc a) as [[[[b ofs] bf] ty']  | ] eqn:?. rewrite (is_loc_inv _ _ _ _ _ Heqo).
   (* top *)
   destruct (type_eq ty ty')... subst ty'.
-  destruct (do_deref_loc w ty m b ofs) as [[[w' t] v] | ] eqn:?.
+  destruct (do_deref_loc w ty m b ofs bf) as [[[w' t] v] | ] eqn:?.
   exploit do_deref_loc_sound; eauto. intros [A B].
   apply topred_ok; auto. red. split. apply red_rvalof; auto. exists w'; auto.
   apply not_invert_ok; simpl; intros; myinv. exploit do_deref_loc_complete; eauto. congruence.
@@ -1393,8 +1453,9 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence;
   (* depth *)
   eapply incontext_ok; eauto.
 (* Eaddrof *)
-  destruct (is_loc a) as [[[b ofs] ty'] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ Heqo).
+  destruct (is_loc a) as [[[[b ofs] bf ] ty'] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ _ Heqo).
   (* top *)
+  destruct bf... 
   apply topred_ok; auto. split. apply red_addrof; auto. exists w; constructor.
   (* depth *)
   eapply incontext_ok; eauto.
@@ -1450,26 +1511,26 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence;
 (* alignof *)
   apply topred_ok; auto. split. apply red_alignof. exists w; constructor.
 (* assign *)
-  destruct (is_loc a1) as [[[b ofs] ty1] | ] eqn:?.
+  destruct (is_loc a1) as [[[[b ofs] bf] ty1] | ] eqn:?.
   destruct (is_val a2) as [[v2 ty2] | ] eqn:?.
-  rewrite (is_loc_inv _ _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0).
+  rewrite (is_loc_inv _ _ _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0).
   (* top *)
   destruct (type_eq ty1 ty)... subst ty1.
   destruct (sem_cast v2 ty2 ty m) as [v|] eqn:?...
-  destruct (do_assign_loc w ty m b ofs v) as [[[w' t] m']|] eqn:?.
+  destruct (do_assign_loc w ty m b ofs bf v) as [[[[w' t] m'] v']|] eqn:?.
   exploit do_assign_loc_sound; eauto. intros [P Q].
-  apply topred_ok; auto. split. apply red_assign; auto. exists w'; auto.
+  apply topred_ok; auto. split. eapply red_assign; eauto. exists w'; auto.
   apply not_invert_ok; simpl; intros; myinv. exploit do_assign_loc_complete; eauto. congruence.
   (* depth *)
   eapply incontext2_ok; eauto.
   eapply incontext2_ok; eauto.
 (* assignop *)
-  destruct (is_loc a1) as [[[b ofs] ty1] | ] eqn:?.
+  destruct (is_loc a1) as [[[[b ofs] bf] ty1] | ] eqn:?.
   destruct (is_val a2) as [[v2 ty2] | ] eqn:?.
-  rewrite (is_loc_inv _ _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0).
+  rewrite (is_loc_inv _ _ _ _ _ Heqo). rewrite (is_val_inv _ _ _ Heqo0).
   (* top *)
   destruct (type_eq ty1 ty)... subst ty1.
-  destruct (do_deref_loc w ty m b ofs) as [[[w' t] v] | ] eqn:?.
+  destruct (do_deref_loc w ty m b ofs bf) as [[[w' t] v] | ] eqn:?.
   exploit do_deref_loc_sound; eauto. intros [A B].
   apply topred_ok; auto. red. split. apply red_assignop; auto. exists w'; auto.
   apply not_invert_ok; simpl; intros; myinv. exploit do_deref_loc_complete; eauto. congruence.
@@ -1477,10 +1538,10 @@ Proof with (try (apply not_invert_ok; simpl; intro; myinv; intuition congruence;
   eapply incontext2_ok; eauto.
   eapply incontext2_ok; eauto.
 (* postincr *)
-  destruct (is_loc a) as [[[b ofs] ty'] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ Heqo).
+  destruct (is_loc a) as [[[[b ofs] bf] ty'] | ] eqn:?. rewrite (is_loc_inv _ _ _ _ _ Heqo).
   (* top *)
   destruct (type_eq ty' ty)... subst ty'.
-  destruct (do_deref_loc w ty m b ofs) as [[[w' t] v] | ] eqn:?.
+  destruct (do_deref_loc w ty m b ofs bf) as [[[w' t] v] | ] eqn:?.
   exploit do_deref_loc_sound; eauto. intros [A B].
   apply topred_ok; auto. red. split. apply red_postincr; auto. exists w'; auto.
   apply not_invert_ok; simpl; intros; myinv. exploit do_deref_loc_complete; eauto. congruence.
@@ -1576,7 +1637,7 @@ Proof.
 (* field struct *)
   rewrite H, H0; econstructor; eauto.
 (* field union *)
-  rewrite H; econstructor; eauto.
+  rewrite H, H0; econstructor; eauto.
 Qed.
 
 Lemma rred_topred:
@@ -1587,7 +1648,7 @@ Proof.
   induction 1; simpl; intros.
 (* valof *)
   rewrite dec_eq_true.
-  rewrite (do_deref_loc_complete _ _ _ _ _ _ _ _ H H0). econstructor; eauto.
+  rewrite (do_deref_loc_complete _ _ _ _ _ _ _ _ _ H H0). econstructor; eauto.
 (* addrof *)
   inv H. econstructor; eauto.
 (* unop *)
@@ -1609,13 +1670,13 @@ Proof.
 (* alignof *)
   inv H. econstructor; eauto.
 (* assign *)
-  rewrite dec_eq_true. rewrite H. rewrite (do_assign_loc_complete _ _ _ _ _ _ _ _ _ H0 H1).
+  rewrite dec_eq_true. rewrite H. rewrite (do_assign_loc_complete _ _ _ _ _ _ _ _ _ _ _ H0 H1).
   econstructor; eauto.
 (* assignop *)
-  rewrite dec_eq_true. rewrite (do_deref_loc_complete _ _ _ _ _ _ _ _ H H0).
+  rewrite dec_eq_true. rewrite (do_deref_loc_complete _ _ _ _ _ _ _ _ _ H H0).
   econstructor; eauto.
 (* postincr *)
-  rewrite dec_eq_true. subst. rewrite (do_deref_loc_complete _ _ _ _ _ _ _ _ H H1).
+  rewrite dec_eq_true. subst. rewrite (do_deref_loc_complete _ _ _ _ _ _ _ _ _ H H1).
   econstructor; eauto.
 (* comma *)
   inv H0. rewrite dec_eq_true. econstructor; eauto.
@@ -1664,10 +1725,10 @@ Proof.
 Qed.
 
 Lemma reducts_incl_loc:
-  forall (A: Type) a m b ofs ty (C: expr -> A) res,
-  is_loc a = Some(b, ofs, ty) -> reducts_incl C (step_expr LV a m) res.
+  forall (A: Type) a m b ofs ty bf (C: expr -> A) res,
+  is_loc a = Some(b, ofs, bf, ty) -> reducts_incl C (step_expr LV a m) res.
 Proof.
-  intros. rewrite (is_loc_inv _ _ _ _ H). apply reducts_incl_nil.
+  intros. rewrite (is_loc_inv _ _ _ _ _ H). apply reducts_incl_nil.
 Qed.
 
 Lemma reducts_incl_listval:
@@ -1732,10 +1793,10 @@ Proof.
   destruct (is_val (C a)) as [[v ty']|] eqn:?; eauto.
 (* valof *)
   eapply reducts_incl_trans with (C' := fun x => Evalof x ty); eauto.
-  destruct (is_loc (C a)) as [[[b ofs] ty']|] eqn:?; eauto.
+  destruct (is_loc (C a)) as [[[[b ofs] bf] ty']|] eqn:?; eauto.
 (* addrof *)
   eapply reducts_incl_trans with (C' := fun x => Eaddrof x ty); eauto.
-  destruct (is_loc (C a)) as [[[b ofs] ty']|] eqn:?; eauto.
+  destruct (is_loc (C a)) as [[[[b ofs] bf] ty']|] eqn:?; eauto.
 (* unop *)
   eapply reducts_incl_trans with (C' := fun x => Eunop op x ty); eauto.
   destruct (is_val (C a)) as [[v ty']|] eqn:?; eauto.
@@ -1760,21 +1821,21 @@ Proof.
   destruct (is_val (C a)) as [[v ty']|] eqn:?; eauto.
 (* assign left *)
   eapply reducts_incl_trans with (C' := fun x => Eassign x e2 ty); eauto.
-  destruct (is_loc (C a)) as [[[b ofs] ty']|] eqn:?; eauto.
+  destruct (is_loc (C a)) as [[[[b ofs] bf] ty']|] eqn:?; eauto.
 (* assign right *)
   eapply reducts_incl_trans with (C' := fun x => Eassign e1 x ty); eauto.
-  destruct (is_loc e1) as [[[b ofs] ty1]|] eqn:?; eauto.
+  destruct (is_loc e1) as [[[[b ofs] bf] ty1]|] eqn:?; eauto.
   destruct (is_val (C a)) as [[v2 ty2]|] eqn:?; eauto.
 (* assignop left *)
   eapply reducts_incl_trans with (C' := fun x => Eassignop op x e2 tyres ty); eauto.
-  destruct (is_loc (C a)) as [[[b ofs] ty']|] eqn:?; eauto.
+  destruct (is_loc (C a)) as [[[[b ofs] bf] ty']|] eqn:?; eauto.
 (* assignop right *)
   eapply reducts_incl_trans with (C' := fun x => Eassignop op e1 x tyres ty); eauto.
-  destruct (is_loc e1) as [[[b ofs] ty1]|] eqn:?; eauto.
+  destruct (is_loc e1) as [[[[b ofs] bf] ty1]|] eqn:?; eauto.
   destruct (is_val (C a)) as [[v2 ty2]|] eqn:?; eauto.
 (* postincr *)
   eapply reducts_incl_trans with (C' := fun x => Epostincr id x ty); eauto.
-  destruct (is_loc (C a)) as [[[b ofs] ty']|] eqn:?; eauto.
+  destruct (is_loc (C a)) as [[[[b ofs] bf] ty']|] eqn:?; eauto.
 (* call left *)
   eapply reducts_incl_trans with (C' := fun x => Ecall x el ty); eauto.
   destruct (is_val (C a)) as [[v ty']|] eqn:?; eauto.
@@ -1915,7 +1976,7 @@ Function sem_bind_parameters (w: world) (e: env) (m: mem) (l: list (ident * type
       match PTree.get id e with
          | Some (b, ty') =>
              check (type_eq ty ty');
-             do w', t, m1 <- do_assign_loc w ty m b Ptrofs.zero v1;
+             do w', t, m1, v' <- do_assign_loc w ty m b Ptrofs.zero Full v1;
              match t with nil => sem_bind_parameters w e m1 params lv | _ => None end
         | None => None
       end
@@ -1935,10 +1996,11 @@ Lemma sem_bind_parameters_complete : forall w e m l lv m',
   bind_parameters ge e m l lv m' ->
   sem_bind_parameters w e m l lv = Some m'.
 Proof.
+Local Opaque do_assign_loc.
    induction 1; simpl; auto.
    rewrite H. rewrite dec_eq_true.
    assert (possible_trace w E0 w) by constructor.
-   rewrite (do_assign_loc_complete _ _ _ _ _ _ _ _ _ H0 H2).
+   rewrite (do_assign_loc_complete _ _ _ _ _ _ _ _ _ _ _ H0 H2).
    simpl. auto.
 Qed.
 
diff --git a/cfrontend/Clight.v b/cfrontend/Clight.v
index 3b21be28..d15bc90a 100644
--- a/cfrontend/Clight.v
+++ b/cfrontend/Clight.v
@@ -197,36 +197,42 @@ Definition empty_env: env := (PTree.empty (block * type)).
 
 Definition temp_env := PTree.t val.
 
-(** [deref_loc ty m b ofs v] computes the value of a datum
-  of type [ty] residing in memory [m] at block [b], offset [ofs].
+(** [deref_loc ty m b ofs bf v] computes the value of a datum
+  of type [ty] residing in memory [m] at block [b], offset [ofs],
+  and bitfield designation [bf].
   If the type [ty] indicates an access by value, the corresponding
   memory load is performed.  If the type [ty] indicates an access by
   reference or by copy, the pointer [Vptr b ofs] is returned. *)
 
-Inductive deref_loc (ty: type) (m: mem) (b: block) (ofs: ptrofs) : val -> Prop :=
+Inductive deref_loc (ty: type) (m: mem) (b: block) (ofs: ptrofs) : 
+                                             bitfield -> val -> Prop :=
   | deref_loc_value: forall chunk v,
       access_mode ty = By_value chunk ->
       Mem.loadv chunk m (Vptr b ofs) = Some v ->
-      deref_loc ty m b ofs v
+      deref_loc ty m b ofs Full v
   | deref_loc_reference:
       access_mode ty = By_reference ->
-      deref_loc ty m b ofs (Vptr b ofs)
+      deref_loc ty m b ofs Full (Vptr b ofs)
   | deref_loc_copy:
       access_mode ty = By_copy ->
-      deref_loc ty m b ofs (Vptr b ofs).
+      deref_loc ty m b ofs Full (Vptr b ofs)
+  | deref_loc_bitfield: forall sz sg pos width v,
+      load_bitfield ty sz sg pos width m (Vptr b ofs) v ->
+      deref_loc ty m b ofs (Bits sz sg pos width) v.
 
-(** Symmetrically, [assign_loc ty m b ofs v m'] returns the
+(** Symmetrically, [assign_loc ty m b ofs bf v m'] returns the
   memory state after storing the value [v] in the datum
-  of type [ty] residing in memory [m] at block [b], offset [ofs].
+  of type [ty] residing in memory [m] at block [b], offset [ofs],
+  bitfield designation [bf].
   This is allowed only if [ty] indicates an access by value or by copy.
   [m'] is the updated memory state. *)
 
 Inductive assign_loc (ce: composite_env) (ty: type) (m: mem) (b: block) (ofs: ptrofs):
-                                            val -> mem -> Prop :=
+                                            bitfield -> val -> mem -> Prop :=
   | assign_loc_value: forall v chunk m',
       access_mode ty = By_value chunk ->
       Mem.storev chunk m (Vptr b ofs) v = Some m' ->
-      assign_loc ce ty m b ofs v m'
+      assign_loc ce ty m b ofs Full v m'
   | assign_loc_copy: forall b' ofs' bytes m',
       access_mode ty = By_copy ->
       (sizeof ce ty > 0 -> (alignof_blockcopy ce ty | Ptrofs.unsigned ofs')) ->
@@ -236,7 +242,10 @@ Inductive assign_loc (ce: composite_env) (ty: type) (m: mem) (b: block) (ofs: pt
               \/ Ptrofs.unsigned ofs + sizeof ce ty <= Ptrofs.unsigned ofs' ->
       Mem.loadbytes m b' (Ptrofs.unsigned ofs') (sizeof ce ty) = Some bytes ->
       Mem.storebytes m b (Ptrofs.unsigned ofs) bytes = Some m' ->
-      assign_loc ce ty m b ofs (Vptr b' ofs') m'.
+      assign_loc ce ty m b ofs Full (Vptr b' ofs') m'
+  | assign_loc_bitfield: forall sz sg pos width v m' v',
+      store_bitfield ty sz sg pos width m (Vptr b ofs) v m' v' ->
+      assign_loc ce ty m b ofs (Bits sz sg pos width) v m'.
 
 Section SEMANTICS.
 
@@ -275,7 +284,7 @@ Inductive bind_parameters (e: env):
   | bind_parameters_cons:
       forall m id ty params v1 vl b m1 m2,
       PTree.get id e = Some(b, ty) ->
-      assign_loc ge ty m b Ptrofs.zero v1 m1 ->
+      assign_loc ge ty m b Ptrofs.zero Full v1 m1 ->
       bind_parameters e m1 params vl m2 ->
       bind_parameters e m ((id, ty) :: params) (v1 :: vl) m2.
 
@@ -369,7 +378,7 @@ Inductive eval_expr: expr -> val -> Prop :=
       le!id = Some v ->
       eval_expr (Etempvar id ty) v
   | eval_Eaddrof: forall a ty loc ofs,
-      eval_lvalue a loc ofs ->
+      eval_lvalue a loc ofs Full ->
       eval_expr (Eaddrof a ty) (Vptr loc ofs)
   | eval_Eunop:  forall op a ty v1 v,
       eval_expr a v1 ->
@@ -388,37 +397,39 @@ Inductive eval_expr: expr -> val -> Prop :=
       eval_expr (Esizeof ty1 ty) (Vptrofs (Ptrofs.repr (sizeof ge ty1)))
   | eval_Ealignof: forall ty1 ty,
       eval_expr (Ealignof ty1 ty) (Vptrofs (Ptrofs.repr (alignof ge ty1)))
-  | eval_Elvalue: forall a loc ofs v,
-      eval_lvalue a loc ofs ->
-      deref_loc (typeof a) m loc ofs v ->
+  | eval_Elvalue: forall a loc ofs bf v,
+      eval_lvalue a loc ofs bf ->
+      deref_loc (typeof a) m loc ofs bf v ->
       eval_expr a v
 
 (** [eval_lvalue ge e m a b ofs] defines the evaluation of expression [a]
   in l-value position.  The result is the memory location [b, ofs]
-  that contains the value of the expression [a]. *)
+  that contains the value of the expression [a], and the bitfield [bf]
+  designation. *)
 
-with eval_lvalue: expr -> block -> ptrofs -> Prop :=
+with eval_lvalue: expr -> block -> ptrofs -> bitfield -> Prop :=
   | eval_Evar_local:   forall id l ty,
       e!id = Some(l, ty) ->
-      eval_lvalue (Evar id ty) l Ptrofs.zero
+      eval_lvalue (Evar id ty) l Ptrofs.zero Full
   | eval_Evar_global: forall id l ty,
       e!id = None ->
       Genv.find_symbol ge id = Some l ->
-      eval_lvalue (Evar id ty) l Ptrofs.zero
+      eval_lvalue (Evar id ty) l Ptrofs.zero Full
   | eval_Ederef: forall a ty l ofs,
       eval_expr a (Vptr l ofs) ->
-      eval_lvalue (Ederef a ty) l ofs
- | eval_Efield_struct:   forall a i ty l ofs id co att delta,
+      eval_lvalue (Ederef a ty) l ofs Full
+ | eval_Efield_struct:   forall a i ty l ofs id co att delta bf,
       eval_expr a (Vptr l ofs) ->
       typeof a = Tstruct id att ->
       ge.(genv_cenv)!id = Some co ->
-      field_offset ge i (co_members co) = OK delta ->
-      eval_lvalue (Efield a i ty) l (Ptrofs.add ofs (Ptrofs.repr delta))
- | eval_Efield_union:   forall a i ty l ofs id co att,
+      field_offset ge i (co_members co) = OK (delta, bf) ->
+      eval_lvalue (Efield a i ty) l (Ptrofs.add ofs (Ptrofs.repr delta)) bf
+ | eval_Efield_union:   forall a i ty l ofs id co att delta bf,
       eval_expr a (Vptr l ofs) ->
       typeof a = Tunion id att ->
       ge.(genv_cenv)!id = Some co ->
-      eval_lvalue (Efield a i ty) l ofs.
+      union_field_offset ge i (co_members co) = OK (delta, bf) ->
+      eval_lvalue (Efield a i ty) l (Ptrofs.add ofs (Ptrofs.repr delta)) bf.
 
 Scheme eval_expr_ind2 := Minimality for eval_expr Sort Prop
   with eval_lvalue_ind2 := Minimality for eval_lvalue Sort Prop.
@@ -547,11 +558,11 @@ Variable function_entry: function -> list val -> mem -> env -> temp_env -> mem -
 
 Inductive step: state -> trace -> state -> Prop :=
 
-  | step_assign:   forall f a1 a2 k e le m loc ofs v2 v m',
-      eval_lvalue e le m a1 loc ofs ->
+  | step_assign:   forall f a1 a2 k e le m loc ofs bf v2 v m',
+      eval_lvalue e le m a1 loc ofs bf ->
       eval_expr e le m a2 v2 ->
       sem_cast v2 (typeof a2) (typeof a1) m = Some v ->
-      assign_loc ge (typeof a1) m loc ofs v m' ->
+      assign_loc ge (typeof a1) m loc ofs bf v m' ->
       step (State f (Sassign a1 a2) k e le m)
         E0 (State f Sskip k e le m')
 
diff --git a/cfrontend/ClightBigstep.v b/cfrontend/ClightBigstep.v
index 644c4c6c..51487fa2 100644
--- a/cfrontend/ClightBigstep.v
+++ b/cfrontend/ClightBigstep.v
@@ -79,11 +79,11 @@ Inductive exec_stmt: env -> temp_env -> mem -> statement -> trace -> temp_env ->
   | exec_Sskip:   forall e le m,
       exec_stmt e le m Sskip
                E0 le m Out_normal
-  | exec_Sassign:   forall e le m a1 a2 loc ofs v2 v m',
-      eval_lvalue ge e le m a1 loc ofs ->
+  | exec_Sassign:   forall e le m a1 a2 loc ofs bf v2 v m',
+      eval_lvalue ge e le m a1 loc ofs bf ->
       eval_expr ge e le m a2 v2 ->
       sem_cast v2 (typeof a2) (typeof a1) m = Some v ->
-      assign_loc ge (typeof a1) m loc ofs v m' ->
+      assign_loc ge (typeof a1) m loc ofs bf v m' ->
       exec_stmt e le m (Sassign a1 a2)
                E0 le m' Out_normal
   | exec_Sset:     forall e le m id a v,
diff --git a/cfrontend/Cop.v b/cfrontend/Cop.v
index f6524124..0d7bcc3a 100644
--- a/cfrontend/Cop.v
+++ b/cfrontend/Cop.v
@@ -1084,6 +1084,60 @@ Definition incrdecr_type (ty: type) :=
   | _ => Tvoid
   end.
 
+(** ** Accessing bit fields *)
+
+Definition chunk_for_carrier (sz: intsize) : memory_chunk :=
+  match sz with
+  | I8 | IBool => Mint8unsigned
+  | I16 => Mint16unsigned
+  | I32 => Mint32
+  end.
+
+(** For bitfield accesses, bits are numbered differently on
+    little-endian and on big-endian machines: bit 0 is the least
+    significant bit in little-endian, and the most significant bit in
+    big-endian. *)
+
+Definition bitsize_carrier (sz: intsize) : Z :=
+  match sz with
+  | I8 | IBool => 8
+  | I16 => 16
+  | I32 => 32
+  end.
+
+Definition first_bit (sz: intsize) (pos width: Z) : Z :=
+  if Archi.big_endian
+  then bitsize_carrier sz - pos - width
+  else pos.
+
+Definition bitfield_extract (sz: intsize) (sg: signedness) (pos width: Z) (c: int) : int :=
+  if intsize_eq sz IBool || signedness_eq sg Unsigned
+  then Int.unsigned_bitfield_extract (first_bit sz pos width) width c
+  else Int.signed_bitfield_extract (first_bit sz pos width) width c.
+
+Definition bitfield_normalize (sz: intsize) (sg: signedness) (width: Z) (n: int) : int :=
+  if intsize_eq sz IBool || signedness_eq sg Unsigned
+  then Int.zero_ext width n
+  else Int.sign_ext width n.
+
+Inductive load_bitfield: type -> intsize -> signedness -> Z -> Z -> mem -> val -> val -> Prop :=
+  | load_bitfield_intro: forall sz sg1 attr sg pos width m addr c,
+      0 <= pos -> 0 < width <= bitsize_intsize sz -> pos + width <= bitsize_carrier sz ->
+      sg1 = (if zlt width (bitsize_intsize sz) then Signed else sg) ->
+      Mem.loadv (chunk_for_carrier sz) m addr = Some (Vint c) ->
+      load_bitfield (Tint sz sg1 attr) sz sg pos width m addr
+                    (Vint (bitfield_extract sz sg pos width c)).
+
+Inductive store_bitfield: type -> intsize -> signedness -> Z -> Z -> mem -> val -> val -> mem -> val -> Prop :=
+  | store_bitfield_intro: forall sz sg1 attr sg pos width m addr c n m',
+      0 <= pos -> 0 < width <= bitsize_intsize sz -> pos + width <= bitsize_carrier sz ->
+      sg1 = (if zlt width (bitsize_intsize sz) then Signed else sg) ->
+      Mem.loadv (chunk_for_carrier sz) m addr = Some (Vint c) ->
+      Mem.storev (chunk_for_carrier sz) m addr
+                 (Vint (Int.bitfield_insert (first_bit sz pos width) width c n)) = Some m' ->
+      store_bitfield (Tint sz sg1 attr) sz sg pos width m addr (Vint n)
+                     m' (Vint (bitfield_normalize sz sg width n)).
+
 (** * Compatibility with extensions and injections *)
 
 Section GENERIC_INJECTION.
diff --git a/cfrontend/Csem.v b/cfrontend/Csem.v
index 724c1c9e..6698c56f 100644
--- a/cfrontend/Csem.v
+++ b/cfrontend/Csem.v
@@ -46,49 +46,59 @@ Section SEMANTICS.
 
 Variable ge: genv.
 
-(** [deref_loc ty m b ofs t v] computes the value of a datum
-  of type [ty] residing in memory [m] at block [b], offset [ofs].
+(** [deref_loc ty m b ofs bf t v] computes the value of a datum
+  of type [ty] residing in memory [m] at block [b], offset [ofs],
+  and bitfield designation [bf].
   If the type [ty] indicates an access by value, the corresponding
   memory load is performed.  If the type [ty] indicates an access by
   reference, the pointer [Vptr b ofs] is returned.  [v] is the value
   returned, and [t] the trace of observables (nonempty if this is
   a volatile access). *)
 
-Inductive deref_loc (ty: type) (m: mem) (b: block) (ofs: ptrofs) : trace -> val -> Prop :=
+Inductive deref_loc (ty: type) (m: mem) (b: block) (ofs: ptrofs) :
+                                       bitfield -> trace -> val -> Prop :=
   | deref_loc_value: forall chunk v,
       access_mode ty = By_value chunk ->
       type_is_volatile ty = false ->
       Mem.loadv chunk m (Vptr b ofs) = Some v ->
-      deref_loc ty m b ofs E0 v
+      deref_loc ty m b ofs Full E0 v
   | deref_loc_volatile: forall chunk t v,
       access_mode ty = By_value chunk -> type_is_volatile ty = true ->
       volatile_load ge chunk m b ofs t v ->
-      deref_loc ty m b ofs t v
+      deref_loc ty m b ofs Full t v
   | deref_loc_reference:
       access_mode ty = By_reference ->
-      deref_loc ty m b ofs E0 (Vptr b ofs)
+      deref_loc ty m b ofs Full E0 (Vptr b ofs)
   | deref_loc_copy:
       access_mode ty = By_copy ->
-      deref_loc ty m b ofs E0 (Vptr b ofs).
+      deref_loc ty m b ofs Full E0 (Vptr b ofs)
+  | deref_loc_bitfield: forall sz sg pos width v,
+      load_bitfield ty sz sg pos width m (Vptr b ofs) v ->
+      deref_loc ty m b ofs (Bits sz sg pos width) E0 v.
 
-(** Symmetrically, [assign_loc ty m b ofs v t m'] returns the
+(** Symmetrically, [assign_loc ty m b ofs bf v t m' v'] returns the
   memory state after storing the value [v] in the datum
-  of type [ty] residing in memory [m] at block [b], offset [ofs].
+  of type [ty] residing in memory [m] at block [b], offset [ofs],
+  and bitfield designation [bf].
   This is allowed only if [ty] indicates an access by value or by copy.
   [m'] is the updated memory state and [t] the trace of observables
-  (nonempty if this is a volatile store). *)
+  (nonempty if this is a volatile store).
+  [v'] is the result value of the assignment.  It is equal to [v]
+  if [bf] is [Full], and to [v] normalized to the width and signedness
+  of the bitfield [bf] otherwise.
+*)
 
 Inductive assign_loc (ty: type) (m: mem) (b: block) (ofs: ptrofs):
-                                            val -> trace -> mem -> Prop :=
+                              bitfield -> val -> trace -> mem -> val -> Prop :=
   | assign_loc_value: forall v chunk m',
       access_mode ty = By_value chunk ->
       type_is_volatile ty = false ->
       Mem.storev chunk m (Vptr b ofs) v = Some m' ->
-      assign_loc ty m b ofs v E0 m'
+      assign_loc ty m b ofs Full v E0 m' v
   | assign_loc_volatile: forall v chunk t m',
       access_mode ty = By_value chunk -> type_is_volatile ty = true ->
       volatile_store ge chunk m b ofs v t m' ->
-      assign_loc ty m b ofs v t m'
+      assign_loc ty m b ofs Full v t m' v
   | assign_loc_copy: forall b' ofs' bytes m',
       access_mode ty = By_copy ->
       (alignof_blockcopy ge ty | Ptrofs.unsigned ofs') ->
@@ -98,7 +108,10 @@ Inductive assign_loc (ty: type) (m: mem) (b: block) (ofs: ptrofs):
               \/ Ptrofs.unsigned ofs + sizeof ge ty <= Ptrofs.unsigned ofs' ->
       Mem.loadbytes m b' (Ptrofs.unsigned ofs') (sizeof ge ty) = Some bytes ->
       Mem.storebytes m b (Ptrofs.unsigned ofs) bytes = Some m' ->
-      assign_loc ty m b ofs (Vptr b' ofs') E0 m'.
+      assign_loc ty m b ofs Full (Vptr b' ofs') E0 m' (Vptr b' ofs')
+  | assign_loc_bitfield: forall sz sg pos width v m' v',
+      store_bitfield ty sz sg pos width m (Vptr b ofs) v m' v' ->
+      assign_loc ty m b ofs (Bits sz sg pos width) v E0 m' v'.
 
 (** Allocation of function-local variables.
   [alloc_variables e1 m1 vars e2 m2] allocates one memory block
@@ -131,9 +144,9 @@ Inductive bind_parameters (e: env):
       forall m,
       bind_parameters e m nil nil m
   | bind_parameters_cons:
-      forall m id ty params v1 vl b m1 m2,
+      forall m id ty params v1 vl v1' b m1 m2,
       PTree.get id e = Some(b, ty) ->
-      assign_loc ty m b Ptrofs.zero v1 E0 m1 ->
+      assign_loc ty m b Ptrofs.zero Full v1 E0 m1 v1' ->
       bind_parameters e m1 params vl m2 ->
       bind_parameters e m ((id, ty) :: params) (v1 :: vl) m2.
 
@@ -202,34 +215,35 @@ Inductive lred: expr -> mem -> expr -> mem -> Prop :=
   | red_var_local: forall x ty m b,
       e!x = Some(b, ty) ->
       lred (Evar x ty) m
-           (Eloc b Ptrofs.zero ty) m
+           (Eloc b Ptrofs.zero Full ty) m
   | red_var_global: forall x ty m b,
       e!x = None ->
       Genv.find_symbol ge x = Some b ->
       lred (Evar x ty) m
-           (Eloc b Ptrofs.zero ty) m
+           (Eloc b Ptrofs.zero Full ty) m
   | red_deref: forall b ofs ty1 ty m,
       lred (Ederef (Eval (Vptr b ofs) ty1) ty) m
-           (Eloc b ofs ty) m
-  | red_field_struct: forall b ofs id co a f ty m delta,
+           (Eloc b ofs Full ty) m
+  | red_field_struct: forall b ofs id co a f ty m delta bf,
       ge.(genv_cenv)!id = Some co ->
-      field_offset ge f (co_members co) = OK delta ->
+      field_offset ge f (co_members co) = OK (delta, bf) ->
       lred (Efield (Eval (Vptr b ofs) (Tstruct id a)) f ty) m
-           (Eloc b (Ptrofs.add ofs (Ptrofs.repr delta)) ty) m
-  | red_field_union: forall b ofs id co a f ty m,
+           (Eloc b (Ptrofs.add ofs (Ptrofs.repr delta)) bf ty) m
+  | red_field_union: forall b ofs id co a f ty m delta bf,
       ge.(genv_cenv)!id = Some co ->
+      union_field_offset ge f (co_members co) = OK (delta, bf) ->
       lred (Efield (Eval (Vptr b ofs) (Tunion id a)) f ty) m
-           (Eloc b ofs ty) m.
+           (Eloc b (Ptrofs.add ofs (Ptrofs.repr delta)) bf ty) m.
 
 (** Head reductions for r-values *)
 
 Inductive rred: expr -> mem -> trace -> expr -> mem -> Prop :=
-  | red_rvalof: forall b ofs ty m t v,
-      deref_loc ty m b ofs t v ->
-      rred (Evalof (Eloc b ofs ty) ty) m
+  | red_rvalof: forall b ofs bf ty m t v,
+      deref_loc ty m b ofs bf t v ->
+      rred (Evalof (Eloc b ofs bf ty) ty) m
          t (Eval v ty) m
   | red_addrof: forall b ofs ty1 ty m,
-      rred (Eaddrof (Eloc b ofs ty1) ty) m
+      rred (Eaddrof (Eloc b ofs Full ty1) ty) m
         E0 (Eval (Vptr b ofs) ty) m
   | red_unop: forall op v1 ty1 ty m v,
       sem_unary_operation op v1 ty1 m = Some v ->
@@ -269,21 +283,21 @@ Inductive rred: expr -> mem -> trace -> expr -> mem -> Prop :=
   | red_alignof: forall ty1 ty m,
       rred (Ealignof ty1 ty) m
         E0 (Eval (Vptrofs (Ptrofs.repr (alignof ge ty1))) ty) m
-  | red_assign: forall b ofs ty1 v2 ty2 m v t m',
+  | red_assign: forall b ofs ty1 bf v2 ty2 m v t m' v',
       sem_cast v2 ty2 ty1 m = Some v ->
-      assign_loc ty1 m b ofs v t m' ->
-      rred (Eassign (Eloc b ofs ty1) (Eval v2 ty2) ty1) m
-         t (Eval v ty1) m'
-  | red_assignop: forall op b ofs ty1 v2 ty2 tyres m t v1,
-      deref_loc ty1 m b ofs t v1 ->
-      rred (Eassignop op (Eloc b ofs ty1) (Eval v2 ty2) tyres ty1) m
-         t (Eassign (Eloc b ofs ty1)
+      assign_loc ty1 m b ofs bf v t m' v' ->
+      rred (Eassign (Eloc b ofs bf ty1) (Eval v2 ty2) ty1) m
+         t (Eval v' ty1) m'
+  | red_assignop: forall op b ofs ty1 bf v2 ty2 tyres m t v1,
+      deref_loc ty1 m b ofs bf t v1 ->
+      rred (Eassignop op (Eloc b ofs bf ty1) (Eval v2 ty2) tyres ty1) m
+         t (Eassign (Eloc b ofs bf ty1)
                     (Ebinop op (Eval v1 ty1) (Eval v2 ty2) tyres) ty1) m
-  | red_postincr: forall id b ofs ty m t v1 op,
-      deref_loc ty m b ofs t v1 ->
+  | red_postincr: forall id b ofs ty bf m t v1 op,
+      deref_loc ty m b ofs bf t v1 ->
       op = match id with Incr => Oadd | Decr => Osub end ->
-      rred (Epostincr id (Eloc b ofs ty) ty) m
-         t (Ecomma (Eassign (Eloc b ofs ty)
+      rred (Epostincr id (Eloc b ofs bf ty) ty) m
+         t (Ecomma (Eassign (Eloc b ofs bf ty)
                             (Ebinop op (Eval v1 ty)
                                        (Eval (Vint Int.one) type_int32s)
                                        (incrdecr_type ty))
@@ -409,8 +423,8 @@ with contextlist: kind -> (expr -> exprlist) -> Prop :=
 Inductive imm_safe: kind -> expr -> mem -> Prop :=
   | imm_safe_val: forall v ty m,
       imm_safe RV (Eval v ty) m
-  | imm_safe_loc: forall b ofs ty m,
-      imm_safe LV (Eloc b ofs ty) m
+  | imm_safe_loc: forall b ofs bf ty m,
+      imm_safe LV (Eloc b ofs bf ty) m
   | imm_safe_lred: forall to C e m e' m',
       lred e m e' m' ->
       context LV to C ->
@@ -839,10 +853,10 @@ Lemma semantics_single_events:
 Proof.
   unfold semantics; intros; red; simpl; intros.
   set (ge := globalenv p) in *.
-  assert (DEREF: forall chunk m b ofs t v, deref_loc ge chunk m b ofs t v -> (length t <= 1)%nat).
-    intros. inv H0; simpl; try lia. inv H3; simpl; try lia.
-  assert (ASSIGN: forall chunk m b ofs t v m', assign_loc ge chunk m b ofs v t m' -> (length t <= 1)%nat).
-    intros. inv H0; simpl; try lia. inv H3; simpl; try lia.
+  assert (DEREF: forall chunk m b ofs bf t v, deref_loc ge chunk m b ofs bf t v -> (length t <= 1)%nat).
+  { intros. inv H0; simpl; try lia. inv H3; simpl; try lia. }
+  assert (ASSIGN: forall chunk m b ofs bf t v m' v', assign_loc ge chunk m b ofs bf v t m' v' -> (length t <= 1)%nat).
+  { intros. inv H0; simpl; try lia. inv H3; simpl; try lia. }
   destruct H.
   inv H; simpl; try lia. inv H0; eauto; simpl; try lia.
   eapply external_call_trace_length; eauto.
diff --git a/cfrontend/Cshmgen.v b/cfrontend/Cshmgen.v
index 5bd12d00..9e804176 100644
--- a/cfrontend/Cshmgen.v
+++ b/cfrontend/Cshmgen.v
@@ -372,19 +372,56 @@ Definition make_cmp (c: comparison) (e1: expr) (ty1: type) (e2: expr) (ty2: type
         e1 ty1 e2 ty2
   end.
 
+(** Auxiliary for translating bitfield accesses *)
+
+Definition make_extract_bitfield (sz: intsize) (sg: signedness) (pos width: Z)
+                                 (addr: expr) : res expr :=
+  if zle 0 pos && zlt 0 width && zle (pos + width) (bitsize_carrier sz) then
+    let amount1 := Int.repr (Int.zwordsize - first_bit sz pos width - width) in
+    let amount2 := Int.repr (Int.zwordsize - width) in
+    let e1 := Eload (chunk_for_carrier sz) addr in
+    let e2 := Ebinop Oshl e1 (make_intconst amount1) in
+    let e3 := Ebinop (if intsize_eq sz IBool
+                      || signedness_eq sg Unsigned then Oshru else Oshr)
+                     e2 (make_intconst amount2) in
+    OK e3
+  else
+    Error(msg "Cshmgen.extract_bitfield").
+
 (** [make_load addr ty_res] loads a value of type [ty_res] from
-   the memory location denoted by the Csharpminor expression [addr].
+   the memory location denoted by the Csharpminor expression [addr]
+   and the bitfield designator [bf].
    If [ty_res] is an array or function type, returns [addr] instead,
    as consistent with C semantics.
 *)
 
-Definition make_load (addr: expr) (ty_res: type) :=
-  match (access_mode ty_res) with
-  | By_value chunk => OK (Eload chunk addr)
-  | By_reference => OK addr
-  | By_copy => OK addr
-  | By_nothing => Error (msg "Cshmgen.make_load")
-  end.
+Definition make_load (addr: expr) (ty_res: type) (bf: bitfield) :=
+  match bf with
+  | Full =>
+      match access_mode ty_res with
+      | By_value chunk => OK (Eload chunk addr)
+      | By_reference => OK addr
+      | By_copy => OK addr
+      | By_nothing => Error (msg "Cshmgen.make_load")
+      end
+  | Bits sz sg pos width =>
+      make_extract_bitfield sz sg pos width addr
+  end.
+
+(** Auxiliary for translating bitfield updates *)
+
+Definition make_store_bitfield (sz: intsize) (sg: signedness) (pos width: Z)
+                               (addr val: expr) : res stmt :=
+  if zle 0 pos && zlt 0 width && zle (pos + width) (bitsize_carrier sz) then
+    let amount := first_bit sz pos width in
+    let mask := Int.shl (Int.repr (two_p width - 1)) (Int.repr amount) in
+    let e1 := Eload (chunk_for_carrier sz) addr in
+    let e2 := Ebinop Oshl val (make_intconst (Int.repr amount)) in
+    let e3 := Ebinop Oor (Ebinop Oand e2 (make_intconst mask))
+                         (Ebinop Oand e1 (make_intconst (Int.not mask))) in
+    OK (Sstore (chunk_for_carrier sz) addr e3)
+  else
+    Error(msg "Cshmgen.make_store_bitfield").
 
 (** [make_memcpy dst src ty] returns a [memcpy] builtin appropriate for
   by-copy assignment of a value of Clight type [ty]. *)
@@ -394,16 +431,21 @@ Definition make_memcpy (ce: composite_env) (dst src: expr) (ty: type) :=
   OK (Sbuiltin None (EF_memcpy sz (Ctypes.alignof_blockcopy ce ty))
                     (dst :: src :: nil)).
 
-(** [make_store addr ty rhs] stores the value of the
+(** [make_store addr ty bf rhs] stores the value of the
    Csharpminor expression [rhs] into the memory location denoted by the
    Csharpminor expression [addr].
-   [ty] is the type of the memory location. *)
-
-Definition make_store (ce: composite_env) (addr: expr) (ty: type) (rhs: expr) :=
-  match access_mode ty with
-  | By_value chunk => OK (Sstore chunk addr rhs)
-  | By_copy => make_memcpy ce addr rhs ty
-  | _ => Error (msg "Cshmgen.make_store")
+   [ty] is the type of the memory location and [bf] a bitfield designator. *)
+
+Definition make_store (ce: composite_env) (addr: expr) (ty: type) (bf: bitfield) (rhs: expr) :=
+  match bf with
+  | Full =>
+      match access_mode ty with
+      | By_value chunk => OK (Sstore chunk addr rhs)
+      | By_copy => make_memcpy ce addr rhs ty
+      | _ => Error (msg "Cshmgen.make_store")
+      end
+  | Bits sz sg pos width =>
+      make_store_bitfield sz sg pos width addr rhs
   end.
 
 (** ** Translation of operators *)
@@ -441,23 +483,27 @@ Definition transl_binop (ce: composite_env)
 
 (** ** Translation of field accesses *)
 
-Definition make_field_access (ce: composite_env) (ty: type) (f: ident) (a: expr) : res expr :=
-  match ty with
-  | Tstruct id _ =>
-      match ce!id with
-      | None =>
-          Error (MSG "Undefined struct " :: CTX id :: nil)
-      | Some co =>
-          do ofs <- field_offset ce f (co_members co);
-          OK (if Archi.ptr64
-              then Ebinop Oaddl a (make_longconst (Int64.repr ofs))
-              else Ebinop Oadd a (make_intconst (Int.repr ofs)))
-      end
-  | Tunion id _ =>
-      OK a
-  | _ =>
-      Error(msg "Cshmgen.make_field_access")
-  end.
+Definition make_field_access (ce: composite_env) (ty: type) (f: ident) (a: expr) : res (expr * bitfield) :=
+  do (ofs, bf) <-
+    match ty with
+    | Tstruct id _ =>
+        match ce!id with
+        | None => Error (MSG "Undefined struct " :: CTX id :: nil)
+        | Some co => field_offset ce f (co_members co)
+        end
+    | Tunion id _ =>
+        match ce!id with
+        | None => Error (MSG "Undefined union " :: CTX id :: nil)
+        | Some co => union_field_offset ce f (co_members co)
+        end
+    | _ =>
+        Error(msg "Cshmgen.make_field_access")
+    end;
+  let a' :=
+    if Archi.ptr64
+    then Ebinop Oaddl a (make_longconst (Int64.repr ofs))
+    else Ebinop Oadd a (make_intconst (Int.repr ofs)) in
+  OK (a', bf).
 
 (** * Translation of expressions *)
 
@@ -476,14 +522,18 @@ Fixpoint transl_expr (ce: composite_env) (a: Clight.expr) {struct a} : res expr
   | Clight.Econst_long n _ =>
       OK(make_longconst n)
   | Clight.Evar id ty =>
-      make_load (Eaddrof id) ty
+      make_load (Eaddrof id) ty Full
   | Clight.Etempvar id ty =>
       OK(Evar id)
   | Clight.Ederef b ty =>
       do tb <- transl_expr ce b;
-      make_load tb ty
+      make_load tb ty Full
   | Clight.Eaddrof b _ =>
-      transl_lvalue ce b
+      do (tb, bf) <- transl_lvalue ce b;
+      match bf with
+      | Full => OK tb
+      | Bits _ _ _ _ => Error (msg "Cshmgen.transl_expr: addrof bitfield")
+      end
   | Clight.Eunop op b _ =>
       do tb <- transl_expr ce b;
       transl_unop op tb (typeof b)
@@ -496,8 +546,8 @@ Fixpoint transl_expr (ce: composite_env) (a: Clight.expr) {struct a} : res expr
       make_cast (typeof b) ty tb
   | Clight.Efield b i ty =>
       do tb <- transl_expr ce b;
-      do addr <- make_field_access ce (typeof b) i tb;
-      make_load addr ty
+      do (addr, bf) <- make_field_access ce (typeof b) i tb;
+      make_load addr ty bf
   | Clight.Esizeof ty' ty =>
       do sz <- sizeof ce ty'; OK(make_ptrofsconst sz)
   | Clight.Ealignof ty' ty =>
@@ -506,15 +556,16 @@ Fixpoint transl_expr (ce: composite_env) (a: Clight.expr) {struct a} : res expr
 
 (** [transl_lvalue a] returns the Csharpminor code that evaluates
    [a] as a lvalue, that is, code that returns the memory address
-   where the value of [a] is stored.
+   where the value of [a] is stored.  It also returns the bitfield to be
+   accessed at this address, if appropriate.
 *)
 
-with transl_lvalue (ce: composite_env) (a: Clight.expr) {struct a} : res expr :=
+with transl_lvalue (ce: composite_env) (a: Clight.expr) {struct a} : res (expr * bitfield) :=
   match a with
   | Clight.Evar id _ =>
-      OK (Eaddrof id)
+      OK (Eaddrof id, Full)
   | Clight.Ederef b _ =>
-      transl_expr ce b
+      do tb <- transl_expr ce b; OK (tb, Full)
   | Clight.Efield b i ty =>
       do tb <- transl_expr ce b;
       make_field_access ce (typeof b) i tb
@@ -618,10 +669,10 @@ Fixpoint transl_statement (ce: composite_env) (tyret: type) (nbrk ncnt: nat)
   | Clight.Sskip =>
       OK Sskip
   | Clight.Sassign b c =>
-      do tb <- transl_lvalue ce b;
+      do (tb, bf) <- transl_lvalue ce b;
       do tc <- transl_expr ce c;
       do tc' <- make_cast (typeof c) (typeof b) tc;
-      make_store ce tb (typeof b) tc'
+      make_store ce tb (typeof b) bf tc'
   | Clight.Sset x b =>
       do tb <- transl_expr ce b;
       OK(Sset x tb)
diff --git a/cfrontend/Cshmgenproof.v b/cfrontend/Cshmgenproof.v
index 6e653e01..8e396e2a 100644
--- a/cfrontend/Cshmgenproof.v
+++ b/cfrontend/Cshmgenproof.v
@@ -115,6 +115,21 @@ Proof.
   destruct (prog_comp_env cunit)!i as [co|] eqn:X; try discriminate; erewrite H1 by eauto; auto.
 Qed.
 
+Lemma union_field_offset_stable:
+  forall (cunit prog: Clight.program) id co f,
+  linkorder cunit prog ->
+  cunit.(prog_comp_env)!id = Some co ->
+  prog.(prog_comp_env)!id = Some co /\
+  union_field_offset prog.(prog_comp_env) f (co_members co) = union_field_offset cunit.(prog_comp_env) f (co_members co).
+Proof.
+  intros.
+  assert (C: composite_consistent cunit.(prog_comp_env) co).
+  { apply build_composite_env_consistent with cunit.(prog_types) id; auto.
+    apply prog_comp_env_eq. }
+  destruct H as [_ A].
+  split. auto. apply Ctypes.union_field_offset_stable; eauto using co_consistent_complete.
+Qed.
+
 Lemma field_offset_stable:
   forall (cunit prog: Clight.program) id co f,
   linkorder cunit prog ->
@@ -127,38 +142,11 @@ Proof.
   { apply build_composite_env_consistent with cunit.(prog_types) id; auto.
     apply prog_comp_env_eq. }
   destruct H as [_ A].
-  split. auto. generalize (co_consistent_complete _ _ C).
-  unfold field_offset. generalize 0. induction (co_members co) as [ | [f1 t1] m]; simpl; intros.
-- auto.
-- InvBooleans.
-  rewrite ! (alignof_stable _ _ A) by auto.
-  rewrite ! (sizeof_stable _ _ A) by auto.
-  destruct (ident_eq f f1); eauto.
+  split. auto. apply Ctypes.field_offset_stable; eauto using co_consistent_complete.
 Qed.
 
 (** * Properties of the translation functions *)
 
-(** Transformation of expressions and statements. *)
-
-Lemma transl_expr_lvalue:
-  forall ge e le m a loc ofs ce ta,
-  Clight.eval_lvalue ge e le m a loc ofs ->
-  transl_expr ce a = OK ta ->
-  (exists tb, transl_lvalue ce a = OK tb /\ make_load tb (typeof a) = OK ta).
-Proof.
-  intros until ta; intros EVAL TR. inv EVAL; simpl in TR.
-  (* var local *)
-  exists (Eaddrof id); auto.
-  (* var global *)
-  exists (Eaddrof id); auto.
-  (* deref *)
-  monadInv TR. exists x; auto.
-  (* field struct *)
-  monadInv TR. exists x0; split; auto. simpl; rewrite EQ; auto.
-  (* field union *)
-  monadInv TR. exists x0; split; auto. simpl; rewrite EQ; auto.
-Qed.
-
 (** Properties of labeled statements *)
 
 Lemma transl_lbl_stmt_1:
@@ -940,28 +928,83 @@ Proof.
   eapply make_cmp_correct; eauto.
 Qed.
 
+Remark int_ltu_true:
+  forall x, 0 <= x < Int.zwordsize -> Int.ltu (Int.repr x) Int.iwordsize = true.
+Proof.
+  intros. unfold Int.ltu. rewrite Int.unsigned_repr_wordsize, Int.unsigned_repr, zlt_true by (generalize Int.wordsize_max_unsigned; lia).
+  auto.
+Qed.
+
+Remark first_bit_range: forall sz pos width,
+  0 <= pos -> 0 < width -> pos + width <= bitsize_carrier sz ->
+     0 <= first_bit sz pos width < Int.zwordsize
+  /\ 0 <= Int.zwordsize - first_bit sz pos width - width < Int.zwordsize.
+Proof.
+  intros.
+  assert (bitsize_carrier sz <= Int.zwordsize) by (destruct sz; compute; congruence).
+  unfold first_bit; destruct Archi.big_endian; lia.
+Qed.
+
 Lemma make_load_correct:
-  forall addr ty code b ofs v e le m,
-  make_load addr ty = OK code ->
+  forall addr ty bf code b ofs v e le m,
+  make_load addr ty bf = OK code ->
   eval_expr ge e le m addr (Vptr b ofs) ->
-  deref_loc ty m b ofs v ->
+  deref_loc ty m b ofs bf v ->
   eval_expr ge e le m code v.
 Proof.
   unfold make_load; intros until m; intros MKLOAD EVEXP DEREF.
   inv DEREF.
-  (* scalar *)
+- (* scalar *)
   rewrite H in MKLOAD. inv MKLOAD. apply eval_Eload with (Vptr b ofs); auto.
-  (* by reference *)
+- (* by reference *)
   rewrite H in MKLOAD. inv MKLOAD. auto.
-  (* by copy *)
+- (* by copy *)
   rewrite H in MKLOAD. inv MKLOAD. auto.
+- (* by bitfield *)
+  inv H.
+  unfold make_extract_bitfield in MKLOAD. unfold bitfield_extract.
+  exploit (first_bit_range sz pos width); eauto. lia. intros [A1 A2].
+  set (amount1 := Int.repr (Int.zwordsize - first_bit sz pos width - width)) in MKLOAD.
+  set (amount2 := Int.repr (Int.zwordsize - width)) in MKLOAD.
+  destruct (zle 0 pos && zlt 0 width && zle (pos + width) (bitsize_carrier sz)); inv MKLOAD.
+  set (e1 := Eload (chunk_for_carrier sz) addr).
+  assert (E1: eval_expr ge e le m e1 (Vint c)) by (econstructor; eauto).
+  set (e2 := Ebinop Oshl e1 (make_intconst amount1)).
+  assert (E2: eval_expr ge e le m e2 (Vint (Int.shl c amount1))).
+  { econstructor; eauto using make_intconst_correct. cbn.
+    unfold amount1 at 1; rewrite int_ltu_true by lia. auto. } 
+  econstructor; eauto using make_intconst_correct.
+  destruct (Ctypes.intsize_eq sz IBool || Ctypes.signedness_eq sg Unsigned); cbn.
+  + unfold amount2 at 1; rewrite int_ltu_true by lia. 
+    rewrite Int.unsigned_bitfield_extract_by_shifts by lia. auto.
+  + unfold amount2 at 1; rewrite int_ltu_true by lia. 
+    rewrite Int.signed_bitfield_extract_by_shifts by lia. auto.
+Qed.
+
+Lemma make_store_bitfield_correct: 
+  forall f sz sg pos width dst src ty k e le m b ofs v m' s,
+  eval_expr ge e le m dst (Vptr b ofs) ->
+  eval_expr ge e le m src v ->
+  assign_loc prog.(prog_comp_env) ty m b ofs (Bits sz sg pos width) v m' ->
+  make_store_bitfield sz sg pos width dst src = OK s ->
+  step ge (State f s k e le m) E0 (State f Sskip k e le m').
+Proof.
+  intros until s; intros DST SRC ASG MK.
+  inv ASG. inv H5. unfold make_store_bitfield in MK.
+  destruct (zle 0 pos && zlt 0 width && zle (pos + width) (bitsize_carrier sz)); inv MK.
+  econstructor; eauto.
+  exploit (first_bit_range sz pos width); eauto. lia. intros [A1 A2].
+  rewrite Int.bitfield_insert_alternative by lia.
+  set (amount := first_bit sz pos width).
+  set (mask := Int.shl (Int.repr (two_p width - 1)) (Int.repr amount)).
+  repeat econstructor; eauto. cbn. rewrite int_ltu_true by lia. auto. 
 Qed.
 
 Lemma make_memcpy_correct:
   forall f dst src ty k e le m b ofs v m' s,
   eval_expr ge e le m dst (Vptr b ofs) ->
   eval_expr ge e le m src v ->
-  assign_loc prog.(prog_comp_env) ty m b ofs v m' ->
+  assign_loc prog.(prog_comp_env) ty m b ofs Full v m' ->
   access_mode ty = By_copy ->
   make_memcpy cunit.(prog_comp_env) dst src ty = OK s ->
   step ge (State f s k e le m) E0 (State f Sskip k e le m').
@@ -979,21 +1022,23 @@ Proof.
 Qed.
 
 Lemma make_store_correct:
-  forall addr ty rhs code e le m b ofs v m' f k,
-  make_store cunit.(prog_comp_env) addr ty rhs = OK code ->
+  forall addr ty bf rhs code e le m b ofs v m' f k,
+  make_store cunit.(prog_comp_env) addr ty bf rhs = OK code ->
   eval_expr ge e le m addr (Vptr b ofs) ->
   eval_expr ge e le m rhs v ->
-  assign_loc prog.(prog_comp_env) ty m b ofs v m' ->
+  assign_loc prog.(prog_comp_env) ty m b ofs bf v m' ->
   step ge (State f code k e le m) E0 (State f Sskip k e le m').
 Proof.
   unfold make_store. intros until k; intros MKSTORE EV1 EV2 ASSIGN.
   inversion ASSIGN; subst.
-  (* nonvolatile scalar *)
+- (* nonvolatile scalar *)
   rewrite H in MKSTORE; inv MKSTORE.
   econstructor; eauto.
-  (* by copy *)
+- (* by copy *)
   rewrite H in MKSTORE.
   eapply make_memcpy_correct with (b := b) (v := Vptr b' ofs'); eauto.
+- (* bitfield *)
+  eapply make_store_bitfield_correct; eauto.
 Qed.
 
 Lemma make_normalization_correct:
@@ -1212,15 +1257,51 @@ Variable m: mem.
 Variable te: Csharpminor.env.
 Hypothesis MENV: match_env e te.
 
+Lemma transl_expr_lvalue:
+  forall a loc ofs bf ta,
+  Clight.eval_lvalue ge e le m a loc ofs bf ->
+  transl_expr cunit.(prog_comp_env) a = OK ta ->
+  exists tb, transl_lvalue cunit.(prog_comp_env) a = OK (tb, bf)
+          /\ make_load tb (typeof a) bf = OK ta.
+Proof.
+  intros until ta; intros EVAL TR. inv EVAL; simpl in TR.
+- (* var local *)
+  exists (Eaddrof id); auto.
+- (* var global *)
+  exists (Eaddrof id); auto.
+- (* deref *)
+  monadInv TR. cbn; rewrite EQ. exists x; auto.
+- (* field struct *)
+  monadInv TR.
+  assert (x1 = bf).
+  { rewrite H0 in EQ1. unfold make_field_access in EQ1.
+    destruct ((prog_comp_env cunit)!id) as [co'|] eqn:E; try discriminate.
+    monadInv EQ1.
+    exploit field_offset_stable. eexact LINK. eauto. instantiate (1 := i). intros [A B].
+    simpl in H1, H2. congruence. }
+  subst x1.
+  exists x0; split; auto. simpl; rewrite EQ; auto.
+- (* field union *)
+  monadInv TR.
+  assert (x1 = bf).
+  { rewrite H0 in EQ1. unfold make_field_access in EQ1.
+    destruct ((prog_comp_env cunit)!id) as [co'|] eqn:E; try discriminate.
+    monadInv EQ1.
+    exploit union_field_offset_stable. eexact LINK. eauto. instantiate (1 := i). intros [A B].
+    simpl in H1, H2. congruence. }
+  subst x1.
+  exists x0; split; auto. simpl; rewrite EQ; auto.
+Qed.
+
 Lemma transl_expr_lvalue_correct:
   (forall a v,
    Clight.eval_expr ge e le m a v ->
    forall ta (TR: transl_expr cunit.(prog_comp_env) a = OK ta) ,
    Csharpminor.eval_expr tge te le m ta v)
-/\(forall a b ofs,
-   Clight.eval_lvalue ge e le m a b ofs ->
-   forall ta (TR: transl_lvalue cunit.(prog_comp_env) a = OK ta),
-   Csharpminor.eval_expr tge te le m ta (Vptr b ofs)).
+/\(forall a b ofs bf,
+   Clight.eval_lvalue ge e le m a b ofs bf ->
+   forall ta bf' (TR: transl_lvalue cunit.(prog_comp_env) a = OK (ta, bf')),
+   bf = bf' /\ Csharpminor.eval_expr tge te le m ta (Vptr b ofs)).
 Proof.
   apply eval_expr_lvalue_ind; intros; try (monadInv TR).
 - (* const int *)
@@ -1234,7 +1315,7 @@ Proof.
 - (* temp var *)
   constructor; auto.
 - (* addrof *)
-  simpl in TR. auto.
+  destruct x0; inv EQ0. apply H0 in EQ. destruct EQ. auto.
 - (* unop *)
   eapply transl_unop_correct; eauto.
 - (* binop *)
@@ -1247,31 +1328,43 @@ Proof.
   rewrite (transl_alignof _ _ _ _ LINK EQ). apply make_ptrofsconst_correct.
 - (* rvalue out of lvalue *)
   exploit transl_expr_lvalue; eauto. intros [tb [TRLVAL MKLOAD]].
+  apply H0 in TRLVAL; destruct TRLVAL. 
   eapply make_load_correct; eauto.
 - (* var local *)
   exploit (me_local _ _ MENV); eauto. intros EQ.
-  econstructor. eapply eval_var_addr_local. eauto.
+  split; auto. econstructor. eapply eval_var_addr_local. eauto.
 - (* var global *)
-  econstructor. eapply eval_var_addr_global.
+  split; auto. econstructor. eapply eval_var_addr_global.
   eapply match_env_globals; eauto.
   rewrite symbols_preserved. auto.
 - (* deref *)
-  simpl in TR. eauto.
+  eauto.
 - (* field struct *)
   unfold make_field_access in EQ0. rewrite H1 in EQ0.
-  destruct (prog_comp_env cunit)!id as [co'|] eqn:CO; monadInv EQ0.
+  destruct (prog_comp_env cunit)!id as [co'|] eqn:CO; try discriminate; monadInv EQ0.
   exploit field_offset_stable. eexact LINK. eauto. instantiate (1 := i). intros [A B].
-  rewrite <- B in EQ1.
+  rewrite <- B in EQ1. 
   assert (x0 = delta) by (unfold ge in *; simpl in *; congruence).
-  subst x0.
+  assert (bf' = bf) by (unfold ge in *; simpl in *; congruence).
+  subst x0 bf'. split; auto.
   destruct Archi.ptr64 eqn:SF.
 + eapply eval_Ebinop; eauto using make_longconst_correct.
   simpl. rewrite SF. apply f_equal. apply f_equal. apply f_equal. auto with ptrofs.
 + eapply eval_Ebinop; eauto using make_intconst_correct.
   simpl. rewrite SF. apply f_equal. apply f_equal. apply f_equal. auto with ptrofs.
 - (* field union *)
-  unfold make_field_access in EQ0; rewrite H1 in EQ0; monadInv EQ0.
-  auto.
+  unfold make_field_access in EQ0. rewrite H1 in EQ0.
+  destruct (prog_comp_env cunit)!id as [co'|] eqn:CO; try discriminate; monadInv EQ0.
+  exploit union_field_offset_stable. eexact LINK. eauto. instantiate (1 := i). intros [A B].
+  rewrite <- B in EQ1. 
+  assert (x0 = delta) by (unfold ge in *; simpl in *; congruence).
+  assert (bf' = bf) by (unfold ge in *; simpl in *; congruence).
+  subst x0 bf'. split; auto.
+  destruct Archi.ptr64 eqn:SF.
++ eapply eval_Ebinop; eauto using make_longconst_correct.
+  simpl. rewrite SF. apply f_equal. apply f_equal. apply f_equal. auto with ptrofs.
++ eapply eval_Ebinop; eauto using make_intconst_correct.
+  simpl. rewrite SF. apply f_equal. apply f_equal. apply f_equal. auto with ptrofs.
 Qed.
 
 Lemma transl_expr_correct:
@@ -1282,10 +1375,10 @@ Lemma transl_expr_correct:
 Proof (proj1 transl_expr_lvalue_correct).
 
 Lemma transl_lvalue_correct:
-   forall a b ofs,
-   Clight.eval_lvalue ge e le m a b ofs ->
-   forall ta, transl_lvalue cunit.(prog_comp_env) a = OK ta ->
-   Csharpminor.eval_expr tge te le m ta (Vptr b ofs).
+   forall a b ofs bf,
+   Clight.eval_lvalue ge e le m a b ofs bf ->
+   forall ta bf', transl_lvalue cunit.(prog_comp_env) a = OK (ta, bf') ->
+   bf = bf' /\ Csharpminor.eval_expr tge te le m ta (Vptr b ofs).
 Proof (proj2 transl_expr_lvalue_correct).
 
 Lemma transl_arglist_correct:
@@ -1468,7 +1561,11 @@ Proof.
   auto.
 - (* assign *)
   unfold make_store, make_memcpy in EQ3.
+  destruct x0.
   destruct (access_mode (typeof e)); monadInv EQ3; auto.
+  unfold make_store_bitfield in EQ3.
+  destruct (zle 0 pos && zlt 0 width && zle (pos + width) (bitsize_carrier sz));
+  monadInv EQ3; auto.
 - (* set *)
   auto.
 - (* call *)
@@ -1568,11 +1665,17 @@ Proof.
   assert (SAME: ts' = ts /\ tk' = tk).
   { inversion MTR. auto.
     subst ts. unfold make_store, make_memcpy in EQ3.
-    destruct (access_mode (typeof a1)); monadInv EQ3; auto. }
+    destruct x0.
+    destruct (access_mode (typeof a1)); monadInv EQ3; auto.
+    unfold make_store_bitfield in EQ3.
+    destruct (zle 0 pos && zlt 0 width && zle (pos + width) (bitsize_carrier sz));
+    monadInv EQ3; auto.
+  }
   destruct SAME; subst ts' tk'.
+  exploit transl_lvalue_correct; eauto. intros [A B]; subst x0.
   econstructor; split.
   apply plus_one. eapply make_store_correct; eauto.
-  eapply transl_lvalue_correct; eauto. eapply make_cast_correct; eauto.
+  eapply make_cast_correct; eauto.
   eapply transl_expr_correct; eauto.
   eapply match_states_skip; eauto.
 
diff --git a/cfrontend/Cstrategy.v b/cfrontend/Cstrategy.v
index 6365f85c..ce965672 100644
--- a/cfrontend/Cstrategy.v
+++ b/cfrontend/Cstrategy.v
@@ -49,7 +49,7 @@ Variable ge: genv.
 
 Fixpoint simple (a: expr) : bool :=
   match a with
-  | Eloc _ _ _ => true
+  | Eloc _ _ _ _ => true
   | Evar _ _ => true
   | Ederef r _ => simple r
   | Efield r _ _ => simple r
@@ -86,41 +86,42 @@ Section SIMPLE_EXPRS.
 Variable e: env.
 Variable m: mem.
 
-Inductive eval_simple_lvalue: expr -> block -> ptrofs -> Prop :=
-  | esl_loc: forall b ofs ty,
-      eval_simple_lvalue (Eloc b ofs ty) b ofs
+Inductive eval_simple_lvalue: expr -> block -> ptrofs -> bitfield -> Prop :=
+  | esl_loc: forall b ofs ty bf,
+      eval_simple_lvalue (Eloc b ofs bf ty) b ofs bf
   | esl_var_local: forall x ty b,
       e!x = Some(b, ty) ->
-      eval_simple_lvalue (Evar x ty) b Ptrofs.zero
+      eval_simple_lvalue (Evar x ty) b Ptrofs.zero Full
   | esl_var_global: forall x ty b,
       e!x = None ->
       Genv.find_symbol ge x = Some b ->
-      eval_simple_lvalue (Evar x ty) b Ptrofs.zero
+      eval_simple_lvalue (Evar x ty) b Ptrofs.zero Full
   | esl_deref: forall r ty b ofs,
       eval_simple_rvalue r (Vptr b ofs) ->
-      eval_simple_lvalue (Ederef r ty) b ofs
-  | esl_field_struct: forall r f ty b ofs id co a delta,
+      eval_simple_lvalue (Ederef r ty) b ofs Full
+  | esl_field_struct: forall r f ty b ofs id co a delta bf,
       eval_simple_rvalue r (Vptr b ofs) ->
       typeof r = Tstruct id a ->
       ge.(genv_cenv)!id = Some co ->
-      field_offset ge f (co_members co) = OK delta ->
-      eval_simple_lvalue (Efield r f ty) b (Ptrofs.add ofs (Ptrofs.repr delta))
-  | esl_field_union: forall r f ty b ofs id co a,
+      field_offset ge f (co_members co) = OK (delta, bf) ->
+      eval_simple_lvalue (Efield r f ty) b (Ptrofs.add ofs (Ptrofs.repr delta)) bf
+  | esl_field_union: forall r f ty b ofs id co a delta bf,
       eval_simple_rvalue r (Vptr b ofs) ->
       typeof r = Tunion id a ->
+      union_field_offset ge f (co_members co) = OK (delta, bf) ->
       ge.(genv_cenv)!id = Some co ->
-      eval_simple_lvalue (Efield r f ty) b ofs
+      eval_simple_lvalue (Efield r f ty) b (Ptrofs.add ofs (Ptrofs.repr delta)) bf
 
 with eval_simple_rvalue: expr -> val -> Prop :=
   | esr_val: forall v ty,
       eval_simple_rvalue (Eval v ty) v
-  | esr_rvalof: forall b ofs l ty v,
-      eval_simple_lvalue l b ofs ->
+  | esr_rvalof: forall b ofs bf l ty v,
+      eval_simple_lvalue l b ofs bf ->
       ty = typeof l -> type_is_volatile ty = false ->
-      deref_loc ge ty m b ofs E0 v ->
+      deref_loc ge ty m b ofs bf E0 v ->
       eval_simple_rvalue (Evalof l ty) v
   | esr_addrof: forall b ofs l ty,
-      eval_simple_lvalue l b ofs ->
+      eval_simple_lvalue l b ofs Full ->
       eval_simple_rvalue (Eaddrof l ty) (Vptr b ofs)
   | esr_unop: forall op r1 ty v1 v,
       eval_simple_rvalue r1 v1 ->
@@ -240,10 +241,10 @@ Inductive estep: state -> trace -> state -> Prop :=
       estep (ExprState f r k e m)
          E0 (ExprState f (Eval v ty) k e m)
 
-  | step_rvalof_volatile: forall f C l ty k e m b ofs t v,
+  | step_rvalof_volatile: forall f C l ty k e m b ofs bf t v,
       leftcontext RV RV C ->
-      eval_simple_lvalue e m l b ofs ->
-      deref_loc ge ty m b ofs t v ->
+      eval_simple_lvalue e m l b ofs bf ->
+      deref_loc ge ty m b ofs bf t v ->
       ty = typeof l -> type_is_volatile ty = true ->
       estep (ExprState f (C (Evalof l ty)) k e m)
           t (ExprState f (C (Eval v ty)) k e m)
@@ -281,68 +282,68 @@ Inductive estep: state -> trace -> state -> Prop :=
       estep (ExprState f (C (Econdition r1 r2 r3 ty)) k e m)
          E0 (ExprState f (C (Eparen (if b then r2 else r3) ty ty)) k e m)
 
-  | step_assign: forall f C l r ty k e m b ofs v v' t m',
+  | step_assign: forall f C l r ty k e m b ofs bf v v1 t m' v',
       leftcontext RV RV C ->
-      eval_simple_lvalue e m l b ofs ->
+      eval_simple_lvalue e m l b ofs bf ->
       eval_simple_rvalue e m r v ->
-      sem_cast v (typeof r) (typeof l) m = Some v' ->
-      assign_loc ge (typeof l) m b ofs v' t m' ->
+      sem_cast v (typeof r) (typeof l) m = Some v1 ->
+      assign_loc ge (typeof l) m b ofs bf v1 t m' v' ->
       ty = typeof l ->
       estep (ExprState f (C (Eassign l r ty)) k e m)
           t (ExprState f (C (Eval v' ty)) k e m')
 
-  | step_assignop: forall f C op l r tyres ty k e m b ofs v1 v2 v3 v4 t1 t2 m' t,
+  | step_assignop: forall f C op l r tyres ty k e m b ofs bf v1 v2 v3 v4 t1 t2 m' v' t,
       leftcontext RV RV C ->
-      eval_simple_lvalue e m l b ofs ->
-      deref_loc ge (typeof l) m b ofs t1 v1 ->
+      eval_simple_lvalue e m l b ofs bf ->
+      deref_loc ge (typeof l) m b ofs bf t1 v1 ->
       eval_simple_rvalue e m r v2 ->
       sem_binary_operation ge op v1 (typeof l) v2 (typeof r) m = Some v3 ->
       sem_cast v3 tyres (typeof l) m = Some v4 ->
-      assign_loc ge (typeof l) m b ofs v4 t2 m' ->
+      assign_loc ge (typeof l) m b ofs bf v4 t2 m' v' ->
       ty = typeof l ->
       t = t1 ** t2 ->
       estep (ExprState f (C (Eassignop op l r tyres ty)) k e m)
-          t (ExprState f (C (Eval v4 ty)) k e m')
+          t (ExprState f (C (Eval v' ty)) k e m')
 
-  | step_assignop_stuck: forall f C op l r tyres ty k e m b ofs v1 v2 t,
+  | step_assignop_stuck: forall f C op l r tyres ty k e m b ofs bf v1 v2 t,
       leftcontext RV RV C ->
-      eval_simple_lvalue e m l b ofs ->
-      deref_loc ge (typeof l) m b ofs t v1 ->
+      eval_simple_lvalue e m l b ofs bf ->
+      deref_loc ge (typeof l) m b ofs bf t v1 ->
       eval_simple_rvalue e m r v2 ->
       match sem_binary_operation ge op v1 (typeof l) v2 (typeof r) m with
       | None => True
       | Some v3 =>
           match sem_cast v3 tyres (typeof l) m with
           | None => True
-          | Some v4 => forall t2 m', ~(assign_loc ge (typeof l) m b ofs v4 t2 m')
+          | Some v4 => forall t2 m' v', ~(assign_loc ge (typeof l) m b ofs bf v4 t2 m' v')
           end
       end ->
       ty = typeof l ->
       estep (ExprState f (C (Eassignop op l r tyres ty)) k e m)
           t Stuckstate
 
-  | step_postincr: forall f C id l ty k e m b ofs v1 v2 v3 t1 t2 m' t,
+  | step_postincr: forall f C id l ty k e m b ofs bf v1 v2 v3 t1 t2 m' v' t,
       leftcontext RV RV C ->
-      eval_simple_lvalue e m l b ofs ->
-      deref_loc ge ty m b ofs t1 v1 ->
+      eval_simple_lvalue e m l b ofs bf ->
+      deref_loc ge ty m b ofs bf t1 v1 ->
       sem_incrdecr ge id v1 ty m = Some v2 ->
       sem_cast v2 (incrdecr_type ty) ty m = Some v3 ->
-      assign_loc ge ty m b ofs v3 t2 m' ->
+      assign_loc ge ty m b ofs bf v3 t2 m' v' ->
       ty = typeof l ->
       t = t1 ** t2 ->
       estep (ExprState f (C (Epostincr id l ty)) k e m)
           t (ExprState f (C (Eval v1 ty)) k e m')
 
-  | step_postincr_stuck: forall f C id l ty k e m b ofs v1 t,
+  | step_postincr_stuck: forall f C id l ty k e m b ofs bf v1 t,
       leftcontext RV RV C ->
-      eval_simple_lvalue e m l b ofs ->
-      deref_loc ge ty m b ofs t v1 ->
+      eval_simple_lvalue e m l b ofs bf ->
+      deref_loc ge ty m b ofs bf t v1 ->
       match sem_incrdecr ge id v1 ty m with
       | None => True
       | Some v2 =>
           match sem_cast v2 (incrdecr_type ty) ty m with
           | None => True
-          | Some v3 => forall t2 m', ~(assign_loc ge (typeof l) m b ofs v3 t2 m')
+          | Some v3 => forall t2 m' v', ~(assign_loc ge (typeof l) m b ofs bf v3 t2 m' v')
           end
       end ->
       ty = typeof l ->
@@ -452,7 +453,7 @@ Qed.
 
 Definition expr_kind (a: expr) : kind :=
   match a with
-  | Eloc _ _ _ => LV
+  | Eloc _ _ _ _ => LV
   | Evar _ _ => LV
   | Ederef _ _ => LV
   | Efield _ _ _ => LV
@@ -518,23 +519,25 @@ Fixpoint exprlist_all_values (rl: exprlist) : Prop :=
 
 Definition invert_expr_prop (a: expr) (m: mem) : Prop :=
   match a with
-  | Eloc b ofs ty => False
+  | Eloc b ofs bf ty => False
   | Evar x ty =>
       exists b,
       e!x = Some(b, ty)
       \/ (e!x = None /\ Genv.find_symbol ge x = Some b)
   | Ederef (Eval v ty1) ty =>
       exists b, exists ofs, v = Vptr b ofs
+  | Eaddrof (Eloc b ofs bf ty) ty' =>
+      bf = Full
   | Efield (Eval v ty1) f ty =>
       exists b, exists ofs, v = Vptr b ofs /\
       match ty1 with
-      | Tstruct id _ => exists co delta, ge.(genv_cenv)!id = Some co /\ field_offset ge f (co_members co) = Errors.OK delta
-      | Tunion id _ => exists co, ge.(genv_cenv)!id = Some co
+      | Tstruct id _ => exists co delta bf, ge.(genv_cenv)!id = Some co /\ field_offset ge f (co_members co) = Errors.OK (delta, bf)
+      | Tunion id _ => exists co delta bf, ge.(genv_cenv)!id = Some co /\ union_field_offset ge f (co_members co) = Errors.OK (delta, bf)
       | _ => False
       end
   | Eval v ty => False
-  | Evalof (Eloc b ofs ty') ty =>
-      ty' = ty /\ exists t, exists v, deref_loc ge ty m b ofs t v
+  | Evalof (Eloc b ofs bf ty') ty =>
+      ty' = ty /\ exists t, exists v, deref_loc ge ty m b ofs bf t v
   | Eunop op (Eval v1 ty1) ty =>
       exists v, sem_unary_operation op v1 ty1 m = Some v
   | Ebinop op (Eval v1 ty1) (Eval v2 ty2) ty =>
@@ -547,17 +550,17 @@ Definition invert_expr_prop (a: expr) (m: mem) : Prop :=
       exists b, bool_val v1 ty1 m = Some b
   | Econdition (Eval v1 ty1) r1 r2 ty =>
       exists b, bool_val v1 ty1 m = Some b
-  | Eassign (Eloc b ofs ty1) (Eval v2 ty2) ty =>
-      exists v, exists m', exists t,
-      ty = ty1 /\ sem_cast v2 ty2 ty1 m = Some v /\ assign_loc ge ty1 m b ofs v t m'
-  | Eassignop op (Eloc b ofs ty1) (Eval v2 ty2) tyres ty =>
-      exists t, exists v1,
+  | Eassign (Eloc b ofs bf ty1) (Eval v2 ty2) ty =>
+      exists v m' v' t,
+      ty = ty1 /\ sem_cast v2 ty2 ty1 m = Some v /\ assign_loc ge ty1 m b ofs bf v t m' v'
+  | Eassignop op (Eloc b ofs bf ty1) (Eval v2 ty2) tyres ty =>
+      exists t v1,
       ty = ty1
-      /\ deref_loc ge ty1 m b ofs t v1
-  | Epostincr id (Eloc b ofs ty1) ty =>
-      exists t, exists v1,
+      /\ deref_loc ge ty1 m b ofs bf t v1
+  | Epostincr id (Eloc b ofs bf ty1) ty =>
+      exists t v1,
       ty = ty1
-      /\ deref_loc ge ty m b ofs t v1
+      /\ deref_loc ge ty m b ofs bf t v1
   | Ecomma (Eval v ty1) r2 ty =>
       typeof r2 = ty
   | Eparen (Eval v1 ty1) ty2 ty =>
@@ -584,8 +587,8 @@ Proof.
   exists b; auto.
   exists b; auto.
   exists b; exists ofs; auto.
-  exists b; exists ofs; split; auto. exists co, delta; auto.
-  exists b; exists ofs; split; auto. exists co; auto.
+  exists b; exists ofs; split; auto. exists co, delta, bf; auto.
+  exists b; exists ofs; split; auto. exists co, delta, bf; auto.
 Qed.
 
 Lemma rred_invert:
@@ -599,7 +602,7 @@ Proof.
   exists true; auto. exists false; auto.
   exists true; auto. exists false; auto.
   exists b; auto.
-  exists v; exists m'; exists t; auto.
+  exists v; exists m'; exists v'; exists t; auto.
   exists t; exists v1; auto.
   exists t; exists v1; auto.
   exists v; auto.
@@ -634,7 +637,7 @@ Proof.
   destruct (C a); auto; contradiction.
   destruct (C a); auto; contradiction.
   destruct (C a); auto; contradiction.
-  auto.
+  destruct (C a); auto; contradiction.
   destruct (C a); auto; contradiction.
   destruct (C a); auto; contradiction.
   destruct e1; auto; destruct (C a); auto; contradiction.
@@ -660,7 +663,7 @@ Lemma imm_safe_inv:
   forall k a m,
   imm_safe ge e k a m ->
   match a with
-  | Eloc _ _ _ => True
+  | Eloc _ _ _ _ => True
   | Eval _ _ => True
   | _ => invert_expr_prop a m
   end.
@@ -685,7 +688,7 @@ Lemma safe_inv:
   safe (ExprState f (C a) K e m) ->
   context k RV C ->
   match a with
-  | Eloc _ _ _ => True
+  | Eloc _ _ _ _ => True
   | Eval _ _ => True
   | _ => invert_expr_prop a m
   end.
@@ -709,10 +712,10 @@ Lemma eval_simple_steps:
     forall C, context RV RV C ->
     star Csem.step ge (ExprState f (C a) k e m)
                    E0 (ExprState f (C (Eval v (typeof a))) k e m))
-/\ (forall a b ofs, eval_simple_lvalue e m a b ofs ->
+/\ (forall a b ofs bf, eval_simple_lvalue e m a b ofs bf ->
     forall C, context LV RV C ->
     star Csem.step ge (ExprState f (C a) k e m)
-                   E0 (ExprState f (C (Eloc b ofs (typeof a))) k e m)).
+                   E0 (ExprState f (C (Eloc b ofs bf (typeof a))) k e m)).
 Proof.
 
 Ltac Steps REC C' := eapply star_trans; [apply (REC C'); eauto | idtac | simpl; reflexivity].
@@ -760,10 +763,10 @@ Lemma eval_simple_rvalue_steps:
 Proof (proj1 eval_simple_steps).
 
 Lemma eval_simple_lvalue_steps:
-  forall a b ofs, eval_simple_lvalue e m a b ofs ->
+  forall a b ofs bf, eval_simple_lvalue e m a b ofs bf ->
   forall C, context LV RV C ->
   star Csem.step ge (ExprState f (C a) k e m)
-                E0 (ExprState f (C (Eloc b ofs (typeof a))) k e m).
+                E0 (ExprState f (C (Eloc b ofs bf (typeof a))) k e m).
 Proof (proj2 eval_simple_steps).
 
 Corollary eval_simple_rvalue_safe:
@@ -776,10 +779,10 @@ Proof.
 Qed.
 
 Corollary eval_simple_lvalue_safe:
-  forall C a b ofs,
-  eval_simple_lvalue e m a b ofs ->
+  forall C a b ofs bf,
+  eval_simple_lvalue e m a b ofs bf ->
   context LV RV C -> safe (ExprState f (C a) k e m) ->
-  safe (ExprState f (C (Eloc b ofs (typeof a))) k e m).
+  safe (ExprState f (C (Eloc b ofs bf (typeof a))) k e m).
 Proof.
   intros. eapply safe_steps; eauto. eapply eval_simple_lvalue_steps; eauto.
 Qed.
@@ -788,15 +791,15 @@ Lemma simple_can_eval:
   forall a from C,
   simple a = true -> context from RV C -> safe (ExprState f (C a) k e m) ->
   match from with
-  | LV => exists b, exists ofs, eval_simple_lvalue e m a b ofs
+  | LV => exists b ofs bf, eval_simple_lvalue e m a b ofs bf
   | RV => exists v, eval_simple_rvalue e m a v
   end.
 Proof.
 Ltac StepL REC C' a :=
-  let b := fresh "b" in let ofs := fresh "ofs" in
+  let b := fresh "b" in let ofs := fresh "ofs" in let bf := fresh "bf" in
   let E := fresh "E" in let S := fresh "SAFE" in
-  exploit (REC LV C'); eauto; intros [b [ofs E]];
-  assert (S: safe (ExprState f (C' (Eloc b ofs (typeof a))) k e m)) by
+  exploit (REC LV C'); eauto; intros (b & ofs & bf & E);
+  assert (S: safe (ExprState f (C' (Eloc b ofs bf (typeof a))) k e m)) by
     (eapply (eval_simple_lvalue_safe C'); eauto);
   simpl in S.
 Ltac StepR REC C' a :=
@@ -809,51 +812,52 @@ Ltac StepR REC C' a :=
   induction a; intros from C S CTX SAFE;
   generalize (safe_expr_kind _ _ _ _ _ _ _ CTX SAFE); intro K; subst;
   simpl in S; try discriminate; simpl.
-(* val *)
+- (* val *)
   exists v; constructor.
-(* var *)
+- (* var *)
   exploit safe_inv; eauto; simpl. intros [b A].
-  exists b; exists Ptrofs.zero.
+  exists b, Ptrofs.zero, Full.
   intuition. apply esl_var_local; auto. apply esl_var_global; auto.
-(* field *)
+- (* field *)
   StepR IHa (fun x => C(Efield x f0 ty)) a.
   exploit safe_inv. eexact SAFE0. eauto. simpl.
   intros [b [ofs [EQ TY]]]. subst v. destruct (typeof a) eqn:?; try contradiction.
-  destruct TY as (co & delta & CE & OFS). exists b; exists (Ptrofs.add ofs (Ptrofs.repr delta)); econstructor; eauto.
-  destruct TY as (co & CE).  exists b; exists ofs; econstructor; eauto.
-(* valof *)
+  destruct TY as (co & delta & bf & CE & OFS). exists b, (Ptrofs.add ofs (Ptrofs.repr delta)), bf; eapply esl_field_struct; eauto.
+  destruct TY as (co & delta & bf & CE & OFS). exists b, (Ptrofs.add ofs (Ptrofs.repr delta)), bf; eapply esl_field_union; eauto.
+- (* valof *)
   destruct (andb_prop _ _ S) as [S1 S2]. clear S. rewrite negb_true_iff in S2.
   StepL IHa (fun x => C(Evalof x ty)) a.
   exploit safe_inv. eexact SAFE0. eauto. simpl. intros [TY [t [v LOAD]]].
   assert (t = E0). inv LOAD; auto. congruence. subst t.
   exists v; econstructor; eauto. congruence.
-(* deref *)
+- (* deref *)
   StepR IHa (fun x => C(Ederef x ty)) a.
   exploit safe_inv. eexact SAFE0. eauto. simpl. intros [b [ofs EQ]].
-  subst v. exists b; exists ofs; econstructor; eauto.
-(* addrof *)
+  subst v. exists b, ofs, Full; econstructor; eauto.
+- (* addrof *)
   StepL IHa (fun x => C(Eaddrof x ty)) a.
+  exploit safe_inv. eexact SAFE0. eauto. simpl. intros EQ; subst bf.
   exists (Vptr b ofs); econstructor; eauto.
-(* unop *)
+- (* unop *)
   StepR IHa (fun x => C(Eunop op x ty)) a.
   exploit safe_inv. eexact SAFE0. eauto. simpl. intros [v' EQ].
   exists v'; econstructor; eauto.
-(* binop *)
+- (* binop *)
   destruct (andb_prop _ _ S) as [S1 S2]; clear S.
   StepR IHa1 (fun x => C(Ebinop op x a2 ty)) a1.
   StepR IHa2 (fun x => C(Ebinop op (Eval v (typeof a1)) x ty)) a2.
   exploit safe_inv. eexact SAFE1. eauto. simpl. intros [v' EQ].
   exists v'; econstructor; eauto.
-(* cast *)
+- (* cast *)
   StepR IHa (fun x => C(Ecast x ty)) a.
   exploit safe_inv. eexact SAFE0. eauto. simpl. intros [v' CAST].
   exists v'; econstructor; eauto.
-(* sizeof *)
+- (* sizeof *)
   econstructor; econstructor.
-(* alignof *)
+- (* alignof *)
   econstructor; econstructor.
-(* loc *)
-  exists b; exists ofs; constructor.
+- (* loc *)
+  exists b, ofs, bf; constructor.
 Qed.
 
 Lemma simple_can_eval_rval:
@@ -869,11 +873,11 @@ Qed.
 Lemma simple_can_eval_lval:
   forall l C,
   simple l = true -> context LV RV C -> safe (ExprState f (C l) k e m) ->
-  exists b, exists ofs, eval_simple_lvalue e m l b ofs
-         /\ safe (ExprState f (C (Eloc b ofs (typeof l))) k e m).
+  exists b ofs bf, eval_simple_lvalue e m l b ofs bf
+         /\ safe (ExprState f (C (Eloc b ofs bf (typeof l))) k e m).
 Proof.
-  intros. exploit (simple_can_eval l LV); eauto. intros [b [ofs A]].
-  exists b; exists ofs; split; auto. eapply eval_simple_lvalue_safe; eauto.
+  intros. exploit (simple_can_eval l LV); eauto. intros (b & ofs & bf & A).
+  exists b, ofs, bf; split; auto. eapply eval_simple_lvalue_safe; eauto.
 Qed.
 
 Fixpoint rval_list (vl: list val) (rl: exprlist) : exprlist :=
@@ -1178,18 +1182,18 @@ Proof.
   eapply star_plus_trans.
   eapply eval_simple_lvalue_steps with (C := fun x => C(Eassign x r (typeof l))); eauto.
   eapply plus_right.
-  eapply eval_simple_rvalue_steps with (C := fun x => C(Eassign (Eloc b ofs (typeof l)) x (typeof l))); eauto.
+  eapply eval_simple_rvalue_steps with (C := fun x => C(Eassign (Eloc b ofs bf (typeof l)) x (typeof l))); eauto.
   left; apply step_rred; eauto. econstructor; eauto.
   reflexivity. auto.
 (* assignop *)
   eapply star_plus_trans.
   eapply eval_simple_lvalue_steps with (C := fun x => C(Eassignop op x r tyres (typeof l))); eauto.
   eapply star_plus_trans.
-  eapply eval_simple_rvalue_steps with (C := fun x => C(Eassignop op (Eloc b ofs (typeof l)) x tyres (typeof l))); eauto.
+  eapply eval_simple_rvalue_steps with (C := fun x => C(Eassignop op (Eloc b ofs bf (typeof l)) x tyres (typeof l))); eauto.
   eapply plus_left.
   left; apply step_rred; auto. econstructor; eauto.
   eapply star_left.
-  left; apply step_rred with (C := fun x => C(Eassign (Eloc b ofs (typeof l)) x (typeof l))); eauto. econstructor; eauto.
+  left; apply step_rred with (C := fun x => C(Eassign (Eloc b ofs bf (typeof l)) x (typeof l))); eauto. econstructor; eauto.
   apply star_one.
   left; apply step_rred; auto. econstructor; eauto.
   reflexivity. reflexivity. reflexivity. traceEq.
@@ -1197,19 +1201,19 @@ Proof.
   eapply star_plus_trans.
   eapply eval_simple_lvalue_steps with (C := fun x => C(Eassignop op x r tyres (typeof l))); eauto.
   eapply star_plus_trans.
-  eapply eval_simple_rvalue_steps with (C := fun x => C(Eassignop op (Eloc b ofs (typeof l)) x tyres (typeof l))); eauto.
+  eapply eval_simple_rvalue_steps with (C := fun x => C(Eassignop op (Eloc b ofs bf (typeof l)) x tyres (typeof l))); eauto.
   eapply plus_left.
   left; apply step_rred; auto. econstructor; eauto.
   destruct (sem_binary_operation ge op v1 (typeof l) v2 (typeof r) m) as [v3|] eqn:?.
   eapply star_left.
-  left; apply step_rred with (C := fun x => C(Eassign (Eloc b ofs (typeof l)) x (typeof l))); eauto. econstructor; eauto.
+  left; apply step_rred with (C := fun x => C(Eassign (Eloc b ofs bf (typeof l)) x (typeof l))); eauto. econstructor; eauto.
   apply star_one.
   left; eapply step_stuck; eauto.
-  red; intros. exploit imm_safe_inv; eauto. simpl. intros [v4' [m' [t' [A [B D]]]]].
+  red; intros. exploit imm_safe_inv; eauto. simpl. intros [v4' [m' [v' [t' [A [B D]]]]]].
   rewrite B in H4. eelim H4; eauto.
   reflexivity.
   apply star_one.
-  left; eapply step_stuck with (C := fun x => C(Eassign (Eloc b ofs (typeof l)) x (typeof l))); eauto.
+  left; eapply step_stuck with (C := fun x => C(Eassign (Eloc b ofs bf (typeof l)) x (typeof l))); eauto.
   red; intros. exploit imm_safe_inv; eauto. simpl. intros [v3 A]. congruence.
   reflexivity.
   reflexivity. traceEq.
@@ -1219,7 +1223,7 @@ Proof.
   eapply plus_left.
   left; apply step_rred; auto. econstructor; eauto.
   eapply star_left.
-  left; apply step_rred with (C := fun x => C (Ecomma (Eassign (Eloc b ofs (typeof l)) x (typeof l)) (Eval v1 (typeof l)) (typeof l))); eauto.
+  left; apply step_rred with (C := fun x => C (Ecomma (Eassign (Eloc b ofs bf (typeof l)) x (typeof l)) (Eval v1 (typeof l)) (typeof l))); eauto.
   econstructor. instantiate (1 := v2). destruct id; assumption.
   eapply star_left.
   left; apply step_rred with (C := fun x => C (Ecomma x (Eval v1 (typeof l)) (typeof l))); eauto.
@@ -1238,15 +1242,15 @@ Proof.
     destruct id; auto.
   destruct (sem_incrdecr ge id v1 (typeof l) m) as [v2|].
   eapply star_left.
-  left; apply step_rred with (C := fun x => C (Ecomma (Eassign (Eloc b ofs (typeof l)) x (typeof l)) (Eval v1 (typeof l)) (typeof l))); eauto.
+  left; apply step_rred with (C := fun x => C (Ecomma (Eassign (Eloc b ofs bf (typeof l)) x (typeof l)) (Eval v1 (typeof l)) (typeof l))); eauto.
   econstructor; eauto.
   apply star_one.
   left; eapply step_stuck with (C := fun x => C (Ecomma x (Eval v1 (typeof l)) (typeof l))); eauto.
-  red; intros. exploit imm_safe_inv; eauto. simpl. intros [v3 [m' [t' [A [B D]]]]].
+  red; intros. exploit imm_safe_inv; eauto. simpl. intros [v3 [m' [v' [t' [A [B D]]]]]].
   rewrite B in H3. eelim H3; eauto.
   reflexivity.
   apply star_one.
-  left; eapply step_stuck with (C := fun x => C (Ecomma (Eassign (Eloc b ofs (typeof l)) x (typeof l)) (Eval v1 (typeof l)) (typeof l))); eauto.
+  left; eapply step_stuck with (C := fun x => C (Ecomma (Eassign (Eloc b ofs bf (typeof l)) x (typeof l)) (Eval v1 (typeof l)) (typeof l))); eauto.
   red; intros. exploit imm_safe_inv; eauto. simpl. intros [v2 A]. congruence.
   reflexivity.
   traceEq.
@@ -1291,7 +1295,7 @@ Proof.
 (* valof volatile *)
   destruct Q.
   exploit (simple_can_eval_lval f k e m b (fun x => C(Evalof x ty))); eauto.
-  intros [b1 [ofs [E1 S1]]].
+  intros (b1 & ofs & bf & E1 & S1).
   exploit safe_inv. eexact S1. eauto. simpl. intros [A [t [v B]]].
   econstructor; econstructor; eapply step_rvalof_volatile; eauto. congruence.
 (* seqand *)
@@ -1316,40 +1320,40 @@ Proof.
 (* assign *)
   destruct Q.
   exploit (simple_can_eval_lval f k e m b1 (fun x => C(Eassign x b2 ty))); eauto.
-  intros [b [ofs [E1 S1]]].
-  exploit (simple_can_eval_rval f k e m b2 (fun x => C(Eassign (Eloc b ofs (typeof b1)) x ty))); eauto.
+  intros (b & ofs & bf & E1 & S1).
+  exploit (simple_can_eval_rval f k e m b2 (fun x => C(Eassign (Eloc b ofs bf (typeof b1)) x ty))); eauto.
   intros [v [E2 S2]].
-  exploit safe_inv. eexact S2. eauto. simpl. intros [v' [m' [t [A [B D]]]]].
+  exploit safe_inv. eexact S2. eauto. simpl. intros [v1 [m' [v' [t [A [B D]]]]]].
   econstructor; econstructor; eapply step_assign; eauto.
 (* assignop *)
   destruct Q.
   exploit (simple_can_eval_lval f k e m b1 (fun x => C(Eassignop op x b2 tyres ty))); eauto.
-  intros [b [ofs [E1 S1]]].
-  exploit (simple_can_eval_rval f k e m b2 (fun x => C(Eassignop op (Eloc b ofs (typeof b1)) x tyres ty))); eauto.
+  intros (b & ofs & bf & E1 & S1).
+  exploit (simple_can_eval_rval f k e m b2 (fun x => C(Eassignop op (Eloc b ofs bf (typeof b1)) x tyres ty))); eauto.
   intros [v [E2 S2]].
   exploit safe_inv. eexact S2. eauto. simpl. intros [t1 [v1 [A B]]].
   destruct (sem_binary_operation ge op v1 (typeof b1) v (typeof b2) m) as [v3|] eqn:?.
   destruct (sem_cast v3 tyres (typeof b1) m) as [v4|] eqn:?.
-  destruct (classic (exists t2, exists m', assign_loc ge (typeof b1) m b ofs v4 t2 m')).
-  destruct H2 as [t2 [m' D]].
+  destruct (classic (exists t2 m' v', assign_loc ge (typeof b1) m b ofs bf v4 t2 m' v')).
+  destruct H2 as [t2 [m' [v' D]]].
   econstructor; econstructor; eapply step_assignop; eauto.
   econstructor; econstructor; eapply step_assignop_stuck; eauto.
-  rewrite Heqo. rewrite Heqo0. intros; red; intros. elim H2. exists t2; exists m'; auto.
+  rewrite Heqo. rewrite Heqo0. intros; red; intros. elim H2. exists t2, m', v'; auto.
   econstructor; econstructor; eapply step_assignop_stuck; eauto.
   rewrite Heqo. rewrite Heqo0. auto.
   econstructor; econstructor; eapply step_assignop_stuck; eauto.
   rewrite Heqo. auto.
 (* postincr *)
   exploit (simple_can_eval_lval f k e m b (fun x => C(Epostincr id x ty))); eauto.
-  intros [b1 [ofs [E1 S1]]].
+  intros (b1 & ofs & bf & E1 & S1).
   exploit safe_inv. eexact S1. eauto. simpl. intros [t [v1 [A B]]].
   destruct (sem_incrdecr ge id v1 ty m) as [v2|] eqn:?.
   destruct (sem_cast v2 (incrdecr_type ty) ty m) as [v3|] eqn:?.
-  destruct (classic (exists t2, exists m', assign_loc ge ty m b1 ofs v3 t2 m')).
-  destruct H0 as [t2 [m' D]].
+  destruct (classic (exists t2 m' v', assign_loc ge ty m b1 ofs bf v3 t2 m' v')).
+  destruct H0 as [t2 [m' [v' D]]].
   econstructor; econstructor; eapply step_postincr; eauto.
   econstructor; econstructor; eapply step_postincr_stuck; eauto.
-  rewrite Heqo. rewrite Heqo0. intros; red; intros. elim H0. exists t2; exists m'; congruence.
+  rewrite Heqo. rewrite Heqo0. intros; red; intros. elim H0. exists t2, m', v'; congruence.
   econstructor; econstructor; eapply step_postincr_stuck; eauto.
   rewrite Heqo. rewrite Heqo0. auto.
   econstructor; econstructor; eapply step_postincr_stuck; eauto.
@@ -1440,18 +1444,18 @@ Definition semantics (p: program) :=
 (** This semantics is receptive to changes in events. *)
 
 Remark deref_loc_trace:
-  forall ge ty m b ofs t v,
-  deref_loc ge ty m b ofs t v ->
+  forall ge ty m b ofs bf t v,
+  deref_loc ge ty m b ofs bf t v ->
   match t with nil => True | ev :: nil => True | _ => False end.
 Proof.
   intros. inv H; simpl; auto. inv H2; simpl; auto.
 Qed.
 
 Remark deref_loc_receptive:
-  forall ge ty m b ofs ev1 t1 v ev2,
-  deref_loc ge ty m b ofs (ev1 :: t1) v ->
+  forall ge ty m b ofs bf ev1 t1 v ev2,
+  deref_loc ge ty m b ofs bf (ev1 :: t1) v ->
   match_traces ge (ev1 :: nil) (ev2 :: nil) ->
-  t1 = nil /\ exists v', deref_loc ge ty m b ofs (ev2 :: nil) v'.
+  t1 = nil /\ exists v', deref_loc ge ty m b ofs bf (ev2 :: nil) v'.
 Proof.
   intros.
   assert (t1 = nil). exploit deref_loc_trace; eauto. destruct t1; simpl; tauto.
@@ -1460,16 +1464,16 @@ Proof.
 Qed.
 
 Remark assign_loc_trace:
-  forall ge ty m b ofs t v m',
-  assign_loc ge ty m b ofs v t m' ->
+  forall ge ty m b ofs bf t v m' v',
+  assign_loc ge ty m b ofs bf v t m' v' ->
   match t with nil => True | ev :: nil => output_event ev | _ => False end.
 Proof.
   intros. inv H; simpl; auto. inv H2; simpl; auto.
 Qed.
 
 Remark assign_loc_receptive:
-  forall ge ty m b ofs ev1 t1 v m' ev2,
-  assign_loc ge ty m b ofs v (ev1 :: t1) m' ->
+  forall ge ty m b ofs bf ev1 t1 v m' v' ev2,
+  assign_loc ge ty m b ofs bf v (ev1 :: t1) m' v' ->
   match_traces ge (ev1 :: nil) (ev2 :: nil) ->
   ev1 :: t1 = ev2 :: nil.
 Proof.
@@ -1499,11 +1503,11 @@ Proof.
   inv H10. exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t0.
   destruct (sem_binary_operation ge op v1' (typeof l) v2 (typeof r) m) as [v3'|] eqn:?.
   destruct (sem_cast v3' tyres (typeof l) m) as [v4'|] eqn:?.
-  destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v4' t2' m'')).
-  destruct H1 as [t2' [m'' P]].
+  destruct (classic (exists t2' m'' v'', assign_loc ge (typeof l) m b ofs bf v4' t2' m'' v'')).
+  destruct H1 as [t2' [m'' [v'' P]]].
   econstructor; econstructor. left; eapply step_assignop with (v1 := v1'); eauto. simpl; reflexivity.
   econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto.
-  rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t0; exists m'0; auto.
+  rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t0, m'0, v'0; auto.
   econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto.
   rewrite Heqo; rewrite Heqo0; auto.
   econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto.
@@ -1512,11 +1516,11 @@ Proof.
   exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t1.
   destruct (sem_binary_operation ge op v1' (typeof l) v2 (typeof r) m) as [v3'|] eqn:?.
   destruct (sem_cast v3' tyres (typeof l) m) as [v4'|] eqn:?.
-  destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v4' t2' m'')).
-  destruct H1 as [t2' [m'' P]].
+  destruct (classic (exists t2' m'' v'', assign_loc ge (typeof l) m b ofs bf v4' t2' m'' v'')).
+  destruct H1 as [t2' [m'' [v'' P]]].
   econstructor; econstructor. left; eapply step_assignop with (v1 := v1'); eauto. simpl; reflexivity.
   econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto.
-  rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t2; exists m'; auto.
+  rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t2, m', v'; auto.
   econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto.
   rewrite Heqo; rewrite Heqo0; auto.
   econstructor; econstructor. left; eapply step_assignop_stuck with (v1 := v1'); eauto.
@@ -1528,11 +1532,11 @@ Proof.
   inv H9. exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t0.
   destruct (sem_incrdecr ge id v1' (typeof l) m) as [v2'|] eqn:?.
   destruct (sem_cast v2' (incrdecr_type (typeof l)) (typeof l) m) as [v3'|] eqn:?.
-  destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v3' t2' m'')).
-  destruct H1 as [t2' [m'' P]].
+  destruct (classic (exists t2' m'' v'', assign_loc ge (typeof l) m b ofs bf v3' t2' m'' v'')).
+  destruct H1 as [t2' [m'' [v'' P]]].
   econstructor; econstructor. left; eapply step_postincr with (v1 := v1'); eauto. simpl; reflexivity.
   econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto.
-  rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t0; exists m'0; auto.
+  rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t0, m'0, v'0; auto.
   econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto.
   rewrite Heqo; rewrite Heqo0; auto.
   econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto.
@@ -1541,11 +1545,11 @@ Proof.
   exploit deref_loc_receptive; eauto. intros [EQ [v1' A]]. subst t1.
   destruct (sem_incrdecr ge id v1' (typeof l) m) as [v2'|] eqn:?.
   destruct (sem_cast v2' (incrdecr_type (typeof l)) (typeof l) m) as [v3'|] eqn:?.
-  destruct (classic (exists t2', exists m'', assign_loc ge (typeof l) m b ofs v3' t2' m'')).
-  destruct H1 as [t2' [m'' P]].
+  destruct (classic (exists t2' m'' v'', assign_loc ge (typeof l) m b ofs bf v3' t2' m'' v'')).
+  destruct H1 as [t2' [m'' [v'' P]]].
   econstructor; econstructor. left; eapply step_postincr with (v1 := v1'); eauto. simpl; reflexivity.
   econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto.
-  rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t2; exists m'; auto.
+  rewrite Heqo; rewrite Heqo0. intros; red; intros; elim H1. exists t2, m', v'; auto.
   econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto.
   rewrite Heqo; rewrite Heqo0; auto.
   econstructor; econstructor. left; eapply step_postincr_stuck with (v1 := v1'); eauto.
@@ -1671,11 +1675,11 @@ with eval_expr: env -> mem -> kind -> expr -> trace -> mem -> expr -> Prop :=
       type_is_volatile (typeof a) = false ->
       eval_expr e m LV a t m' a' ->
       eval_expr e m RV (Evalof a ty) t m' (Evalof a' ty)
-  | eval_valof_volatile: forall e m a t1 m' a' ty b ofs t2 v,
+  | eval_valof_volatile: forall e m a t1 m' a' ty b ofs bf t2 v,
       type_is_volatile (typeof a) = true ->
       eval_expr e m LV a t1 m' a' ->
-      eval_simple_lvalue ge e m' a' b ofs ->
-      deref_loc ge (typeof a) m' b ofs t2 v ->
+      eval_simple_lvalue ge e m' a' b ofs bf ->
+      deref_loc ge (typeof a) m' b ofs bf t2 v ->
       ty = typeof a ->
       eval_expr e m RV (Evalof a ty) (t1 ** t2) m' (Eval v ty)
   | eval_deref: forall e m a t m' a' ty,
@@ -1723,32 +1727,32 @@ with eval_expr: env -> mem -> kind -> expr -> trace -> mem -> expr -> Prop :=
       eval_expr e m RV (Esizeof ty' ty) E0 m (Esizeof ty' ty)
   | eval_alignof: forall e m ty' ty,
       eval_expr e m RV (Ealignof ty' ty) E0 m (Ealignof ty' ty)
-  | eval_assign: forall e m l r ty t1 m1 l' t2 m2 r' b ofs v v' t3 m3,
+  | eval_assign: forall e m l r ty t1 m1 l' t2 m2 r' b ofs bf v v1 v' t3 m3,
       eval_expr e m LV l t1 m1 l' -> eval_expr e m1 RV r t2 m2 r' ->
-      eval_simple_lvalue ge e m2 l' b ofs ->
+      eval_simple_lvalue ge e m2 l' b ofs bf ->
       eval_simple_rvalue ge e m2 r' v ->
-      sem_cast v (typeof r) (typeof l) m2 = Some v' ->
-      assign_loc ge (typeof l) m2 b ofs v' t3 m3 ->
+      sem_cast v (typeof r) (typeof l) m2 = Some v1 ->
+      assign_loc ge (typeof l) m2 b ofs bf v1 t3 m3 v' ->
       ty = typeof l ->
       eval_expr e m RV (Eassign l r ty) (t1**t2**t3) m3 (Eval v' ty)
-  | eval_assignop: forall e m op l r tyres ty t1 m1 l' t2 m2 r' b ofs
-                          v1 v2 v3 v4 t3 t4 m3,
+  | eval_assignop: forall e m op l r tyres ty t1 m1 l' t2 m2 r' b ofs bf
+                          v1 v2 v3 v4 v' t3 t4 m3,
       eval_expr e m LV l t1 m1 l' -> eval_expr e m1 RV r t2 m2 r' ->
-      eval_simple_lvalue ge e m2 l' b ofs ->
-      deref_loc ge (typeof l) m2 b ofs t3 v1 ->
+      eval_simple_lvalue ge e m2 l' b ofs bf ->
+      deref_loc ge (typeof l) m2 b ofs bf t3 v1 ->
       eval_simple_rvalue ge e m2 r' v2 ->
       sem_binary_operation ge op v1 (typeof l) v2 (typeof r) m2 = Some v3 ->
       sem_cast v3 tyres (typeof l) m2 = Some v4 ->
-      assign_loc ge (typeof l) m2 b ofs v4 t4 m3 ->
+      assign_loc ge (typeof l) m2 b ofs bf v4 t4 m3 v' ->
       ty = typeof l ->
-      eval_expr e m RV (Eassignop op l r tyres ty) (t1**t2**t3**t4) m3 (Eval v4 ty)
-  | eval_postincr: forall e m id l ty t1 m1 l' b ofs v1 v2 v3 m2 t2 t3,
+      eval_expr e m RV (Eassignop op l r tyres ty) (t1**t2**t3**t4) m3 (Eval v' ty)
+  | eval_postincr: forall e m id l ty t1 m1 l' b ofs bf v1 v2 v3 v' m2 t2 t3,
       eval_expr e m LV l t1 m1 l' ->
-      eval_simple_lvalue ge e m1 l' b ofs ->
-      deref_loc ge ty m1 b ofs t2 v1 ->
+      eval_simple_lvalue ge e m1 l' b ofs bf ->
+      deref_loc ge ty m1 b ofs bf t2 v1 ->
       sem_incrdecr ge id v1 ty m1 = Some v2 ->
       sem_cast v2 (incrdecr_type ty) ty m1 = Some v3 ->
-      assign_loc ge ty m1 b ofs v3 t3 m2 ->
+      assign_loc ge ty m1 b ofs bf v3 t3 m2 v' ->
       ty = typeof l ->
       eval_expr e m RV (Epostincr id l ty) (t1**t2**t3) m2 (Eval v1 ty)
   | eval_comma: forall e m r1 r2 ty t1 m1 r1' v1 t2 m2 r2',
@@ -2311,7 +2315,7 @@ Proof.
   simpl; intuition.
   eapply star_trans. eexact D.
   eapply star_right. eexact G.
-  left. eapply step_assign; eauto. congruence. rewrite B; eauto. congruence.
+  left. eapply step_assign with (v1 := v1); eauto. congruence. rewrite B; eauto. congruence.
   reflexivity. traceEq.
 (* assignop *)
   exploit (H0 (fun x => C(Eassignop op x r tyres ty))).
@@ -2322,7 +2326,7 @@ Proof.
   eapply star_trans. eexact D.
   eapply star_right. eexact G.
   left. eapply step_assignop; eauto.
-  rewrite B; eauto. rewrite B; rewrite F; eauto. congruence. rewrite B; eauto. congruence.
+  rewrite B; eauto. rewrite B; rewrite F; eauto. rewrite B; eauto. rewrite B; eauto. congruence.
   reflexivity. traceEq.
 (* postincr *)
   exploit (H0 (fun x => C(Epostincr id x ty))).
@@ -2656,7 +2660,7 @@ Proof (proj2 (proj2 (proj2 (proj2 bigstep_to_steps)))).
 
 Fixpoint esize (a: expr) : nat :=
   match a with
-  | Eloc _ _ _ => 1%nat
+  | Eloc _ _ _ _ => 1%nat
   | Evar _ _ => 1%nat
   | Ederef r1 _ => S(esize r1)
   | Efield l1 _ _ => S(esize l1)
diff --git a/cfrontend/Csyntax.v b/cfrontend/Csyntax.v
index 19bc2ec3..5b8a62be 100644
--- a/cfrontend/Csyntax.v
+++ b/cfrontend/Csyntax.v
@@ -56,7 +56,7 @@ Inductive expr : Type :=
                                              (**r function call [r1(rargs)] *)
   | Ebuiltin (ef: external_function) (tyargs: typelist) (rargs: exprlist) (ty: type)
                                                  (**r builtin function call *)
-  | Eloc (b: block) (ofs: ptrofs) (ty: type)
+  | Eloc (b: block) (ofs: ptrofs) (bf: bitfield) (ty: type)
                        (**r memory location, result of evaluating a l-value *)
   | Eparen (r: expr) (tycast: type) (ty: type)   (**r marked subexpression *)
 
@@ -117,7 +117,7 @@ Definition Eselection (r1 r2 r3: expr) (ty: type) :=
 
 Definition typeof (a: expr) : type :=
   match a with
-  | Eloc _ _ ty => ty
+  | Eloc _ _ _ ty => ty
   | Evar _ ty => ty
   | Ederef _ ty => ty
   | Efield _ _ ty => ty
diff --git a/cfrontend/Ctypes.v b/cfrontend/Ctypes.v
index 142cc362..7b2c7354 100644
--- a/cfrontend/Ctypes.v
+++ b/cfrontend/Ctypes.v
@@ -20,6 +20,8 @@ Require Import Axioms Coqlib Maps Errors.
 Require Import AST Linking.
 Require Archi.
 
+Local Open Scope error_monad_scope.
+
 (** * Syntax of types *)
 
 (** Compcert C types are similar to those of C.  They include numeric types,
@@ -84,21 +86,28 @@ Proof.
   decide equality.
 Defined.
 
+Lemma signedness_eq: forall (s1 s2: signedness), {s1=s2} + {s1<>s2}.
+Proof.
+  decide equality.
+Defined.
+
+Lemma attr_eq: forall (a1 a2: attr), {a1=a2} + {a1<>a2}.
+Proof.
+  decide equality. decide equality. apply N.eq_dec. apply bool_dec.
+Defined.
+
 Lemma type_eq: forall (ty1 ty2: type), {ty1=ty2} + {ty1<>ty2}
 with typelist_eq: forall (tyl1 tyl2: typelist), {tyl1=tyl2} + {tyl1<>tyl2}.
 Proof.
-  assert (forall (x y: signedness), {x=y} + {x<>y}) by decide equality.
   assert (forall (x y: floatsize), {x=y} + {x<>y}) by decide equality.
-  assert (forall (x y: attr), {x=y} + {x<>y}).
-  { decide equality. decide equality. apply N.eq_dec. apply bool_dec. }
-  generalize ident_eq zeq bool_dec ident_eq intsize_eq; intros.
+  generalize ident_eq zeq bool_dec ident_eq intsize_eq signedness_eq attr_eq; intros.
   decide equality.
   decide equality.
   decide equality.
   decide equality.
 Defined.
 
-Opaque type_eq typelist_eq.
+Global Opaque intsize_eq signedness_eq attr_eq type_eq typelist_eq.
 
 (** Extract the attributes of a type. *)
 
@@ -150,17 +159,53 @@ Definition attr_union (a1 a2: attr) : attr :=
 Definition merge_attributes (ty: type) (a: attr) : type :=
   change_attributes (attr_union a) ty.
 
+(** Maximal size in bits of a bitfield of type [sz]. *)
+
+Definition bitsize_intsize (sz: intsize) : Z :=
+  match sz with
+  | I8 => 8
+  | I16 => 16
+  | I32 => 32
+  | IBool => 1
+  end.
+
 (** Syntax for [struct] and [union] definitions.  [struct] and [union]
   are collectively called "composites".  Each compilation unit
   comes with a list of top-level definitions of composites. *)
 
 Inductive struct_or_union : Type := Struct | Union.
 
-Definition members : Type := list (ident * type).
+Inductive member : Type :=
+  | Member_plain (id: ident) (t: type)
+  | Member_bitfield (id: ident) (sz: intsize) (sg: signedness) (a: attr)
+                    (width: Z) (padding: bool).
+
+Definition members : Type := list member.
 
 Inductive composite_definition : Type :=
   Composite (id: ident) (su: struct_or_union) (m: members) (a: attr).
 
+Definition name_member (m: member) : ident :=
+  match m with
+  | Member_plain id _ => id
+  | Member_bitfield id _ _ _ _ _ => id
+  end.
+
+Definition type_member (m: member) : type :=
+  match m with
+  | Member_plain _ t => t
+  | Member_bitfield _ sz sg a w _ =>
+      (* An unsigned bitfield of width < size of type reads with a signed type *)
+      let sg' := if zlt w (bitsize_intsize sz) then Signed else sg in
+      Tint sz sg' a
+  end.
+
+Definition member_is_padding (m: member) : bool :=
+  match m with
+  | Member_plain _ _ => false
+  | Member_bitfield _ _ _ _ _ p => p
+  end.
+
 Definition name_composite_def (c: composite_definition) : ident :=
   match c with Composite id su m a => id end.
 
@@ -168,7 +213,9 @@ Definition composite_def_eq (x y: composite_definition): {x=y} + {x<>y}.
 Proof.
   decide equality.
 - decide equality. decide equality. apply N.eq_dec. apply bool_dec.
-- apply list_eq_dec. decide equality. apply type_eq. apply ident_eq.
+- apply list_eq_dec. decide equality.
+  apply type_eq. apply ident_eq.
+  apply bool_dec. apply zeq. apply attr_eq. apply signedness_eq. apply intsize_eq. apply ident_eq.
 - decide equality.
 - apply ident_eq.
 Defined.
@@ -194,6 +241,13 @@ Record composite : Type := {
 
 Definition composite_env : Type := PTree.t composite.
 
+(** Access modes for members of structs or unions: either a plain field
+    or a bitfield *)
+
+Inductive bitfield : Type :=
+  | Full
+  | Bits (sz: intsize) (sg: signedness) (pos: Z) (width: Z).
+
 (** * Operations over types *)
 
 (** ** Conversions *)
@@ -389,41 +443,205 @@ Proof.
 - destruct (env!i). apply co_sizeof_alignof. apply Z.divide_0_r.
 Qed.
 
+(** ** Layout of struct fields *)
+
+Section LAYOUT.
+
+Variable env: composite_env.
+
+Definition bitalignof (t: type) := alignof env t * 8.
+
+Definition bitsizeof  (t: type) := sizeof env t * 8.
+
+Definition bitalignof_intsize (sz: intsize) : Z :=
+  match sz with
+  | I8 | IBool => 8
+  | I16 => 16
+  | I32 => 32
+  end.
+
+Definition next_field (pos: Z) (m: member) : Z :=
+  match m with
+  | Member_plain _ t =>
+      align pos (bitalignof t) + bitsizeof t
+  | Member_bitfield _ sz _ _ w _ =>
+      let s := bitalignof_intsize sz in
+      if zle w 0 then
+        align pos s
+      else
+        let curr := floor pos s in
+        let next := curr + s in
+        if zle (pos + w) next then pos + w else next + w
+  end.
+
+Definition layout_field (pos: Z) (m: member) : res (Z * bitfield) :=
+  match m with
+  | Member_plain _ t =>
+      OK (align pos (bitalignof t) / 8, Full)
+  | Member_bitfield _ sz sg _ w _ =>
+      if zle w 0 then Error (msg "accessing zero-width bitfield")
+      else if zlt (bitsize_intsize sz) w then Error (msg "bitfield too wide")
+      else
+        let s := bitalignof_intsize sz in
+        let start := floor pos s in
+        let next := start + s in
+        if zle (pos + w) next then
+          OK (start / 8, Bits sz sg (pos - start) w)
+        else
+          OK (next / 8, Bits sz sg 0 w)
+  end.
+
+(** Some properties *)
+
+Lemma bitalignof_intsize_pos:
+  forall sz, bitalignof_intsize sz > 0.
+Proof.
+  destruct sz; simpl; lia.
+Qed.
+
+Lemma next_field_incr:
+  forall pos m, pos <= next_field pos m.
+Proof.
+  intros. unfold next_field. destruct m.
+- set (al := bitalignof t).
+  assert (A: al > 0).
+  { unfold al, bitalignof. generalize (alignof_pos env t). lia. }
+  assert (pos <= align pos al) by (apply align_le; auto).
+  assert (bitsizeof t >= 0).
+  { unfold bitsizeof. generalize (sizeof_pos env t). lia. } 
+  lia.
+- set (s := bitalignof_intsize sz).
+  assert (A: s > 0) by (apply bitalignof_intsize_pos).
+  destruct (zle width 0).
++ apply align_le; auto.
++ generalize (floor_interval pos s A). 
+  set (start := floor pos s). intros B.
+  destruct (zle (pos + width) (start + s)); lia.
+Qed.
+
+Definition layout_start (p: Z) (bf: bitfield) :=
+  p * 8 + match bf with Full => 0 | Bits sz sg pos w => pos end.
+
+Definition layout_width (t: type) (bf: bitfield) :=
+  match bf with Full => bitsizeof t | Bits sz sg pos w => w end.
+
+Lemma layout_field_range: forall pos m ofs bf,
+  layout_field pos m = OK (ofs, bf) ->
+  pos <= layout_start ofs bf 
+  /\ layout_start ofs bf + layout_width (type_member m) bf <= next_field pos m.
+Proof.
+  intros until bf; intros L. unfold layout_start, layout_width. destruct m; simpl in L.
+- inv L. simpl.
+  set (al := bitalignof t).
+  set (q := align pos al).
+  assert (A: al > 0).
+  { unfold al, bitalignof. generalize (alignof_pos env t). lia. }
+  assert (B: pos <= q) by (apply align_le; auto).
+  assert (C: (al | q)) by (apply align_divides; auto).
+  assert (D: (8 | q)). 
+  { apply Z.divide_transitive with al; auto. apply Z.divide_factor_r. }
+  assert (E: q / 8 * 8 = q).
+  { destruct D as (n & E). rewrite E. rewrite Z.div_mul by lia. auto. }
+  rewrite E. lia.
+- unfold next_field.
+  destruct (zle width 0); try discriminate.
+  destruct (zlt (bitsize_intsize sz) width); try discriminate.
+  set (s := bitalignof_intsize sz) in *.
+  assert (A: s > 0) by (apply bitalignof_intsize_pos).
+  generalize (floor_interval pos s A). set (p := floor pos s) in *. intros B.
+  assert (C: (s | p)) by (apply floor_divides; auto).
+  assert (D: (8 | s)).
+  { exists (s / 8). unfold s. destruct sz; reflexivity. }
+  assert (E: (8 | p)) by (apply Z.divide_transitive with s; auto).
+  assert (F: (8 | p + s)) by (apply Z.divide_add_r; auto).
+  assert (G: p / 8 * 8 = p).
+  { destruct E as (n & EQ). rewrite EQ. rewrite Z.div_mul by lia. auto. }
+  assert (H: (p + s) / 8 * 8 = p + s).
+  { destruct F as (n & EQ). rewrite EQ. rewrite Z.div_mul by lia. auto. }
+  destruct (zle (pos + width) (p + s)); inv L; lia.
+Qed.
+
+Definition layout_alignment (t: type) (bf: bitfield) :=
+  match bf with
+  | Full => alignof env t
+  | Bits sz _ _ _ => bitalignof_intsize sz / 8
+  end.
+
+Lemma layout_field_alignment: forall pos m ofs bf,
+  layout_field pos m = OK (ofs, bf) ->
+  (layout_alignment (type_member m) bf | ofs).
+Proof.
+  intros until bf; intros L. destruct m; simpl in L.
+- inv L; simpl. 
+  set (q := align pos (bitalignof t)).
+  assert (A: (bitalignof t | q)).
+  { apply align_divides. unfold bitalignof. generalize (alignof_pos env t). lia. }
+  destruct A as [n E]. exists n. rewrite E. unfold bitalignof. rewrite Z.mul_assoc, Z.div_mul by lia. auto.
+- destruct (zle width 0); try discriminate.
+  destruct (zlt (bitsize_intsize sz) width); try discriminate.
+  set (s := bitalignof_intsize sz) in *.
+  assert (A: s > 0) by (apply bitalignof_intsize_pos).
+  set (p := floor pos s) in *.
+  assert (C: (s | p)) by (apply floor_divides; auto).
+  assert (D: (8 | s)).
+  { exists (s / 8). unfold s. destruct sz; reflexivity. }
+  assert (E: forall n, (s | n) -> (s / 8 | n / 8)).
+  { intros. destruct H as [n1 E1], D as [n2 E2]. rewrite E1, E2.
+    rewrite Z.mul_assoc, ! Z.div_mul by lia. exists n1; auto. }
+  destruct (zle (pos + width) (p + s)); inv L; simpl; fold s.
+  + apply E. auto.
+  + apply E. apply Z.divide_add_r; auto using Z.divide_refl.
+Qed.
+
+End LAYOUT.
+
 (** ** Size and alignment for composite definitions *)
 
 (** The alignment for a structure or union is the max of the alignment
-  of its members. *)
+  of its members.  Padding bitfields are ignored. *)
 
-Fixpoint alignof_composite (env: composite_env) (m: members) : Z :=
-  match m with
+Fixpoint alignof_composite (env: composite_env) (ms: members) : Z :=
+  match ms with
   | nil => 1
-  | (id, t) :: m' => Z.max (alignof env t) (alignof_composite env m')
+  | m :: ms => 
+     if member_is_padding m
+     then alignof_composite env ms
+     else Z.max (alignof env (type_member m)) (alignof_composite env ms)
   end.
 
 (** The size of a structure corresponds to its layout: fields are
   laid out consecutively, and padding is inserted to align
-  each field to the alignment for its type. *)
+  each field to the alignment for its type.  Bitfields are packed
+  as described above. *)
 
-Fixpoint sizeof_struct (env: composite_env) (cur: Z) (m: members) : Z :=
-  match m with
+Fixpoint bitsizeof_struct (env: composite_env) (cur: Z) (ms: members) : Z :=
+  match ms with
   | nil => cur
-  | (id, t) :: m' => sizeof_struct env (align cur (alignof env t) + sizeof env t) m'
+  | m :: ms => bitsizeof_struct env (next_field env cur m) ms
   end.
 
+Definition bytes_of_bits (n: Z) := (n + 7) / 8.
+
+Definition sizeof_struct (env: composite_env) (m: members) : Z :=
+  bytes_of_bits (bitsizeof_struct env 0 m).
+
 (** The size of an union is the max of the sizes of its members. *)
 
-Fixpoint sizeof_union (env: composite_env) (m: members) : Z :=
-  match m with
+Fixpoint sizeof_union (env: composite_env) (ms: members) : Z :=
+  match ms with
   | nil => 0
-  | (id, t) :: m' => Z.max (sizeof env t) (sizeof_union env m')
+  | m :: ms => Z.max (sizeof env (type_member m)) (sizeof_union env ms)
   end.
 
+(** Some properties *)
+
 Lemma alignof_composite_two_p:
   forall env m, exists n, alignof_composite env m = two_power_nat n.
 Proof.
-  induction m as [|[id t]]; simpl.
+  induction m; simpl.
 - exists 0%nat; auto.
-- apply Z.max_case; auto. apply alignof_two_p.
+- destruct (member_is_padding a); auto.
+  apply Z.max_case; auto. apply alignof_two_p.
 Qed.
 
 Lemma alignof_composite_pos:
@@ -435,94 +653,113 @@ Proof.
   rewrite EQ; apply two_power_nat_pos.
 Qed.
 
-Lemma sizeof_struct_incr:
-  forall env m cur, cur <= sizeof_struct env cur m.
+Lemma bitsizeof_struct_incr:
+  forall env m cur, cur <= bitsizeof_struct env cur m.
 Proof.
-  induction m as [|[id t]]; simpl; intros.
+  induction m; simpl; intros.
 - lia.
-- apply Z.le_trans with (align cur (alignof env t)).
-  apply align_le. apply alignof_pos.
-  apply Z.le_trans with (align cur (alignof env t) + sizeof env t).
-  generalize (sizeof_pos env t); lia.
-  apply IHm.
+- apply Z.le_trans with (next_field env cur a).
+  apply next_field_incr. apply IHm.
 Qed.
 
 Lemma sizeof_union_pos:
   forall env m, 0 <= sizeof_union env m.
 Proof.
-  induction m as [|[id t]]; simpl; extlia.
+  induction m; simpl; extlia.
 Qed.
 
-(** ** Byte offset for a field of a structure *)
+(** ** Byte offset and bitfield designator for a field of a structure *)
 
-(** [field_offset env id fld] returns the byte offset for field [id]
-  in a structure whose members are [fld].  Fields are laid out
-  consecutively, and padding is inserted to align each field to the
-  alignment for its type. *)
-
-Fixpoint field_offset_rec (env: composite_env) (id: ident) (fld: members) (pos: Z)
-                          {struct fld} : res Z :=
-  match fld with
+Fixpoint field_type (id: ident) (ms: members) {struct ms} : res type :=
+  match ms with
   | nil => Error (MSG "Unknown field " :: CTX id :: nil)
-  | (id', t) :: fld' =>
-      if ident_eq id id'
-      then OK (align pos (alignof env t))
-      else field_offset_rec env id fld' (align pos (alignof env t) + sizeof env t)
+  | m :: ms => if ident_eq id (name_member m) then OK (type_member m) else field_type id ms
   end.
 
-Definition field_offset (env: composite_env) (id: ident) (fld: members) : res Z :=
-  field_offset_rec env id fld 0.
+(** [field_offset env id fld] returns the byte offset for field [id]
+  in a structure whose members are [fld].  It also returns a
+  bitfield designator, giving the location of the bits to access
+  within the storage unit for the bitfield. *)
 
-Fixpoint field_type (id: ident) (fld: members) {struct fld} : res type :=
-  match fld with
+Fixpoint field_offset_rec (env: composite_env) (id: ident) (ms: members) (pos: Z)
+                          {struct ms} : res (Z * bitfield) :=
+  match ms with
   | nil => Error (MSG "Unknown field " :: CTX id :: nil)
-  | (id', t) :: fld' => if ident_eq id id' then OK t else field_type id fld'
+  | m :: ms =>
+      if ident_eq id (name_member m)
+      then layout_field env pos m
+      else field_offset_rec env id ms (next_field env pos m)
   end.
 
+Definition field_offset (env: composite_env) (id: ident) (ms: members) : res (Z * bitfield) :=
+  field_offset_rec env id ms 0.
+
 (** Some sanity checks about field offsets.  First, field offsets are
   within the range of acceptable offsets. *)
 
 Remark field_offset_rec_in_range:
-  forall env id ofs ty fld pos,
-  field_offset_rec env id fld pos = OK ofs -> field_type id fld = OK ty ->
-  pos <= ofs /\ ofs + sizeof env ty <= sizeof_struct env pos fld.
+  forall env id ofs bf ty ms pos,
+  field_offset_rec env id ms pos = OK (ofs, bf) -> field_type id ms = OK ty ->
+  pos <= layout_start ofs bf
+  /\ layout_start ofs bf + layout_width env ty bf <= bitsizeof_struct env pos ms.
 Proof.
-  intros until ty. induction fld as [|[i t]]; simpl; intros.
+  induction ms as [ | m ms]; simpl; intros.
 - discriminate.
-- destruct (ident_eq id i); intros.
-  inv H. inv H0. split.
-  apply align_le. apply alignof_pos. apply sizeof_struct_incr.
-  exploit IHfld; eauto. intros [A B]. split; auto.
-  eapply Z.le_trans; eauto. apply Z.le_trans with (align pos (alignof env t)).
-  apply align_le. apply alignof_pos. generalize (sizeof_pos env t). lia.
+- destruct (ident_eq id (name_member m)).
+  + inv H0. 
+    exploit layout_field_range; eauto.
+    generalize (bitsizeof_struct_incr env ms (next_field env pos m)).
+    lia.
+  + exploit IHms; eauto.
+    generalize (next_field_incr env pos m).
+    lia.
 Qed.
 
-Lemma field_offset_in_range:
-  forall env fld id ofs ty,
-  field_offset env id fld = OK ofs -> field_type id fld = OK ty ->
-  0 <= ofs /\ ofs + sizeof env ty <= sizeof_struct env 0 fld.
+Lemma field_offset_in_range_gen:
+  forall env ms id ofs bf ty,
+  field_offset env id ms = OK (ofs, bf) -> field_type id ms = OK ty ->
+  0 <= layout_start ofs bf
+  /\ layout_start ofs bf + layout_width env ty bf <= bitsizeof_struct env 0 ms.
 Proof.
   intros. eapply field_offset_rec_in_range; eauto.
 Qed.
 
+Corollary field_offset_in_range:
+  forall env ms id ofs ty,
+  field_offset env id ms = OK (ofs, Full) -> field_type id ms = OK ty ->
+  0 <= ofs /\ ofs + sizeof env ty <= sizeof_struct env ms.
+Proof.
+  intros. exploit field_offset_in_range_gen; eauto. 
+  unfold layout_start, layout_width, bitsizeof, sizeof_struct. intros [A B].
+  assert (C: forall x y, x * 8 <= y -> x <= bytes_of_bits y).
+  { unfold bytes_of_bits; intros. 
+    assert (P: 8 > 0) by lia.
+    generalize (Z_div_mod_eq (y + 7) 8 P) (Z_mod_lt (y + 7) 8 P).
+    lia. }
+  split. lia. apply C. lia.
+Qed.
+
 (** Second, two distinct fields do not overlap *)
 
 Lemma field_offset_no_overlap:
-  forall env id1 ofs1 ty1 id2 ofs2 ty2 fld,
-  field_offset env id1 fld = OK ofs1 -> field_type id1 fld = OK ty1 ->
-  field_offset env id2 fld = OK ofs2 -> field_type id2 fld = OK ty2 ->
+  forall env id1 ofs1 bf1 ty1 id2 ofs2 bf2 ty2 fld,
+  field_offset env id1 fld = OK (ofs1, bf1) -> field_type id1 fld = OK ty1 ->
+  field_offset env id2 fld = OK (ofs2, bf2) -> field_type id2 fld = OK ty2 ->
   id1 <> id2 ->
-  ofs1 + sizeof env ty1 <= ofs2 \/ ofs2 + sizeof env ty2 <= ofs1.
+  layout_start ofs1 bf1 + layout_width env ty1 bf1 <= layout_start ofs2 bf2
+  \/ layout_start ofs2 bf2 + layout_width env ty2 bf2 <= layout_start ofs1 bf1.
 Proof.
   intros until fld. unfold field_offset. generalize 0 as pos.
-  induction fld as [|[i t]]; simpl; intros.
+  induction fld as [|m fld]; simpl; intros.
 - discriminate.
-- destruct (ident_eq id1 i); destruct (ident_eq id2 i).
+- destruct (ident_eq id1 (name_member m)); destruct (ident_eq id2 (name_member m)).
 + congruence.
-+ subst i. inv H; inv H0.
-  exploit field_offset_rec_in_range. eexact H1. eauto. tauto.
-+ subst i. inv H1; inv H2.
-  exploit field_offset_rec_in_range. eexact H. eauto. tauto.
++ inv H0.
+  exploit field_offset_rec_in_range; eauto.
+  exploit layout_field_range; eauto. lia.
++ inv H2.
+  exploit field_offset_rec_in_range; eauto.
+  exploit layout_field_range; eauto. lia.
 + eapply IHfld; eauto.
 Qed.
 
@@ -530,31 +767,90 @@ Qed.
     are the same. *)
 
 Lemma field_offset_prefix:
-  forall env id ofs fld2 fld1,
-  field_offset env id fld1 = OK ofs ->
-  field_offset env id (fld1 ++ fld2) = OK ofs.
+  forall env id ofs bf fld2 fld1,
+  field_offset env id fld1 = OK (ofs, bf) ->
+  field_offset env id (fld1 ++ fld2) = OK (ofs, bf).
 Proof.
   intros until fld1. unfold field_offset. generalize 0 as pos.
-  induction fld1 as [|[i t]]; simpl; intros.
+  induction fld1 as [|m fld1]; simpl; intros.
 - discriminate.
-- destruct (ident_eq id i); auto.
+- destruct (ident_eq id (name_member m)); auto.
 Qed.
 
 (** Fourth, the position of each field respects its alignment. *)
 
-Lemma field_offset_aligned:
-  forall env id fld ofs ty,
-  field_offset env id fld = OK ofs -> field_type id fld = OK ty ->
-  (alignof env ty | ofs).
+Lemma field_offset_aligned_gen:
+  forall env id fld ofs bf ty,
+  field_offset env id fld = OK (ofs, bf) -> field_type id fld = OK ty ->
+  (layout_alignment env ty bf | ofs).
 Proof.
   intros until ty. unfold field_offset. generalize 0 as pos. revert fld.
-  induction fld as [|[i t]]; simpl; intros.
+  induction fld as [|m fld]; simpl; intros.
 - discriminate.
-- destruct (ident_eq id i).
-+ inv H; inv H0. apply align_divides. apply alignof_pos.
+- destruct (ident_eq id (name_member m)).
++ inv H0. eapply layout_field_alignment; eauto.
 + eauto.
 Qed.
 
+Corollary field_offset_aligned:
+  forall env id fld ofs ty,
+  field_offset env id fld = OK (ofs, Full) -> field_type id fld = OK ty ->
+  (alignof env ty | ofs).
+Proof.
+  intros. exploit field_offset_aligned_gen; eauto.
+Qed.
+
+(** [union_field_offset env id ms] returns the byte offset and
+    bitfield designator for accessing a member named [id] of a union
+    whose members are [ms].  The byte offset is always 0. *)
+
+Fixpoint union_field_offset (env: composite_env) (id: ident) (ms: members)
+                          {struct ms} : res (Z * bitfield) :=
+  match ms with
+  | nil => Error (MSG "Unknown field " :: CTX id :: nil)
+  | m :: ms =>
+      if ident_eq id (name_member m)
+      then layout_field env 0 m
+      else union_field_offset env id ms
+  end.
+
+(** Some sanity checks about union field offsets.  First, field offsets
+    fit within the size of the union. *)
+
+Lemma union_field_offset_in_range_gen:
+  forall env id ofs bf ty ms,
+  union_field_offset env id ms = OK (ofs, bf) -> field_type id ms = OK ty ->
+  ofs = 0 /\ 0 <= layout_start ofs bf /\ layout_start ofs bf + layout_width env ty bf <= sizeof_union env ms * 8.
+Proof.
+  induction ms as [ | m ms]; simpl; intros.
+- discriminate.
+- destruct (ident_eq id (name_member m)).
+  + inv H0. set (ty := type_member m) in *.
+    destruct m; simpl in H.
+    * inv H. unfold layout_start, layout_width. 
+      rewrite align_same. change (0 / 8) with 0. unfold bitsizeof. lia.
+      unfold bitalignof. generalize (alignof_pos env t). lia.
+      apply Z.divide_0_r.
+    * destruct (zle width 0); try discriminate.
+      destruct (zlt (bitsize_intsize sz) width); try discriminate.
+      assert (A: bitsize_intsize sz <= bitalignof_intsize sz <= sizeof env ty * 8).
+      { unfold ty, type_member; destruct sz; simpl; lia. }
+      rewrite zle_true in H by lia. inv H.
+      unfold layout_start, layout_width.
+      unfold floor; rewrite Z.div_0_l by lia.
+      lia.
+  + exploit IHms; eauto. lia.
+Qed.
+
+Corollary union_field_offset_in_range:
+  forall env ms id ofs ty,
+  union_field_offset env id ms = OK (ofs, Full) -> field_type id ms = OK ty ->
+  ofs = 0 /\ sizeof env ty <= sizeof_union env ms.
+Proof.
+  intros. exploit union_field_offset_in_range_gen; eauto. 
+  unfold layout_start, layout_width, bitsizeof. lia.
+Qed.
+
 (** ** Access modes *)
 
 (** The [access_mode] function describes how a l-value of the given
@@ -712,7 +1008,8 @@ Fixpoint rank_type (ce: composite_env) (t: type) : nat :=
 Fixpoint rank_members (ce: composite_env) (m: members) : nat :=
   match m with
   | nil => 0%nat
-  | (id, t) :: m => Init.Nat.max (rank_type ce t) (rank_members ce m)
+  | Member_plain _ t :: m => Init.Nat.max (rank_type ce t) (rank_members ce m)
+  | Member_bitfield _ _ _ _ _ _ :: m => rank_members ce m
   end.
 
 (** ** C types and back-end types *)
@@ -766,7 +1063,7 @@ Definition signature_of_type (args: typelist) (res: type) (cc: calling_conventio
 
 Definition sizeof_composite (env: composite_env) (su: struct_or_union) (m: members) : Z :=
   match su with
-  | Struct => sizeof_struct env 0 m
+  | Struct => sizeof_struct env m
   | Union  => sizeof_union env m
   end.
 
@@ -774,21 +1071,23 @@ Lemma sizeof_composite_pos:
   forall env su m, 0 <= sizeof_composite env su m.
 Proof.
   intros. destruct su; simpl.
-  apply sizeof_struct_incr.
-  apply sizeof_union_pos.
+- unfold sizeof_struct, bytes_of_bits.
+  assert (0 <= bitsizeof_struct env 0 m) by apply bitsizeof_struct_incr.
+  change 0 with (0 / 8) at 1. apply Z.div_le_mono; lia.
+- apply sizeof_union_pos.
 Qed.
 
-Fixpoint complete_members (env: composite_env) (m: members) : bool :=
-  match m with
+Fixpoint complete_members (env: composite_env) (ms: members) : bool :=
+  match ms with
   | nil => true
-  | (id, t) :: m' => complete_type env t && complete_members env m'
+  | m :: ms => complete_type env (type_member m) && complete_members env ms
   end.
 
 Lemma complete_member:
-  forall env id t m,
-  In (id, t) m -> complete_members env m = true -> complete_type env t = true.
+  forall env m ms,
+  In m ms -> complete_members env ms = true -> complete_type env (type_member m) = true.
 Proof.
-  induction m as [|[id1 t1] m]; simpl; intuition auto.
+  induction ms as [|m1 ms]; simpl; intuition auto.
   InvBooleans; inv H1; auto.
   InvBooleans; eauto.
 Qed.
@@ -852,8 +1151,6 @@ Defined.
   must precede all uses of this composite, unless the use is under
   a pointer or function type. *)
 
-Local Open Scope error_monad_scope.
-
 Fixpoint add_composite_definitions (env: composite_env) (defs: list composite_definition) : res composite_env :=
   match defs with
   | nil => OK env
@@ -916,52 +1213,88 @@ Proof.
 Qed.
 
 Lemma alignof_composite_stable:
-  forall m, complete_members env m = true -> alignof_composite env' m = alignof_composite env m.
+  forall ms, complete_members env ms = true -> alignof_composite env' ms = alignof_composite env ms.
 Proof.
-  induction m as [|[id t]]; simpl; intros.
+  induction ms as [|m ms]; simpl; intros.
   auto.
-  InvBooleans. rewrite alignof_stable by auto. rewrite IHm by auto. auto.
+  InvBooleans. rewrite alignof_stable by auto. rewrite IHms by auto. auto.
 Qed.
 
-Lemma sizeof_struct_stable:
-  forall m pos, complete_members env m = true -> sizeof_struct env' pos m = sizeof_struct env pos m.
+Remark next_field_stable: forall pos m,
+  complete_type env (type_member m) = true -> next_field env' pos m = next_field env pos m.
 Proof.
-  induction m as [|[id t]]; simpl; intros.
+  destruct m; simpl; intros.
+- unfold bitalignof, bitsizeof. rewrite alignof_stable, sizeof_stable by auto. auto.
+- auto.
+Qed.
+
+Lemma bitsizeof_struct_stable:
+  forall ms pos, complete_members env ms = true -> bitsizeof_struct env' pos ms = bitsizeof_struct env pos ms.
+Proof.
+  induction ms as [|m ms]; simpl; intros.
   auto.
-  InvBooleans. rewrite alignof_stable by auto. rewrite sizeof_stable by auto.
-  rewrite IHm by auto. auto.
+  InvBooleans. rewrite next_field_stable by auto. apply IHms; auto.
 Qed.
 
 Lemma sizeof_union_stable:
-  forall m, complete_members env m = true -> sizeof_union env' m = sizeof_union env m.
+  forall ms, complete_members env ms = true -> sizeof_union env' ms = sizeof_union env ms.
 Proof.
-  induction m as [|[id t]]; simpl; intros.
+  induction ms as [|m ms]; simpl; intros.
   auto.
-  InvBooleans. rewrite sizeof_stable by auto. rewrite IHm by auto. auto.
+  InvBooleans. rewrite sizeof_stable by auto. rewrite IHms by auto. auto.
 Qed.
 
 Lemma sizeof_composite_stable:
-  forall su m, complete_members env m = true -> sizeof_composite env' su m = sizeof_composite env su m.
+  forall su ms, complete_members env ms = true -> sizeof_composite env' su ms = sizeof_composite env su ms.
 Proof.
   intros. destruct su; simpl.
-  apply sizeof_struct_stable; auto.
+  unfold sizeof_struct. f_equal. apply bitsizeof_struct_stable; auto.
   apply sizeof_union_stable; auto.
 Qed.
 
 Lemma complete_members_stable:
-  forall m, complete_members env m = true -> complete_members env' m = true.
+  forall ms, complete_members env ms = true -> complete_members env' ms = true.
 Proof.
-  induction m as [|[id t]]; simpl; intros.
+  induction ms as [|m ms]; simpl; intros.
   auto.
-  InvBooleans. rewrite complete_type_stable by auto. rewrite IHm by auto. auto.
+  InvBooleans. rewrite complete_type_stable by auto. rewrite IHms by auto. auto.
 Qed.
 
 Lemma rank_members_stable:
-  forall m, complete_members env m = true -> rank_members env' m = rank_members env m.
+  forall ms, complete_members env ms = true -> rank_members env' ms = rank_members env ms.
 Proof.
-  induction m as [|[id t]]; simpl; intros.
+  induction ms as [|m ms]; simpl; intros.
   auto.
-  InvBooleans. f_equal; auto. apply rank_type_stable; auto.
+  InvBooleans. destruct m; auto. f_equal; auto. apply rank_type_stable; auto.
+Qed.
+
+Remark layout_field_stable: forall pos m,
+  complete_type env (type_member m) = true -> layout_field env' pos m = layout_field env pos m.
+Proof.
+  destruct m; simpl; intros.
+- unfold bitalignof. rewrite alignof_stable by auto. auto.
+- auto.
+Qed.
+
+Lemma field_offset_stable:
+  forall f ms, complete_members env ms = true -> field_offset env' f ms = field_offset env f ms.
+Proof.
+  intros until ms. unfold field_offset. generalize 0.
+  induction ms as [|m ms]; simpl; intros.
+- auto.
+- InvBooleans. destruct (ident_eq f (name_member m)).
+  apply layout_field_stable; auto.
+  rewrite next_field_stable by auto. apply IHms; auto.
+Qed.
+
+Lemma union_field_offset_stable:
+  forall f ms, complete_members env ms = true -> union_field_offset env' f ms = union_field_offset env f ms.
+Proof.
+  induction ms as [|m ms]; simpl; intros.
+- auto.
+- InvBooleans. destruct (ident_eq f (name_member m)).
+  apply layout_field_stable; auto.
+  apply IHms; auto.
 Qed.
 
 End STABILITY.
@@ -1091,19 +1424,23 @@ Qed.
   is strictly greater than the ranks of its member types. *)
 
 Remark rank_type_members:
-  forall ce id t m, In (id, t) m -> (rank_type ce t <= rank_members ce m)%nat.
+  forall ce m ms, In m ms -> (rank_type ce (type_member m) <= rank_members ce ms)%nat.
 Proof.
-  induction m; simpl; intros; intuition auto.
-  subst a. extlia.
-  extlia.
+  induction ms; simpl; intros.
+- tauto.
+- destruct a; destruct H; subst; simpl.
+  + lia.
+  + apply IHms in H. lia.
+  + lia.
+  + apply IHms; auto.
 Qed.
 
 Lemma rank_struct_member:
-  forall ce id a co id1 t1,
+  forall ce id a co m,
   composite_env_consistent ce ->
   ce!id = Some co ->
-  In (id1, t1) (co_members co) ->
-  (rank_type ce t1 < rank_type ce (Tstruct id a))%nat.
+  In m (co_members co) ->
+  (rank_type ce (type_member m) < rank_type ce (Tstruct id a))%nat.
 Proof.
   intros; simpl. rewrite H0.
   erewrite co_consistent_rank by eauto.
@@ -1112,11 +1449,11 @@ Proof.
 Qed.
 
 Lemma rank_union_member:
-  forall ce id a co id1 t1,
+  forall ce id a co m,
   composite_env_consistent ce ->
   ce!id = Some co ->
-  In (id1, t1) (co_members co) ->
-  (rank_type ce t1 < rank_type ce (Tunion id a))%nat.
+  In m (co_members co) ->
+  (rank_type ce (type_member m) < rank_type ce (Tunion id a))%nat.
 Proof.
   intros; simpl. rewrite H0.
   erewrite co_consistent_rank by eauto.
diff --git a/cfrontend/Ctyping.v b/cfrontend/Ctyping.v
index 5f0a3e5b..c930a407 100644
--- a/cfrontend/Ctyping.v
+++ b/cfrontend/Ctyping.v
@@ -410,8 +410,8 @@ Inductive wt_rvalue : expr -> Prop :=
       wt_rvalue (Eparen r tycast ty)
 
 with wt_lvalue : expr -> Prop :=
-  | wt_Eloc: forall b ofs ty,
-      wt_lvalue (Eloc b ofs ty)
+  | wt_Eloc: forall b ofs bf ty,
+      wt_lvalue (Eloc b ofs bf ty)
   | wt_Evar: forall x ty,
       e!x = Some ty ->
       wt_lvalue (Evar x ty)
@@ -440,7 +440,7 @@ Definition wt_expr_kind (k: kind) (a: expr) :=
 
 Definition expr_kind (a: expr) : kind :=
   match a with
-  | Eloc _ _ _ => LV
+  | Eloc _ _ _ _ => LV
   | Evar _ _ => LV
   | Ederef _ _ => LV
   | Efield _ _ _ => LV
@@ -596,7 +596,7 @@ Fixpoint check_arguments (el: exprlist) (tyl: typelist) : res unit :=
 
 Definition check_rval (e: expr) : res unit :=
   match e with
-  | Eloc _ _ _ | Evar _ _ | Ederef _ _ | Efield _ _ _ =>
+  | Eloc _ _ _ _ | Evar _ _ | Ederef _ _ | Efield _ _ _ =>
       Error (msg "not a r-value")
   | _ =>
       OK tt
@@ -604,7 +604,7 @@ Definition check_rval (e: expr) : res unit :=
 
 Definition check_lval (e: expr) : res unit :=
   match e with
-  | Eloc _ _ _ | Evar _ _ | Ederef _ _ | Efield _ _ _ =>
+  | Eloc _ _ _ _ | Evar _ _ | Ederef _ _ | Efield _ _ _ =>
       OK tt
   | _ =>
       Error (msg "not a l-value")
@@ -846,7 +846,7 @@ Fixpoint retype_expr (ce: composite_env) (e: typenv) (a: expr) : res expr :=
       do r1' <- retype_expr ce e r1; do rl' <- retype_exprlist ce e rl; ecall r1' rl'
   | Ebuiltin ef tyargs rl tyres =>
       do rl' <- retype_exprlist ce e rl; ebuiltin ef tyargs rl' tyres
-  | Eloc _ _ _ =>
+  | Eloc _ _ _ _ =>
       Error (msg "Eloc in source")
   | Eparen _ _ _ =>
       Error (msg "Eparen in source")
@@ -984,6 +984,7 @@ Lemma binarith_type_cast:
   forall t1 t2 m t,
   binarith_type t1 t2 m = OK t -> wt_cast t1 t /\ wt_cast t2 t.
 Proof.
+Local Transparent Ctypes.intsize_eq.
   unfold wt_cast, binarith_type, classify_binarith; intros; DestructCases;
   simpl; split; try congruence;
   try (destruct Archi.ptr64; congruence).
@@ -1656,9 +1657,31 @@ Proof.
   unfold Mptr in *. destruct Archi.ptr64 eqn:SF; auto with ty.
 Qed.
 
+Remark wt_bitfield_normalize: forall sz sg width sg1 n,
+  0 < width <= bitsize_intsize sz ->
+  sg1 = (if zlt width (bitsize_intsize sz) then Signed else sg) ->
+  wt_int (bitfield_normalize sz sg width n) sz sg1.
+Proof.
+  intros. destruct sz; cbn in *.
+  + destruct sg.
+    * replace sg1 with Signed by (destruct zlt; auto).
+      apply Int.sign_ext_widen; lia.
+    * subst sg1; destruct zlt.
+      ** apply Int.sign_zero_ext_widen; lia.
+      ** apply Int.zero_ext_widen; lia.
+  + destruct sg.
+    * replace sg1 with Signed by (destruct zlt; auto).
+      apply Int.sign_ext_widen; lia.
+    * subst sg1; destruct zlt.
+      ** apply Int.sign_zero_ext_widen; lia.
+      ** apply Int.zero_ext_widen; lia.
+  + auto.
+  + apply Int.zero_ext_widen; lia.
+Qed.
+
 Lemma wt_deref_loc:
-  forall ge ty m b ofs t v,
-  deref_loc ge ty m b ofs t v ->
+  forall ge ty m b ofs bf t v,
+  deref_loc ge ty m b ofs bf t v ->
   wt_val v ty.
 Proof.
   induction 1.
@@ -1680,6 +1703,19 @@ Proof.
   destruct ty; simpl in H; try discriminate; auto with ty.
   destruct i; destruct s; discriminate.
   destruct f; discriminate.
+- (* bitfield *)
+  inv H. constructor.
+  apply wt_bitfield_normalize. lia. auto.
+Qed.
+
+Lemma wt_assign_loc:
+  forall ge ty m b ofs bf v t m' v',
+  assign_loc ge ty m b ofs bf v t m' v' ->
+  wt_val v ty -> wt_val v' ty.
+Proof.
+  induction 1; intros; auto.
+- inv H. constructor.
+  apply wt_bitfield_normalize. lia. auto.
 Qed.
 
 Lemma wt_cast_self:
@@ -1770,7 +1806,7 @@ Proof.
 - (* condition *) constructor. destruct b; auto. destruct b; auto. red; auto.
 - (* sizeof *)  unfold size_t, Vptrofs; destruct Archi.ptr64; constructor; auto with ty.
 - (* alignof *)  unfold size_t, Vptrofs; destruct Archi.ptr64; constructor; auto with ty.
-- (* assign *) inversion H5. constructor. eapply pres_sem_cast; eauto.
+- (* assign *) inversion H5. constructor. eapply wt_assign_loc; eauto. eapply pres_sem_cast; eauto.
 - (* assignop *) subst tyres l r. constructor. auto.
   constructor. constructor. eapply wt_deref_loc; eauto.
   auto. auto. auto.
diff --git a/cfrontend/Initializers.v b/cfrontend/Initializers.v
index 77d6cfea..32fbf46b 100644
--- a/cfrontend/Initializers.v
+++ b/cfrontend/Initializers.v
@@ -114,18 +114,23 @@ Fixpoint constval (ce: composite_env) (a: expr) : res val :=
   | Ederef r ty =>
       constval ce r
   | Efield l f ty =>
-      match typeof l with
-      | Tstruct id _ =>
-          do co <- lookup_composite ce id;
-          do delta <- field_offset ce f (co_members co);
-          do v <- constval ce l;
+      do (delta, bf) <-
+        match typeof l with
+        | Tstruct id _ =>
+            do co <- lookup_composite ce id; field_offset ce f (co_members co)
+        | Tunion id _ =>
+            do co <- lookup_composite ce id; union_field_offset ce f (co_members co)
+        | _ =>
+            Error (msg "ill-typed field access")
+        end;
+      do v <- constval ce l;
+      match bf with
+      | Full =>
           OK (if Archi.ptr64
               then Val.addl v (Vlong (Int64.repr delta))
               else Val.add v (Vint (Int.repr delta)))
-      | Tunion id _ =>
-          constval ce l
-      | _ =>
-          Error(msg "ill-typed field access")
+      | Bits _ _ _ _ =>
+          Error(msg "taking the address of a bitfield")
       end
   | Eparen r tycast ty =>
       do v <- constval ce r; do_cast v (typeof r) tycast
@@ -138,6 +143,183 @@ Fixpoint constval (ce: composite_env) (a: expr) : res val :=
 Definition constval_cast (ce: composite_env) (a: expr) (ty: type): res val :=
   do v <- constval ce a; do_cast v (typeof a) ty.
 
+(** * Building and recording initialization data *)
+
+(** The following [state] type is the output of the translation of
+    initializers.  It contains the list of initialization data
+    generated so far, the corresponding position in bytes, and the
+    total size expected for the final initialization data, in bytes. *)
+
+Record state : Type := {
+  init: list init_data;      (**r reversed *)
+  curr: Z;                   (**r current position for head of [init] *)
+  total_size: Z              (**r total expected size *)
+}.
+
+(** A state [s] can also be viewed as a memory block.  The size of
+    the block is [s.(total_size)], it is initialized with zero bytes,
+    then filled with the initialization data [rev s.(init)] like
+    [Genv.store_init_data_list] does. *)
+
+Definition initial_state (sz: Z) : state :=
+  {| init := nil; curr := 0; total_size := sz |}.
+
+(** We now define abstract "store" operations that operate
+    directly on the state, but whose behavior mimic those of
+    storing in the corresponding memory block.  To initialize
+    bitfields, we also need an abstract "load" operation.
+    The operations are optimized for stores that occur at increasing
+    positions, like those that take place during initialization. *)
+
+(** Initialization from bytes *)
+
+Definition int_of_byte (b: byte) := Int.repr (Byte.unsigned b).
+
+Definition Init_byte (b: byte) := Init_int8 (int_of_byte b).
+
+(** Add a list of bytes to a reversed initialization data list. *)
+
+Fixpoint add_rev_bytes (l: list byte) (il: list init_data) :=
+  match l with
+  | nil => il
+  | b :: l => add_rev_bytes l (Init_byte b :: il)
+  end.
+
+(** Add [n] zero bytes to an initialization data list. *)
+
+Definition add_zeros (n: Z) (il: list init_data) :=
+  Z.iter n (fun l => Init_int8 Int.zero :: l) il.
+
+(** Make sure the [depth] positions at the top of [il] are bytes,
+    that is, [Init_int8] items.  Other numerical items are split
+    into bytes.  [Init_addrof] items cannot be split and result in
+    an error. *)
+
+Fixpoint normalize (il: list init_data) (depth: Z) : res (list init_data) :=
+  if zle depth 0 then OK il else
+    match il with
+    | nil =>
+        Error (msg "normalize: empty list")
+    | Init_int8 n :: il =>
+        do il' <- normalize il (depth - 1);
+        OK (Init_int8 n :: il')
+    | Init_int16 n :: il =>
+        do il' <- normalize il (depth - 2);
+        OK (add_rev_bytes (encode_int 2%nat (Int.unsigned n)) il')
+    | Init_int32 n :: il =>
+        do il' <- normalize il (depth - 4);
+        OK (add_rev_bytes (encode_int 4%nat (Int.unsigned n)) il')
+    | Init_int64 n :: il =>
+        do il' <- normalize il (depth - 8);
+        OK (add_rev_bytes (encode_int 8%nat (Int64.unsigned n)) il')
+    | Init_float32 f :: il =>
+        do il' <- normalize il (depth - 4);
+        OK (add_rev_bytes (encode_int 4%nat (Int.unsigned (Float32.to_bits f))) il')
+    | Init_float64 f :: il =>
+        do il' <- normalize il (depth - 8);
+        OK (add_rev_bytes (encode_int 8%nat (Int64.unsigned (Float.to_bits f))) il')
+    | Init_addrof _ _ :: il =>
+        Error (msg "normalize: Init_addrof")
+    | Init_space n :: il =>
+        let n := Z.max 0 n in
+        if zle n depth then
+          do il' <- normalize il (depth - n);
+          OK (add_zeros n il')
+        else
+          OK (add_zeros depth (Init_space (n - depth) :: il))
+    end.
+
+(** Split [il] into [depth] bytes and the initialization list that follows.
+    The bytes are returned reversed. *)
+
+Fixpoint decompose_rec (accu: list byte) (il: list init_data) (depth: Z) : res (list byte * list init_data) :=
+  if zle depth 0 then OK (accu, il) else
+    match il with
+    | Init_int8 n :: il => decompose_rec (Byte.repr (Int.unsigned n) :: accu) il (depth - 1)
+    | _ => Error (msg "decompose: wrong shape")
+    end.
+
+Definition decompose (il: list init_data) (depth: Z) : res (list byte * list init_data) :=
+  decompose_rec nil il depth.
+
+(** Decompose an initialization list in three parts:
+    [depth] bytes (reversed), [sz] bytes (reversed),
+    and the remainder of the initialization list. *)
+
+Definition trisection (il: list init_data) (depth sz: Z) : res (list byte * list byte * list init_data) :=
+  do il0 <- normalize il (depth + sz);
+  do (bytes1, il1) <- decompose il0 depth;
+  do (bytes2, il2) <- decompose il1 sz;
+  OK (bytes1, bytes2, il2).
+
+(** Graphically: [rev il] is equal to
+<<
+                 <---sz---><--depth-->
++----------------+---------+---------+
+|                |         |         |
++----------------+---------+---------+
+    rev il2         bytes2    bytes1
+>>
+*)
+
+(** Add padding if necessary so that position [pos] is within the state. *)
+
+Definition pad_to (s: state) (pos: Z) : state :=
+  if zle pos s.(curr)
+  then s
+  else {| init := Init_space (pos - s.(curr)) :: s.(init);
+          curr := pos;
+          total_size := s.(total_size) |}.
+
+(** Store the initialization data [i] at position [pos] in state [s]. *)
+
+Definition store_data (s: state) (pos: Z) (i: init_data) : res state :=
+  let sz := init_data_size i in
+  assertion (zle 0 pos && zle (pos + sz) s.(total_size));
+  if zle s.(curr) pos then
+    OK {| init := i :: (if zlt s.(curr) pos
+                        then Init_space (pos - s.(curr)) :: s.(init)
+                        else s.(init));
+          curr := pos + sz;
+          total_size := s.(total_size) |}
+  else
+    let s' := pad_to s (pos + sz) in
+    do x3 <- trisection s'.(init) (s'.(curr) - (pos + sz)) sz;
+    let '(bytes1, _, il2) := x3 in
+    OK {| init := add_rev_bytes bytes1 (i :: il2);
+          curr := s'.(curr);
+          total_size := s'.(total_size) |}.
+
+(** Store the integer [n] of size [isz] at position [pos] in state [s]. *)
+
+Definition init_data_for_carrier (isz: intsize) (n: int) :=
+  match isz with
+  | I8 | IBool => Init_int8 n
+  | I16 => Init_int16 n
+  | I32 => Init_int32 n
+  end.
+
+Definition store_int (s: state) (pos: Z) (isz: intsize) (n: int) : res state :=
+  store_data s pos (init_data_for_carrier isz n).
+
+(** Load the integer of size [isz] at position [pos] in state [s]. *)
+
+Definition load_int (s: state) (pos: Z) (isz: intsize) : res int :=
+  let chunk := chunk_for_carrier isz in
+  let sz := size_chunk chunk in
+  assertion (zle 0 pos && zle (pos + sz) s.(total_size));
+  let s' := pad_to s (pos + sz) in
+  do x3 <- trisection s'.(init) (s'.(curr) - (pos + sz)) sz;
+  let '(_, bytes2, _) := x3 in
+  OK (Int.repr (decode_int bytes2)).
+
+(** Extract the final initialization data from a state. *)
+
+Definition init_data_list_of_state (s: state) : res (list init_data) :=
+  assertion (zle s.(curr) s.(total_size));
+  let s' := pad_to s s.(total_size) in
+  OK (List.rev' s'.(init)).
+
 (** * Translation of initializers *)
 
 Inductive initializer :=
@@ -149,6 +331,11 @@ with initializer_list :=
   | Init_nil
   | Init_cons (i: initializer) (il: initializer_list).
 
+Definition length_initializer_list (il: initializer_list) :=
+  let fix length (accu: Z) (il: initializer_list) : Z :=
+    match il with Init_nil => accu | Init_cons _ il => length (Z.succ accu) il end
+  in length 0 il.
+
 (** Translate an initializing expression [a] for a scalar variable
   of type [ty].  Return the corresponding initialization datum. *)
 
@@ -170,69 +357,116 @@ Definition transl_init_single (ce: composite_env) (ty: type) (a: expr) : res ini
   | _, _ => Error (msg "type mismatch in initializer")
   end.
 
-(** Translate an initializer [i] for a variable of type [ty].
-  [transl_init ce ty i] returns the appropriate list of initialization data.
-  The intermediate functions [transl_init_rec], [transl_init_array]
-  and [transl_init_struct] append initialization data to the given
-  list [k], and build the list of initialization data in reverse order,
-  so as to remain tail-recursive. *)
+(** Initialize a bitfield [Bits sz sg p w] with expression [a]. *)
 
-Definition padding (frm to: Z) (k: list init_data) : list init_data :=
-  if zlt frm to then Init_space (to - frm) :: k else k.
+Definition transl_init_bitfield (ce: composite_env) (s: state)
+                                (ty: type) (sz: intsize) (p w: Z)
+                                (i: initializer) (pos: Z) : res state :=
+  match i with
+  | Init_single a =>
+      do v <- constval_cast ce a ty;
+      match v with
+      | Vint n =>
+          do c <- load_int s pos sz;
+          let c' := Int.bitfield_insert (first_bit sz p w) w c n in
+          store_int s pos sz c'
+      | Vundef =>
+          Error (msg "undefined operation in bitfield initializer")
+      | _ =>
+          Error (msg "type mismatch in bitfield initializer")
+      end
+  | _ =>
+      Error (msg "bitfield initialized by composite initializer")
+  end.
+
+(** Padding bitfields and bitfields with zero width are not initialized. *)
+
+Definition member_not_initialized (m: member) : bool :=
+  match m with
+  | Member_plain _ _ => false
+  | Member_bitfield _ _ _ _ w p => p || zle w 0
+  end.
 
-Fixpoint transl_init_rec (ce: composite_env) (ty: type) (i: initializer)
-                         (k: list init_data) {struct i} : res (list init_data) :=
+(** Translate an initializer [i] for a variable of type [ty]
+    and store the corresponding list of initialization data in state [s]
+    at position [pos].  Return the updated state. *)
+
+Fixpoint transl_init_rec (ce: composite_env) (s: state)
+                         (ty: type) (i: initializer) (pos: Z)
+                         {struct i} : res state :=
   match i, ty with
   | Init_single a, _ =>
-      do d <- transl_init_single ce ty a; OK (d :: k)
+      do d <- transl_init_single ce ty a; store_data s pos d
   | Init_array il, Tarray tyelt nelt _ =>
-      transl_init_array ce tyelt il (Z.max 0 nelt) k
+      assertion (zle (length_initializer_list il) (Z.max 0 nelt));
+      transl_init_array ce s tyelt il pos
   | Init_struct il, Tstruct id _ =>
       do co <- lookup_composite ce id;
       match co_su co with
-      | Struct => transl_init_struct ce ty (co_members co) il 0 k
+      | Struct => transl_init_struct ce s (co_members co) il pos 0
       | Union  => Error (MSG "struct/union mismatch on " :: CTX id :: nil)
       end
   | Init_union f i1, Tunion id _ =>
       do co <- lookup_composite ce id;
       match co_su co with
       | Struct => Error (MSG "union/struct mismatch on " :: CTX id :: nil)
-      | Union =>
-          do ty1 <- field_type f (co_members co);
-          do k1  <- transl_init_rec ce ty1 i1 k;
-          OK (padding (sizeof ce ty1) (sizeof ce ty) k1)
+      | Union =>  do ty1 <- field_type f (co_members co);
+                  do (delta, layout) <- union_field_offset ce f (co_members co);
+                  match layout with
+                  | Full =>
+                      transl_init_rec ce s ty1 i1 (pos + delta)
+                  | Bits sz sg p w =>
+                      transl_init_bitfield ce s ty1 sz p w i1 (pos + delta)
+                  end
       end
   | _, _ =>
       Error (msg "wrong type for compound initializer")
   end
 
-with transl_init_array (ce: composite_env) (ty: type) (il: initializer_list) (sz: Z)
-                       (k: list init_data) {struct il} : res (list init_data) :=
+with transl_init_array (ce: composite_env) (s: state)
+                       (tyelt: type) (il: initializer_list) (pos: Z)
+                       {struct il} : res state :=
   match il with
   | Init_nil =>
-      if zeq sz 0 then OK k
-      else if zle 0 sz then OK (Init_space (sz * sizeof ce ty) :: k)
-      else Error (msg "wrong number of elements in array initializer")
+      OK s
   | Init_cons i1 il' =>
-      do k1 <- transl_init_rec ce ty i1 k;
-      transl_init_array ce ty il' (sz - 1) k1
+      do s1 <- transl_init_rec ce s tyelt i1 pos;
+      transl_init_array ce s1 tyelt il' (pos + sizeof ce tyelt)
   end
 
-with transl_init_struct (ce: composite_env) (ty: type)
-                        (fl: members) (il: initializer_list) (pos: Z)
-                        (k: list init_data)
-                        {struct il} : res (list init_data) :=
-  match il, fl with
-  | Init_nil, nil =>
-      OK (padding pos (sizeof ce ty) k)
-  | Init_cons i1 il', (_, ty1) :: fl' =>
-      let pos1 := align pos (alignof ce ty1) in
-      do k1 <- transl_init_rec ce ty1 i1 (padding pos pos1 k);
-      transl_init_struct ce ty fl' il' (pos1 + sizeof ce ty1) k1
-  | _, _ =>
-      Error (msg "wrong number of elements in struct initializer")
+with transl_init_struct (ce: composite_env) (s: state)
+                        (ms: members) (il: initializer_list)
+                        (base: Z) (pos: Z)
+                        {struct il} : res state :=
+  match il with
+  | Init_nil =>
+      OK s
+  | Init_cons i1 il' =>
+      let fix init (ms: members) (pos: Z) {struct ms} : res state :=
+        match ms with
+        | nil =>
+            Error (msg "too many elements in struct initializer")
+        | m :: ms' =>
+            if member_not_initialized m then
+              init ms' (next_field ce pos m)
+            else
+              do (delta, layout) <- layout_field ce pos m;
+              do s1 <-
+                match layout with
+                | Full =>
+                    transl_init_rec ce s (type_member m) i1 (base + delta)
+                | Bits sz sg p w =>
+                    transl_init_bitfield ce s (type_member m) sz p w i1 (base + delta)
+                end;
+                transl_init_struct ce s1 ms' il' base (next_field ce pos m)
+         end in
+      init ms pos
   end.
 
+(** The entry point. *)
+
 Definition transl_init (ce: composite_env) (ty: type) (i: initializer)
                        : res (list init_data) :=
-  do k <- transl_init_rec ce ty i nil; OK (List.rev' k).
+  let s0 := initial_state (sizeof ce ty) in
+  do s1 <- transl_init_rec ce s0 ty i 0;
+  init_data_list_of_state s1.
diff --git a/cfrontend/Initializersproof.v b/cfrontend/Initializersproof.v
index 10ccbeff..00f7e331 100644
--- a/cfrontend/Initializersproof.v
+++ b/cfrontend/Initializersproof.v
@@ -12,7 +12,7 @@
 
 (** Compile-time evaluation of initializers for global C variables. *)
 
-Require Import Coqlib Maps.
+Require Import Zwf Coqlib Maps.
 Require Import Errors Integers Floats Values AST Memory Globalenvs Events Smallstep.
 Require Import Ctypes Cop Csyntax Csem.
 Require Import Initializers.
@@ -30,7 +30,7 @@ Variable ge: genv.
 
 Fixpoint simple (a: expr) : Prop :=
   match a with
-  | Eloc _ _ _ => True
+  | Eloc _ _ _ _ => True
   | Evar _ _ => True
   | Ederef r _ => simple r
   | Efield l1 _ _ => simple l1
@@ -65,38 +65,38 @@ Section SIMPLE_EXPRS.
 Variable e: env.
 Variable m: mem.
 
-Inductive eval_simple_lvalue: expr -> block -> ptrofs -> Prop :=
-  | esl_loc: forall b ofs ty,
-      eval_simple_lvalue (Eloc b ofs ty) b ofs
+Inductive eval_simple_lvalue: expr -> block -> ptrofs -> bitfield -> Prop :=
+  | esl_loc: forall b ofs bf ty,
+      eval_simple_lvalue (Eloc b ofs bf ty) b ofs bf
   | esl_var_local: forall x ty b,
       e!x = Some(b, ty) ->
-      eval_simple_lvalue (Evar x ty) b Ptrofs.zero
+      eval_simple_lvalue (Evar x ty) b Ptrofs.zero Full
   | esl_var_global: forall x ty b,
       e!x = None ->
       Genv.find_symbol ge x = Some b ->
-      eval_simple_lvalue (Evar x ty) b Ptrofs.zero
+      eval_simple_lvalue (Evar x ty) b Ptrofs.zero Full
   | esl_deref: forall r ty b ofs,
       eval_simple_rvalue r (Vptr b ofs) ->
-      eval_simple_lvalue (Ederef r ty) b ofs
-  | esl_field_struct: forall r f ty b ofs id co a delta,
+      eval_simple_lvalue (Ederef r ty) b ofs Full
+  | esl_field_struct: forall r f ty b ofs id co a delta bf,
       eval_simple_rvalue r (Vptr b ofs) ->
-      typeof r = Tstruct id a -> ge.(genv_cenv)!id = Some co -> field_offset ge f (co_members co) = OK delta ->
-      eval_simple_lvalue (Efield r f ty) b (Ptrofs.add ofs (Ptrofs.repr delta))
-  | esl_field_union: forall r f ty b ofs id a,
+      typeof r = Tstruct id a -> ge.(genv_cenv)!id = Some co -> field_offset ge f (co_members co) = OK (delta, bf) ->
+      eval_simple_lvalue (Efield r f ty) b (Ptrofs.add ofs (Ptrofs.repr delta)) bf
+  | esl_field_union: forall r f ty b ofs id co a delta bf,
       eval_simple_rvalue r (Vptr b ofs) ->
-      typeof r = Tunion id a ->
-      eval_simple_lvalue (Efield r f ty) b ofs
+      typeof r = Tunion id a -> ge.(genv_cenv)!id = Some co -> union_field_offset ge f (co_members co) = OK (delta, bf) ->
+      eval_simple_lvalue (Efield r f ty) b (Ptrofs.add ofs (Ptrofs.repr delta)) bf
 
 with eval_simple_rvalue: expr -> val -> Prop :=
   | esr_val: forall v ty,
       eval_simple_rvalue (Eval v ty) v
-  | esr_rvalof: forall b ofs l ty v,
-      eval_simple_lvalue l b ofs ->
+  | esr_rvalof: forall b ofs bf l ty v,
+      eval_simple_lvalue l b ofs bf ->
       ty = typeof l ->
-      deref_loc ge ty m b ofs E0 v ->
+      deref_loc ge ty m b ofs bf E0 v ->
       eval_simple_rvalue (Evalof l ty) v
   | esr_addrof: forall b ofs l ty,
-      eval_simple_lvalue l b ofs ->
+      eval_simple_lvalue l b ofs Full ->
       eval_simple_rvalue (Eaddrof l ty) (Vptr b ofs)
   | esr_unop: forall op r1 ty v1 v,
       eval_simple_rvalue r1 v1 ->
@@ -153,7 +153,7 @@ End SIMPLE_EXPRS.
 Definition compat_eval (k: kind) (e: env) (a a': expr) (m: mem) : Prop :=
   typeof a = typeof a' /\
   match k with
-  | LV => forall b ofs, eval_simple_lvalue e m a' b ofs -> eval_simple_lvalue e m a b ofs
+  | LV => forall b ofs bf, eval_simple_lvalue e m a' b ofs bf -> eval_simple_lvalue e m a b ofs bf
   | RV => forall v, eval_simple_rvalue e m a' v -> eval_simple_rvalue e m a v
   end.
 
@@ -167,7 +167,7 @@ Lemma lred_compat:
   forall e l m l' m', lred ge e l m l' m' ->
   m = m' /\ compat_eval LV e l l' m.
 Proof.
-  induction 1; simpl; split; auto; split; auto; intros bx ofsx EV; inv EV.
+  induction 1; simpl; split; auto; split; auto; intros bx ofsx bf' EV; inv EV.
   apply esl_var_local; auto.
   apply esl_var_global; auto.
   constructor. constructor.
@@ -365,6 +365,22 @@ Proof.
   intros. eapply bool_val_inj; eauto. intros. rewrite mem_empty_not_weak_valid_pointer in H2; discriminate.
 Qed.
 
+Lemma add_offset_match:
+  forall v b ofs delta,
+  Val.inject inj v (Vptr b ofs) ->
+  Val.inject inj
+    (if Archi.ptr64
+     then Val.addl v (Vlong (Int64.repr delta))
+     else Val.add v (Vint (Int.repr delta)))
+    (Vptr b (Ptrofs.add ofs (Ptrofs.repr delta))).
+Proof.
+  intros. inv H.
+- rewrite Ptrofs.add_assoc. rewrite (Ptrofs.add_commut (Ptrofs.repr delta0)).
+  unfold Val.addl, Val.add; destruct Archi.ptr64 eqn:SF;
+  econstructor; eauto; rewrite ! Ptrofs.add_assoc; f_equal; f_equal; symmetry; auto with ptrofs.
+- unfold Val.addl, Val.add; destruct Archi.ptr64; auto.
+Qed.
+
 (** Soundness of [constval] with respect to the big-step semantics *)
 
 Lemma constval_rvalue:
@@ -374,20 +390,22 @@ Lemma constval_rvalue:
   constval ge a = OK v' ->
   Val.inject inj v' v
 with constval_lvalue:
-  forall m a b ofs,
-  eval_simple_lvalue empty_env m a b ofs ->
+  forall m a b ofs bf,
+  eval_simple_lvalue empty_env m a b ofs bf ->
   forall v',
   constval ge a = OK v' ->
-  Val.inject inj v' (Vptr b ofs).
+  bf = Full /\ Val.inject inj v' (Vptr b ofs).
 Proof.
   (* rvalue *)
   induction 1; intros vres CV; simpl in CV; try (monadInv CV).
   (* val *)
   destruct v; monadInv CV; constructor.
   (* rval *)
-  inv H1; rewrite H2 in CV; try congruence. eauto. eauto.
+  assert (constval ge l = OK vres) by (destruct (access_mode ty); congruence).
+  exploit constval_lvalue; eauto. intros [A B]. subst bf.
+  inv H1; rewrite H3 in CV; congruence.
   (* addrof *)
-  eauto.
+  eapply constval_lvalue; eauto.
   (* unop *)
   destruct (sem_unary_operation op x (typeof r1) Mem.empty) as [v1'|] eqn:E; inv EQ0.
   exploit (sem_unary_operation_inj inj Mem.empty m).
@@ -438,28 +456,31 @@ Proof.
   (* lvalue *)
   induction 1; intros v' CV; simpl in CV; try (monadInv CV).
   (* var local *)
-  unfold empty_env in H. rewrite PTree.gempty in H. congruence.
+  split; auto. unfold empty_env in H. rewrite PTree.gempty in H. congruence.
   (* var_global *)
-  econstructor. unfold inj. rewrite H0. eauto. auto.
+  split; auto. econstructor. unfold inj. rewrite H0. eauto. auto.
   (* deref *)
-  eauto.
+  split; eauto.
   (* field struct *)
-  rewrite H0 in CV. monadInv CV. unfold lookup_composite in EQ; rewrite H1 in EQ; monadInv EQ.
-  exploit constval_rvalue; eauto. intro MV. inv MV.
-  replace x0 with delta by congruence. rewrite Ptrofs.add_assoc. rewrite (Ptrofs.add_commut (Ptrofs.repr delta0)).
-  simpl; destruct Archi.ptr64 eqn:SF;
-  econstructor; eauto; rewrite ! Ptrofs.add_assoc; f_equal; f_equal; symmetry; auto with ptrofs.
-  destruct Archi.ptr64; auto.
+  rewrite H0 in EQ. monadInv EQ. destruct x0; monadInv EQ2.
+  unfold lookup_composite in EQ0; rewrite H1 in EQ0; monadInv EQ0.
+  exploit constval_rvalue; eauto. intro MV.
+  split. congruence.
+  replace x with delta by congruence.
+  apply (add_offset_match _ _ _ _ MV).
   (* field union *)
-  rewrite H0 in CV. eauto.
+  rewrite H0 in EQ. monadInv EQ. destruct x0; monadInv EQ2.
+  unfold lookup_composite in EQ0; rewrite H1 in EQ0; monadInv EQ0.
+  exploit constval_rvalue; eauto. intro MV.
+  split. congruence.
+  replace x with delta by congruence. 
+  apply (add_offset_match _ _ _ _ MV).
 Qed.
 
 Lemma constval_simple:
   forall a v, constval ge a = OK v -> simple a.
 Proof.
   induction a; simpl; intros vx CV; try (monadInv CV); eauto.
-  destruct (typeof a); discriminate || eauto.
-  monadInv CV. eauto.
   destruct (access_mode ty); discriminate || eauto.
   intuition eauto.
 Qed.
@@ -476,331 +497,757 @@ Proof.
   intros [A [B C]]. intuition. eapply constval_rvalue; eauto.
 Qed.
 
-(** * Relational specification of the translation of initializers *)
-
-Definition tr_padding (frm to: Z) : list init_data :=
-  if zlt frm to then Init_space (to - frm) :: nil else nil.
-
-Inductive tr_init: type -> initializer -> list init_data -> Prop :=
-  | tr_init_sgl: forall ty a d,
-      transl_init_single ge ty a = OK d ->
-      tr_init ty (Init_single a) (d :: nil)
-  | tr_init_arr: forall tyelt nelt attr il d,
-      tr_init_array tyelt il (Z.max 0 nelt) d ->
-      tr_init (Tarray tyelt nelt attr) (Init_array il) d
-  | tr_init_str: forall id attr il co d,
-      lookup_composite ge id = OK co -> co_su co = Struct ->
-      tr_init_struct (Tstruct id attr) (co_members co) il 0 d ->
-      tr_init (Tstruct id attr) (Init_struct il) d
-  | tr_init_uni: forall id attr f i1 co ty1 d,
-      lookup_composite ge id = OK co -> co_su co = Union -> field_type f (co_members co) = OK ty1 ->
-      tr_init ty1 i1 d ->
-      tr_init (Tunion id attr) (Init_union f i1)
-              (d ++ tr_padding (sizeof ge ty1) (sizeof ge (Tunion id attr)))
-
-with tr_init_array: type -> initializer_list -> Z -> list init_data -> Prop :=
-  | tr_init_array_nil_0: forall ty,
-      tr_init_array ty Init_nil 0 nil
-  | tr_init_array_nil_pos: forall ty sz,
-      0 < sz ->
-      tr_init_array ty Init_nil sz (Init_space (sz * sizeof ge ty) :: nil)
-  | tr_init_array_cons: forall ty i il sz d1 d2,
-      tr_init ty i d1 -> tr_init_array ty il (sz - 1) d2 ->
-      tr_init_array ty (Init_cons i il) sz (d1 ++ d2)
-
-with tr_init_struct: type -> members -> initializer_list -> Z -> list init_data -> Prop :=
-  | tr_init_struct_nil: forall ty pos,
-      tr_init_struct ty nil Init_nil pos (tr_padding pos (sizeof ge ty))
-  | tr_init_struct_cons: forall ty f1 ty1 fl i1 il pos d1 d2,
-      let pos1 := align pos (alignof ge ty1) in
-      tr_init ty1 i1 d1 ->
-      tr_init_struct ty fl il (pos1 + sizeof ge ty1) d2 ->
-      tr_init_struct ty ((f1, ty1) :: fl) (Init_cons i1 il)
-                     pos (tr_padding pos pos1 ++ d1 ++ d2).
-
-Lemma transl_padding_spec:
-  forall frm to k, padding frm to k = rev (tr_padding frm to) ++ k.
-Proof.
-  unfold padding, tr_padding; intros. 
-  destruct (zlt frm to); auto.
-Qed.
-
-Lemma transl_init_rec_spec:
-  forall i ty k res,
-  transl_init_rec ge ty i k = OK res ->
-  exists d, tr_init ty i d /\ res = rev d ++ k
-
-with transl_init_array_spec:
-  forall il ty sz k res,
-  transl_init_array ge ty il sz k = OK res ->
-  exists d, tr_init_array ty il sz d /\ res = rev d ++ k
-
-with transl_init_struct_spec:
-  forall il ty fl pos k res,
-  transl_init_struct ge ty fl il pos k = OK res ->
-  exists d, tr_init_struct ty fl il pos d /\ res = rev d ++ k.
-
-Proof.
-Local Opaque sizeof.
-- destruct i; intros until res; intros TR; simpl in TR.
-+ monadInv TR. exists (x :: nil); split; auto. constructor; auto.
-+ destruct ty; try discriminate.
-  destruct (transl_init_array_spec _ _ _ _ _ TR) as (d & A & B).
-  exists d; split; auto. constructor; auto.
-+ destruct ty; try discriminate. monadInv TR. destruct (co_su x) eqn:SU; try discriminate.
-  destruct (transl_init_struct_spec _ _ _ _ _ _ EQ0) as (d & A & B).
-  exists d; split; auto. econstructor; eauto.
-+ destruct ty; try discriminate.
-  monadInv TR. destruct (co_su x) eqn:SU; monadInv EQ0.
-  destruct (transl_init_rec_spec _ _ _ _ EQ0) as (d & A & B).
-  exists (d ++ tr_padding (sizeof ge x0) (sizeof ge (Tunion i0 a))); split.
-  econstructor; eauto.
-  rewrite rev_app_distr, app_ass, B. apply transl_padding_spec. 
-
-- destruct il; intros until res; intros TR; simpl in TR.
-+ destruct (zeq sz 0). 
-  inv TR. exists (@nil init_data); split; auto. constructor.
-  destruct (zle 0 sz).
-  inv TR. econstructor; split. constructor. lia. auto.
-  discriminate.
-+ monadInv TR. 
-  destruct (transl_init_rec_spec _ _ _ _ EQ) as (d1 & A1 & B1).
-  destruct (transl_init_array_spec _ _ _ _ _ EQ0) as (d2 & A2 & B2).
-  exists (d1 ++ d2); split. econstructor; eauto. 
-  subst res x. rewrite rev_app_distr, app_ass. auto.
+(** * Correctness of operations over the initialization state *)
+
+(** ** Properties of the in-memory bytes denoted by initialization data *)
+
+Local Notation boid := (Genv.bytes_of_init_data (genv_genv ge)).
+Local Notation boidl := (Genv.bytes_of_init_data_list (genv_genv ge)).
+
+Lemma boidl_app: forall il2 il1,
+  boidl (il1 ++ il2) = boidl il1 ++ boidl il2.
+Proof.
+  induction il1 as [ | il il1]; simpl. auto. rewrite app_ass. f_equal; auto.
+Qed.
+
+Corollary boidl_rev_cons: forall i il,
+  boidl (rev il ++ i :: nil) = boidl (rev il) ++ boid i.
+Proof.
+  intros. rewrite boidl_app. simpl. rewrite <- app_nil_end. auto.
+Qed. 
+
+Definition byte_of_int (n: int) := Byte.repr (Int.unsigned n).
+
+Lemma byte_of_int_of_byte: forall b, byte_of_int (int_of_byte b) = b.
+Proof.
+  intros. unfold int_of_byte, byte_of_int.
+  rewrite Int.unsigned_repr, Byte.repr_unsigned. auto.
+  assert(Byte.max_unsigned < Int.max_unsigned) by reflexivity.
+  generalize (Byte.unsigned_range_2 b). lia.
+Qed.
+
+Lemma inj_bytes_1: forall n,
+  inj_bytes (encode_int 1 n) = Byte (Byte.repr n) :: nil.
+Proof.
+  intros. unfold encode_int, bytes_of_int, rev_if_be. destruct Archi.big_endian; auto.
+Qed.
+
+Lemma inj_bytes_byte: forall b,
+  inj_bytes (encode_int 1 (Int.unsigned (int_of_byte b))) = Byte b :: nil.
+Proof.
+  intros. rewrite inj_bytes_1. do 2 f_equal. apply byte_of_int_of_byte.
+Qed.
+
+Lemma boidl_init_ints8: forall l,
+  boidl (map Init_int8 l) = inj_bytes (map byte_of_int l).
+Proof.
+  induction l as [ | i l]; simpl. auto. rewrite inj_bytes_1; simpl. f_equal; auto.
+Qed.
+
+Lemma boidl_init_bytes: forall l,
+  boidl (map Init_byte l) = inj_bytes l.
+Proof.
+  induction l as [ | b l]; simpl. auto. rewrite inj_bytes_byte, IHl. auto.
+Qed.
+
+Lemma boidl_ints8: forall i n,
+  boidl (repeat (Init_int8 i) n) = repeat (Byte (byte_of_int i)) n.
+Proof.
+  induction n; simpl. auto. rewrite inj_bytes_1. simpl; f_equal; auto.
+Qed.
+
+(** ** Properties of operations over list of initialization data *)
+
+Lemma add_rev_bytes_spec: forall l il,
+  add_rev_bytes l il = List.map Init_byte (List.rev l) ++ il.
+Proof.
+  induction l as [ | b l]; intros; simpl.
+- auto.
+- rewrite IHl. rewrite map_app. simpl. rewrite app_ass. auto.
+Qed.
+
+Lemma add_rev_bytes_spec': forall l il,
+  List.rev (add_rev_bytes l il) = List.rev il ++ List.map Init_byte l.
+Proof.
+  intros. rewrite add_rev_bytes_spec. rewrite rev_app_distr, map_rev, rev_involutive. auto.
+Qed.
+
+Lemma add_zeros_spec: forall n il,
+  0 <= n ->
+  add_zeros n il = List.repeat (Init_int8 Int.zero) (Z.to_nat n) ++ il.
+Proof.
+  intros.
+  unfold add_zeros; rewrite iter_nat_of_Z by auto; rewrite Zabs2Nat.abs_nat_nonneg by auto.
+  induction (Z.to_nat n); simpl. auto. f_equal; auto.
+Qed.
+
+Lemma decompose_spec: forall il depth bl il',
+  decompose il depth = OK (bl, il') ->
+  exists nl, il = List.map Init_int8 nl ++ il'
+          /\ bl = List.map byte_of_int (rev nl)
+          /\ List.length nl = Z.to_nat depth.
+Proof.
+  assert (REC: forall il accu depth bl il',
+               decompose_rec accu il depth = OK (bl, il') ->
+               exists nl, il = List.map Init_int8 nl ++ il'
+                       /\ bl = List.map byte_of_int (rev nl) ++ accu
+                       /\ List.length nl = Z.to_nat depth).
+  { induction il as [ | i il ]; intros until il'; intros D; simpl in D.
+  - destruct (zle depth 0); inv D.
+    exists (@nil int); simpl. rewrite Z_to_nat_neg by auto. auto.
+  - destruct (zle depth 0). 
+    + inv D. exists (@nil int); simpl. rewrite Z_to_nat_neg by auto. auto.
+    + destruct i; try discriminate.
+      apply IHil in D; destruct D as (nl & P & Q & R).
+      exists (i :: nl); simpl; split. congruence. split.
+      rewrite map_app. simpl. rewrite app_ass. exact Q.
+      rewrite R, <- Z2Nat.inj_succ by lia. f_equal; lia.
+  }
+  intros. apply REC in H. destruct H as (nl & P & Q & R). rewrite app_nil_r in Q.
+  exists nl; auto.
+Qed.
+
+Lemma list_repeat_app: forall (A: Type) (a: A) n2 n1,
+  List.repeat a n1 ++ List.repeat a n2 = List.repeat a (n1 + n2)%nat.
+Proof.
+  induction n1; simpl; congruence.
+Qed.
+
+Lemma list_rev_repeat: forall (A: Type) (a: A) n,
+  rev (List.repeat a n) = List.repeat a n.
+Proof.
+  induction n; simpl. auto. rewrite IHn. change (a :: nil) with (repeat a 1%nat).
+  rewrite list_repeat_app. rewrite Nat.add_comm. auto. 
+Qed.
+
+Lemma normalize_boidl: forall il depth il',
+  normalize il depth = OK il' ->
+  boidl (rev il') = boidl (rev il).
+Proof.
+  induction il as [ | i il]; simpl; intros depth il' AT.
+- destruct (zle depth 0); inv AT. auto.
+- destruct (zle depth 0). inv AT. auto.
+  destruct i;
+  try (monadInv AT; simpl;
+       rewrite ? add_rev_bytes_spec', ? boidl_rev_cons, ? boidl_app, ? boidl_init_bytes;
+       erewrite IHil by eauto; reflexivity).
+  set (n := Z.max 0 z) in *. destruct (zle n depth); monadInv AT.
+  + rewrite add_zeros_spec, rev_app_distr, ! boidl_app by lia.
+    erewrite IHil by eauto. f_equal.
+    rewrite list_rev_repeat. simpl. rewrite app_nil_r, boidl_ints8.
+    f_equal. unfold n. apply Z.max_case_strong; intros; auto. rewrite ! Z_to_nat_neg by lia. auto.
+  + rewrite add_zeros_spec, rev_app_distr, !boidl_app by lia.
+    simpl. rewrite boidl_rev_cons, list_rev_repeat. simpl.
+    rewrite app_ass, app_nil_r, !boidl_ints8. f_equal.
+    rewrite list_repeat_app. f_equal. rewrite <- Z2Nat.inj_add by lia.
+    unfold n. apply Z.max_case_strong; intros; f_equal; lia.
+Qed.
+
+Lemma trisection_boidl: forall il depth sz bytes1 bytes2 il',
+  trisection il depth sz = OK (bytes1, bytes2, il') ->
+  boidl (rev il) = boidl (rev il') ++ inj_bytes bytes2 ++ inj_bytes bytes1
+  /\ length bytes1 = Z.to_nat depth
+  /\ length bytes2 = Z.to_nat sz.
+Proof.
+  unfold trisection; intros. monadInv H.
+  apply normalize_boidl in EQ. rewrite <- EQ.
+  apply decompose_spec in EQ1. destruct EQ1 as (nl1 & A1 & B1 & C1).
+  apply decompose_spec in EQ0. destruct EQ0 as (nl2 & A2 & B2 & C2).
+  split.
+- rewrite A1, A2, !rev_app_distr, !boidl_app, app_ass.
+  rewrite <- !map_rev, !boidl_init_ints8. rewrite <- B1, <- B2. auto.
+- rewrite B1, B2, !map_length, !rev_length. auto.
+Qed. 
+
+Lemma store_init_data_loadbytes:
+  forall m b p i m',
+  Genv.store_init_data ge m b p i = Some m' ->
+  match i with Init_space _ => False | _ => True end ->
+  Mem.loadbytes m' b p (init_data_size i) = Some (boid i).
+Proof.
+  intros; destruct i; simpl in H; try apply (Mem.loadbytes_store_same _ _ _ _ _ _ H).
+- contradiction.
+- rewrite Genv.init_data_size_addrof. simpl.
+  destruct (Genv.find_symbol ge i) as [b'|]; try discriminate.
+  rewrite (Mem.loadbytes_store_same _ _ _ _ _ _ H).
+  unfold encode_val, Mptr; destruct Archi.ptr64; reflexivity.
+Qed.
+
+(** ** Validity and size of initialization data *)
+
+Definition idvalid (i: init_data) : Prop :=
+  match i with
+  | Init_addrof symb ofs => exists b, Genv.find_symbol ge symb = Some b
+  | _ => True
+  end.
+
+Fixpoint idlvalid (p: Z) (il: list init_data) {struct il} : Prop :=
+  match il with
+  | nil => True
+  | i1 :: il =>
+        (Genv.init_data_alignment i1 | p)
+     /\ idvalid i1
+     /\ idlvalid (p + init_data_size i1) il
+  end.
+
+Lemma idlvalid_app: forall l2 l1 pos,
+  idlvalid pos (l1 ++ l2) <-> idlvalid pos l1 /\ idlvalid (pos + init_data_list_size l1) l2.
+Proof.
+  induction l1 as [ | d l1]; intros; simpl.
+- rewrite Z.add_0_r; tauto.
+- rewrite IHl1. rewrite Z.add_assoc. tauto.
+Qed.
+
+Lemma add_rev_bytes_valid: forall il bl,
+  idlvalid 0 (rev il) -> idlvalid 0 (rev (add_rev_bytes bl il)).
+Proof.
+  intros. rewrite add_rev_bytes_spec, rev_app_distr, idlvalid_app. split; auto.
+  generalize (rev bl) (0 + init_data_list_size (rev il)). induction l; simpl; intros.
+  auto.
+  rewrite idlvalid_app; split; auto. simpl. auto using Z.divide_1_l.
+Qed.
+
+Lemma add_zeros_valid: forall il n,
+  0 <= n -> idlvalid 0 (rev il) -> idlvalid 0 (rev (add_zeros n il)).
+Proof.
+  intros. rewrite add_zeros_spec, rev_app_distr, idlvalid_app by auto.
+  split; auto.
+  generalize (Z.to_nat n) (0 + init_data_list_size (rev il)). induction n0; simpl; intros.
+  auto.
+  rewrite idlvalid_app; split; auto. simpl. auto using Z.divide_1_l.
+Qed.
 
-- destruct il; intros until res; intros TR; simpl in TR.
-+ destruct fl; inv TR. econstructor; split. constructor. apply transl_padding_spec.
-+ destruct fl as [ | [f1 ty1] fl ]; monadInv TR.
-  destruct (transl_init_rec_spec _ _ _ _ EQ) as (d1 & A1 & B1).
-  destruct (transl_init_struct_spec _ _ _ _ _ _ EQ0) as (d2 & A2 & B2).
-  exists (tr_padding pos (align pos (alignof ge ty1)) ++ d1 ++ d2); split.
-  econstructor; eauto.
-  rewrite ! rev_app_distr. subst res x. rewrite ! app_ass. rewrite transl_padding_spec. auto.
+Lemma normalize_valid: forall il depth il',
+  normalize il depth = OK il' -> idlvalid 0 (rev il) -> idlvalid 0 (rev il').
+Proof.
+  induction il as [ | i il]; simpl; intros.
+- destruct (zle depth 0); inv H. simpl. tauto.
+- destruct (zle depth 0). inv H. auto.
+  rewrite idlvalid_app in H0; destruct H0.
+  destruct i; try (monadInv H; apply add_rev_bytes_valid; eapply IHil; eauto).
+  + monadInv H. simpl. rewrite idlvalid_app; split. eauto. simpl; auto using Z.divide_1_l. 
+  + destruct (zle (Z.max 0 z)); monadInv H.
+    * apply add_zeros_valid. lia. eauto.
+    * apply add_zeros_valid. lia. simpl. rewrite idlvalid_app; split. auto. simpl; auto using Z.divide_1_l.
 Qed.
 
-Theorem transl_init_spec:
-  forall ty i d, transl_init ge ty i = OK d -> tr_init ty i d.
+Lemma trisection_valid: forall il depth sz bytes1 bytes2 il',
+  trisection il depth sz = OK (bytes1, bytes2, il') ->
+  idlvalid 0 (rev il) ->
+  idlvalid 0 (rev il').
 Proof.
-  unfold transl_init; intros. monadInv H. 
-  exploit transl_init_rec_spec; eauto. intros (d & A & B). 
-  subst x. unfold rev'; rewrite <- rev_alt. 
-  rewrite rev_app_distr; simpl. rewrite rev_involutive. auto.
+  unfold trisection; intros. monadInv H.
+  apply decompose_spec in EQ1. destruct EQ1 as (nl1 & A1 & B1 & C1).
+  apply decompose_spec in EQ0. destruct EQ0 as (nl2 & A2 & B2 & C2).
+  exploit normalize_valid; eauto. rewrite A1, A2, !rev_app_distr, !idlvalid_app.
+  tauto.
+Qed.
+
+Lemma init_data_size_boid: forall i,
+  init_data_size i = Z.of_nat (length (boid i)).
+Proof.
+  intros. destruct i; simpl; rewrite ?length_inj_bytes, ?encode_int_length; auto.
+- rewrite repeat_length. rewrite Z_to_nat_max; auto.
+- destruct (Genv.find_symbol ge i), Archi.ptr64; reflexivity.
+Qed.
+
+Lemma init_data_list_size_boidl: forall il,
+  init_data_list_size il = Z.of_nat (length (boidl il)).
+Proof.
+  induction il as [ | i il]; simpl. auto. 
+  rewrite app_length, init_data_size_boid. lia.
+Qed.
+
+Lemma init_data_list_size_app: forall l1 l2,
+  init_data_list_size (l1 ++ l2) = init_data_list_size l1 + init_data_list_size l2.
+Proof.
+  induction l1 as [ | i l1]; intros; simpl. auto. rewrite IHl1; lia.
+Qed.
+
+(** ** Memory areas that are initialized to zeros *)
+
+Definition reads_as_zeros (m: mem) (b: block) (from to: Z) : Prop :=
+  forall i, from <= i < to -> Mem.loadbytes m b i 1 = Some (Byte Byte.zero :: nil).
+
+Lemma reads_as_zeros_mono: forall m b from1 from2 to1 to2,
+  reads_as_zeros m b from1 to1 -> from1 <= from2 -> to2 <= to1 ->
+  reads_as_zeros m b from2 to2.
+Proof.
+  intros; red; intros. apply H; lia.
+Qed.
+
+Remark reads_as_zeros_unchanged:
+  forall (P: block -> Z -> Prop) m b from to m',
+  reads_as_zeros m b from to ->
+  Mem.unchanged_on P m m' ->
+  (forall i, from <= i < to -> P b i) ->
+  reads_as_zeros m' b from to.
+Proof.
+  intros; red; intros. eapply Mem.loadbytes_unchanged_on; eauto.
+  intros; apply H1. lia.
+Qed.
+
+Lemma reads_as_zeros_loadbytes: forall m b from to,
+  reads_as_zeros m b from to ->
+  forall len pos, from <= pos -> pos + len <= to -> 0 <= len ->
+  Mem.loadbytes m b pos len = Some (repeat (Byte Byte.zero) (Z.to_nat len)).
+Proof.
+  intros until to; intros RZ.
+  induction len using (well_founded_induction (Zwf_well_founded 0)).
+  intros. destruct (zeq len 0).
+- subst len. rewrite Mem.loadbytes_empty by lia. auto.
+- replace (Z.to_nat len) with (S (Z.to_nat (len - 1))).
+  change (repeat (Byte Byte.zero) (S (Z.to_nat (len - 1))))
+    with ((Byte Byte.zero :: nil) ++ repeat (Byte Byte.zero) (Z.to_nat (len - 1))).
+  replace len with (1 + (len - 1)) at 1 by lia. 
+  apply Mem.loadbytes_concat; try lia.
+  + apply RZ. lia.
+  + apply H; unfold Zwf; lia.
+  + rewrite <- Z2Nat.inj_succ by lia. f_equal; lia. 
+Qed.
+
+Lemma reads_as_zeros_equiv: forall m b from to,
+  reads_as_zeros m b from to <-> Genv.readbytes_as_zero m b from (to - from).
+Proof.
+  intros; split; intros.
+- red; intros. set (len := Z.of_nat n).
+  replace n with (Z.to_nat len) by apply Nat2Z.id.
+  eapply reads_as_zeros_loadbytes; eauto. lia. lia.
+- red; intros. red in H. apply (H i 1%nat). lia. lia.
+Qed.
+
+(** ** Semantic correctness of state operations *)
+
+(** Semantic interpretation of states. *)
+
+Record match_state (s: state) (m: mem) (b: block) : Prop := {
+  match_range:
+    0 <= s.(curr) <= s.(total_size);
+  match_contents:
+    Mem.loadbytes m b 0 s.(curr) = Some (boidl (rev s.(init)));
+  match_valid:
+    idlvalid 0 (rev s.(init));
+  match_uninitialized:
+    reads_as_zeros m b s.(curr) s.(total_size)
+}.
+
+Lemma match_size: forall s m b,
+  match_state s m b ->
+  init_data_list_size (rev s.(init)) = s.(curr).
+Proof.
+  intros. rewrite init_data_list_size_boidl.
+  erewrite Mem.loadbytes_length by (eapply match_contents; eauto).
+  apply Z2Nat.id. eapply match_range; eauto.
+Qed.
+
+Lemma curr_pad_to: forall s pos,
+  curr s <= curr (pad_to s pos) /\ pos <= curr (pad_to s pos).
+Proof.
+  unfold pad_to; intros. destruct (zle pos (curr s)); simpl; lia.
+Qed.
+
+Lemma total_size_pad_to: forall s pos,
+  total_size (pad_to s pos) = total_size s.
+Proof.
+  unfold pad_to; intros. destruct (zle pos (curr s)); auto.
+Qed.
+
+Lemma pad_to_correct: forall pos s m b,
+  match_state s m b -> pos <= s.(total_size) ->
+  match_state (pad_to s pos) m b.
+Proof.
+  intros. unfold pad_to. destruct (zle pos (curr s)); auto.
+  destruct H; constructor; simpl; intros.
+- lia.
+- rewrite boidl_rev_cons. simpl.
+  replace pos with (s.(curr) + (pos - s.(curr))) at 1 by lia.
+  apply Mem.loadbytes_concat; try lia.
+    * auto.
+    * eapply reads_as_zeros_loadbytes; eauto. lia. lia. lia.
+- rewrite idlvalid_app. split; auto. simpl. intuition auto using Z.divide_1_l.
+- eapply reads_as_zeros_mono; eauto; lia.
+Qed.
+
+Lemma trisection_correct: forall s m b pos sz bytes1 bytes2 il,
+  match_state s m b ->
+  trisection s.(init) (s.(curr) - (pos + sz)) sz = OK (bytes1, bytes2, il) ->
+  0 <= pos -> pos + sz <= s.(curr) -> 0 <= sz ->
+  Mem.loadbytes m b 0 pos = Some (boidl (rev il))
+  /\ Mem.loadbytes m b pos sz = Some (inj_bytes bytes2)
+  /\ Mem.loadbytes m b (pos + sz) (s.(curr) - (pos + sz)) = Some (inj_bytes bytes1).
+Proof.
+  intros. apply trisection_boidl in H0. destruct H0 as (A & B & C).
+  set (depth := curr s - (pos + sz)) in *.
+  pose proof (match_contents _ _ _ H) as D.
+  replace (curr s) with ((pos + sz) + depth) in D by lia.
+  exploit Mem.loadbytes_split. eexact D. lia. lia.
+  rewrite Z.add_0_l. intros (bytes0 & bytes1' & LB0 & LB1 & E1).
+  exploit Mem.loadbytes_split. eexact LB0. lia. lia.
+  rewrite Z.add_0_l. intros (bytes3 & bytes2' & LB3 & LB2 & E2).
+  rewrite A in E1. rewrite <- app_ass in E1.
+  exploit list_append_injective_r. eexact E1.
+  { unfold inj_bytes; rewrite map_length. erewrite Mem.loadbytes_length; eauto. }
+  intros (E3 & E4).
+  rewrite E2 in E3.
+  exploit list_append_injective_r. eexact E3.
+  { unfold inj_bytes; rewrite map_length. erewrite Mem.loadbytes_length; eauto. }
+  intros (E5 & E6).
+  intuition congruence.
+Qed.
+
+Remark decode_int_zero_ext: forall n bytes,
+  0 <= n <= 4 -> n = Z.of_nat (length bytes) ->
+  Int.zero_ext (n * 8) (Int.repr (decode_int bytes)) = Int.repr (decode_int bytes).
+Proof.
+  intros.
+  assert (0 <= decode_int bytes < two_p (n * 8)).
+  { rewrite H0. replace (length bytes) with (length (rev_if_be bytes)). 
+    apply int_of_bytes_range.
+    apply rev_if_be_length. }
+  assert (two_p (n * 8) <= Int.modulus).
+  { apply (two_p_monotone (n * 8) 32); lia. } 
+  unfold Int.zero_ext.
+  rewrite Int.unsigned_repr by (unfold Int.max_unsigned; lia).
+  rewrite Zbits.Zzero_ext_mod by lia.
+  rewrite Zmod_small by auto. auto.
+Qed.
+
+Theorem load_int_correct: forall s m b pos isz i v,
+  match_state s m b ->
+  load_int s pos isz = OK i ->
+  Mem.load (chunk_for_carrier isz) m b pos = Some v ->
+  v = Vint i.
+Proof.
+  intros until v; intros MS RI LD.
+  exploit Mem.load_valid_access. eauto. intros [PERM ALIGN].
+  unfold load_int in RI. 
+  set (chunk := chunk_for_carrier isz) in *.
+  set (sz := size_chunk chunk) in *.
+  assert (sz > 0) by (apply size_chunk_pos).
+  set (s1 := pad_to s (pos + sz)) in *.
+  assert (pos + sz <= curr s1) by (apply curr_pad_to).
+  monadInv RI. InvBooleans. destruct x as [[bytes1 bytes2] il].
+  assert (MS': match_state s1 m b) by (apply pad_to_correct; auto).
+  exploit trisection_correct; eauto. lia.
+  intros (L1 & L2 & L3).
+  assert (LEN: Z.of_nat (length bytes2) = sz).
+  { apply Mem.loadbytes_length in L2. unfold inj_bytes in L2.
+    rewrite map_length in L2. rewrite L2. apply Z2Nat.id; lia. }
+  exploit Mem.loadbytes_load. eexact L2. exact ALIGN. rewrite LD. 
+  unfold decode_val. rewrite proj_inj_bytes. intros E; inv E; inv EQ0.
+  unfold chunk, chunk_for_carrier; destruct isz; f_equal.
+  - apply (decode_int_zero_ext 1). lia. auto.
+  - apply (decode_int_zero_ext 2). lia. auto.
+  - apply (decode_int_zero_ext 1). lia. auto.
+Qed.
+
+Remark loadbytes_concat_3: forall m b ofs1 len1 l1 ofs2 len2 l2 ofs3 len3 l3 len,
+  Mem.loadbytes m b ofs1 len1 = Some l1 ->
+  Mem.loadbytes m b ofs2 len2 = Some l2 ->
+  Mem.loadbytes m b ofs3 len3 = Some l3 ->
+  ofs2 = ofs1 + len1 -> ofs3 = ofs2 + len2 -> 0 <= len1 -> 0 <= len2 -> 0 <= len3 ->
+  len = len1 + len2 + len3 ->
+  Mem.loadbytes m b ofs1 len = Some (l1 ++ l2 ++ l3).
+Proof.
+  intros. rewrite H7, <- Z.add_assoc. apply Mem.loadbytes_concat. auto.
+  apply Mem.loadbytes_concat. rewrite <- H2; auto. rewrite <- H2, <- H3; auto.
+  lia. lia. lia. lia.
+Qed. 
+
+Theorem store_data_correct: forall s m b pos i s' m',
+  match_state s m b ->
+  store_data s pos i = OK s' ->
+  Genv.store_init_data ge m b pos i = Some m' ->
+  match i with Init_space _ => False | _ => True end ->
+  match_state s' m' b.
+Proof.
+  intros until m'; intros MS ST SI NOSPACE.
+  exploit Genv.store_init_data_aligned; eauto. intros ALIGN.
+  assert (VALID: idvalid i).
+  { destruct i; simpl; auto. simpl in SI. destruct (Genv.find_symbol ge i); try discriminate. exists b0; auto. }
+  unfold store_data in ST.
+  set (sz := init_data_size i) in *.
+  assert (sz >= 0) by (apply init_data_size_pos).
+  set (s1 := pad_to s (pos + sz)) in *.
+  monadInv ST. InvBooleans.
+  assert (U: Mem.unchanged_on (fun b i => ~(pos <= i < pos + sz)) m m').
+  { eapply Genv.store_init_data_unchanged. eauto. tauto. }
+  exploit store_init_data_loadbytes; eauto. fold sz. intros D.
+  destruct (zle (curr s) pos).
+- inv ST.
+  set (il := if zlt (curr s) pos then Init_space (pos - curr s) :: init s else init s).
+  assert (IL: boidl (rev il) = boidl (rev (init s)) ++ repeat (Byte Byte.zero) (Z.to_nat (pos - curr s))).
+  { unfold il; destruct (zlt (curr s) pos).
+  - simpl rev. rewrite boidl_rev_cons. simpl. auto.
+  - rewrite Z_to_nat_neg by lia. simpl. rewrite app_nil_r; auto.
+  }
+  constructor; simpl; intros.
+  + lia.
+  + rewrite boidl_rev_cons, IL, app_ass.
+    apply loadbytes_concat_3 with (len1 := curr s) (ofs2 := curr s) (len2 := pos - curr s) (ofs3 := pos) (len3 := sz); try lia.
+    * eapply Mem.loadbytes_unchanged_on; eauto.
+      intros. simpl. lia.
+      eapply match_contents; eauto.
+    * eapply Mem.loadbytes_unchanged_on; eauto.
+      intros. simpl. lia.
+      eapply reads_as_zeros_loadbytes. eapply match_uninitialized; eauto. lia. lia. lia.
+    * exact D.
+    * eapply match_range; eauto.
+  + rewrite idlvalid_app; split.
+    * unfold il; destruct (zlt (curr s) pos).
+      ** simpl; rewrite idlvalid_app; split. eapply match_valid; eauto. simpl. auto using Z.divide_1_l.
+      ** eapply match_valid; eauto.
+    * simpl.
+      replace (init_data_list_size (rev il)) with pos. tauto.
+      unfold il; destruct (zlt (curr s) pos).
+      ** simpl; rewrite init_data_list_size_app; simpl.
+         erewrite match_size by eauto. lia.
+      ** erewrite match_size by eauto. lia.
+  + eapply reads_as_zeros_unchanged; eauto.
+    eapply reads_as_zeros_mono. eapply match_uninitialized; eauto. lia. lia.
+    intros. simpl. lia.
+- monadInv ST. destruct x as [[bytes1 bytes2] il]. inv EQ0.
+  assert (pos + sz <= curr s1) by (apply curr_pad_to).
+  assert (MS': match_state s1 m b) by (apply pad_to_correct; auto).
+  exploit trisection_correct; eauto. lia.
+  intros (L1 & L2 & L3).
+  constructor; simpl; intros.
+  + eapply match_range; eauto.
+  + rewrite add_rev_bytes_spec, rev_app_distr; simpl; rewrite app_ass; simpl.
+    rewrite <- map_rev, rev_involutive.
+    rewrite boidl_app. simpl. rewrite boidl_init_bytes.
+    apply loadbytes_concat_3 with (len1 := pos) (ofs2 := pos) (len2 := sz) (ofs3 := pos + sz)
+                                  (len3 := curr s1 - (pos + sz)); try lia.
+    * eapply Mem.loadbytes_unchanged_on; eauto.
+      intros. simpl. lia.
+    * exact D.
+    * eapply Mem.loadbytes_unchanged_on; eauto.
+      intros. simpl. lia.
+  + apply add_rev_bytes_valid. simpl; rewrite idlvalid_app; split.
+    * eapply trisection_valid; eauto. eapply match_valid; eauto.
+    * rewrite init_data_list_size_boidl. erewrite Mem.loadbytes_length by eauto.
+      rewrite Z2Nat.id by lia. simpl. tauto.
+  + eapply reads_as_zeros_unchanged; eauto. eapply match_uninitialized; eauto.
+    intros. simpl. lia.
+Qed.
+
+Corollary store_int_correct: forall s m b pos isz n s' m',
+  match_state s m b ->
+  store_int s pos isz n = OK s' ->
+  Mem.store (chunk_for_carrier isz) m b pos (Vint n) = Some m' ->
+  match_state s' m' b.
+Proof.
+  intros. eapply store_data_correct; eauto.
+- destruct isz; exact H1.
+- destruct isz; exact I.
+Qed.
+
+Theorem init_data_list_of_state_correct: forall s m b il b' m1,
+  match_state s m b ->
+  init_data_list_of_state s = OK il ->
+  Mem.range_perm m1 b' 0 s.(total_size) Cur Writable ->
+  reads_as_zeros m1 b' 0 s.(total_size) ->
+  exists m2,
+     Genv.store_init_data_list ge m1 b' 0 il = Some m2
+  /\ Mem.loadbytes m2 b' 0 (init_data_list_size il) = Mem.loadbytes m b 0 s.(total_size).
+Proof.
+  intros. unfold init_data_list_of_state in H0; monadInv H0. rename l into LE.
+  set (s1 := pad_to s s.(total_size)) in *.
+  assert (MS1: match_state s1 m b) by (apply pad_to_correct; auto; lia).
+  apply reads_as_zeros_equiv in H2. rewrite Z.sub_0_r in H2.
+  assert (R: rev' (init s1) = rev (init s1)).
+  { unfold rev'. rewrite <- rev_alt. auto. }
+  assert (C: curr s1 = total_size s).
+  { unfold s1, pad_to. destruct zle; simpl; lia. }
+  assert (A: Genv.init_data_list_aligned 0 (rev (init s1))).
+  { exploit match_valid; eauto. generalize (rev (init s1)) 0.
+    induction l as [ | i l]; simpl; intuition. }
+  assert (B: forall id ofs, In (Init_addrof id ofs) (rev (init s1)) ->
+             exists b, Genv.find_symbol ge id = Some b).
+  { intros id ofs. exploit match_valid; eauto. generalize (rev (init s1)) 0.
+    induction l as [ | i l]; simpl; intuition eauto. subst i; assumption. }
+  exploit Genv.store_init_data_list_exists.
+  2: eexact A. 2: eexact B.
+  erewrite match_size by eauto. rewrite C. eauto.
+  intros (m2 & ST). exists m2; split.
+- rewrite R. auto.
+- rewrite R. transitivity (Some (boidl (rev (init s1)))).
+  + eapply Genv.store_init_data_list_loadbytes; eauto.
+    erewrite match_size, C by eauto. auto.
+  + symmetry. rewrite <- C. eapply match_contents; eauto.
+Qed.
+
+(** ** Total size properties *)
+
+Lemma total_size_store_data: forall s pos i s',
+  store_data s pos i = OK s' -> total_size s' = total_size s.
+Proof.
+  unfold store_data; intros. monadInv H. destruct (zle (curr s) pos); monadInv H.
+- auto.
+- destruct x as [[bytes1 bytes2] il2]. inv EQ0. simpl. apply total_size_pad_to.
+Qed.
+
+Lemma total_size_transl_init_bitfield: forall ce s ty sz p w i pos s',
+  transl_init_bitfield ce s ty sz p w i pos = OK s' -> total_size s' = total_size s.
+Proof.
+  unfold transl_init_bitfield; intros. destruct i; monadInv H. destruct x; monadInv EQ0.
+  eapply total_size_store_data. eexact EQ2.
+Qed.
+
+Lemma total_size_transl_init_rec: forall ce s ty i pos s',
+  transl_init_rec ce s ty i pos = OK s' -> total_size s' = total_size s
+with total_size_transl_init_array: forall ce s tyelt il pos s',
+  transl_init_array ce s tyelt il pos = OK s' -> total_size s' = total_size s
+with total_size_transl_init_struct: forall ce s ms il base pos s',
+  transl_init_struct ce s ms il base pos = OK s' -> total_size s' = total_size s.
+Proof.
+- destruct i; simpl; intros.
+  + monadInv H; eauto using total_size_store_data.
+  + destruct ty; monadInv H. eauto.
+  + destruct ty; monadInv H. destruct (co_su x); try discriminate. eauto.
+  + destruct ty; monadInv H. destruct (co_su x); monadInv EQ0. destruct x2.
+    * eauto.
+    * eauto using total_size_transl_init_bitfield.
+- destruct il; simpl; intros.
+  + inv H; auto.
+  + monadInv H. transitivity (total_size x); eauto.
+- destruct il; simpl; intros.
+  + inv H; auto.
+  + revert ms pos H. induction ms; intros.
+    * inv H.
+    * destruct (member_not_initialized a). eapply IHms; eauto.
+      monadInv H. transitivity (total_size x1). eauto.
+      destruct x0; eauto using total_size_transl_init_bitfield.
 Qed.
 
 (** * Soundness of the translation of initializers *)
 
 (** Soundness for single initializers. *)
 
-Theorem transl_init_single_steps:
-  forall ty a data f m v1 ty1 m' v chunk b ofs m'',
+Inductive exec_assign: mem -> block -> Z -> bitfield -> type -> val -> mem -> Prop :=
+  | exec_assign_full: forall m b ofs ty v m' chunk,
+      access_mode ty = By_value chunk ->
+      Mem.store chunk m b ofs v = Some m' ->
+      exec_assign m b ofs Full ty v m'
+  | exec_assign_bits: forall m b ofs sz sg sg1 attr pos width ty n m' c,
+      type_is_volatile ty = false ->
+      0 <= pos -> 0 < width -> pos + width <= bitsize_intsize sz ->
+      sg1 = (if zlt width (bitsize_intsize sz) then Signed else sg) ->
+      Mem.load (chunk_for_carrier sz) m b ofs = Some (Vint c) ->
+      Mem.store (chunk_for_carrier sz) m b ofs
+                (Vint (Int.bitfield_insert (first_bit sz pos width) width c n)) = Some m' ->
+      exec_assign m b ofs (Bits sz sg pos width) (Tint sz sg1 attr) (Vint n) m'.
+
+Lemma transl_init_single_sound:
+  forall ty a data f m v1 ty1 m' v b ofs m'',
   transl_init_single ge ty a = OK data ->
   star step ge (ExprState f a Kstop empty_env m) E0 (ExprState f (Eval v1 ty1) Kstop empty_env m') ->
   sem_cast v1 ty1 ty m' = Some v ->
-  access_mode ty = By_value chunk ->
-  Mem.store chunk m' b ofs v = Some m'' ->
-  Genv.store_init_data ge m b ofs data = Some m''.
+  exec_assign m' b ofs Full ty v m'' ->
+  Genv.store_init_data ge m b ofs data = Some m''
+  /\ match data with Init_space _ => False | _ => True end.
 Proof.
-  intros. monadInv H. monadInv EQ. 
+  intros until m''; intros TR STEPS CAST ASG.
+  monadInv TR. monadInv EQ. 
   exploit constval_steps; eauto. intros [A [B C]]. subst m' ty1.
   exploit sem_cast_match; eauto. intros D.
-  unfold Genv.store_init_data.
-  inv D.
+  inv ASG. rename H into A. unfold Genv.store_init_data. inv D.
 - (* int *)
   remember Archi.ptr64 as ptr64.  destruct ty; try discriminate EQ0.
 + destruct i0; inv EQ0.
-  destruct s; simpl in H2; inv H2. rewrite <- Mem.store_signed_unsigned_8; auto. auto.
-  destruct s; simpl in H2; inv H2. rewrite <- Mem.store_signed_unsigned_16; auto. auto.
-  simpl in H2; inv H2. assumption.
-  simpl in H2; inv H2. assumption.
-+ destruct ptr64; inv EQ0. simpl in H2; unfold Mptr in H2; rewrite <- Heqptr64 in H2; inv H2. assumption.
+  destruct s; simpl in A; inv A. rewrite <- Mem.store_signed_unsigned_8; auto. auto.
+  destruct s; simpl in A; inv A. rewrite <- Mem.store_signed_unsigned_16; auto. auto.
+  simpl in A; inv A. auto.
+  simpl in A; inv A. auto.
++ destruct ptr64; inv EQ0. simpl in A; unfold Mptr in A; rewrite <- Heqptr64 in A; inv A. auto.
 - (* Long *)
-  remember Archi.ptr64 as ptr64. destruct ty; inv EQ0.
-+ simpl in H2; inv H2. assumption.
-+ simpl in H2; unfold Mptr in H2; destruct Archi.ptr64; inv H4. 
-  inv H2; assumption.
+  remember Archi.ptr64 as ptr64. destruct ty; monadInv EQ0.
++ simpl in A; inv A. auto.
++ simpl in A; unfold Mptr in A; rewrite <- Heqptr64 in A; inv A. auto.
 - (* float *)
   destruct ty; try discriminate.
-  destruct f1; inv EQ0; simpl in H2; inv H2; assumption.
+  destruct f1; inv EQ0; simpl in A; inv A; auto.
 - (* single *)
   destruct ty; try discriminate.
-  destruct f1; inv EQ0; simpl in H2; inv H2; assumption.
+  destruct f1; inv EQ0; simpl in A; inv A; auto.
 - (* pointer *)
   unfold inj in H.
-  assert (data = Init_addrof b1 ofs1 /\ chunk = Mptr).
+  assert (X: data = Init_addrof b1 ofs1 /\ chunk = Mptr).
   { remember Archi.ptr64 as ptr64.
     destruct ty; inversion EQ0.
-    destruct i; inv H5. unfold Mptr. destruct Archi.ptr64; inv H6; inv H2; auto.
-    subst ptr64. unfold Mptr. destruct Archi.ptr64; inv H5; inv H2; auto.
-    inv H2. auto. }
-  destruct H4; subst. destruct (Genv.find_symbol ge b1); inv H.
-  rewrite Ptrofs.add_zero in H3. auto.
+    - destruct i; monadInv H2. unfold Mptr. rewrite <- Heqptr64. inv A; auto.
+    - monadInv H2. unfold Mptr. rewrite <- Heqptr64. inv A; auto.
+    - inv A; auto.
+  }
+  destruct X; subst. destruct (Genv.find_symbol ge b1); inv H.
+  rewrite Ptrofs.add_zero in H0. auto.
 - (* undef *)
   discriminate.
 Qed.
 
-(** Size properties for initializers. *)
-
-Lemma transl_init_single_size:
-  forall ty a data,
-  transl_init_single ge ty a = OK data ->
-  init_data_size data = sizeof ge ty.
-Proof.
-  intros. monadInv H. monadInv EQ. remember Archi.ptr64 as ptr64. destruct x.
-- monadInv EQ0.
-- destruct ty; try discriminate.
-  destruct i0; inv EQ0; auto.
-  destruct ptr64; inv EQ0. 
-Local Transparent sizeof.
-  unfold sizeof. rewrite <- Heqptr64; auto.
-- destruct ty; inv EQ0; auto. 
-  unfold sizeof. destruct Archi.ptr64; inv H0; auto.
-- destruct ty; try discriminate.
-  destruct f0; inv EQ0; auto.
-- destruct ty; try discriminate.
-  destruct f0; inv EQ0; auto.
-- destruct ty; try discriminate.
-  destruct i0; inv EQ0; auto.
-  destruct Archi.ptr64 eqn:SF; inv H0. simpl. rewrite SF; auto.
-  destruct ptr64; inv EQ0. simpl. rewrite <- Heqptr64; auto.
-  inv EQ0. unfold init_data_size, sizeof. auto.
-Qed.
-
-Notation idlsize := init_data_list_size.
-
-Remark padding_size:
-  forall frm to, frm <= to -> idlsize (tr_padding frm to) = to - frm.
-Proof.
-  unfold tr_padding; intros. destruct (zlt frm to).
-  simpl. extlia.
-  simpl. lia.
-Qed.
-
-Remark idlsize_app:
-  forall d1 d2, idlsize (d1 ++ d2) = idlsize d1 + idlsize d2.
-Proof.
-  induction d1; simpl; intros.
-  auto.
-  rewrite IHd1. lia.
-Qed.
-
-Remark union_field_size:
-  forall f ty fl, field_type f fl = OK ty -> sizeof ge ty <= sizeof_union ge fl.
-Proof.
-  induction fl as [|[i t]]; simpl; intros.
-- inv H.
-- destruct (ident_eq f i).
-  + inv H. extlia.
-  + specialize (IHfl H). extlia.
-Qed.
-
-Hypothesis ce_consistent: composite_env_consistent ge.
-
-Lemma tr_init_size:
-  forall i ty data,
-  tr_init ty i data ->
-  idlsize data = sizeof ge ty
-with tr_init_array_size:
-  forall ty il sz data,
-  tr_init_array ty il sz data ->
-  idlsize data = sizeof ge ty * sz
-with tr_init_struct_size:
-  forall ty fl il pos data,
-  tr_init_struct ty fl il pos data ->
-  sizeof_struct ge pos fl <= sizeof ge ty ->
-  idlsize data + pos = sizeof ge ty.
-Proof.
-Local Opaque sizeof.
-- destruct 1; simpl.
-+ erewrite transl_init_single_size by eauto. lia.
-+ Local Transparent sizeof. simpl. eapply tr_init_array_size; eauto. 
-+ replace (idlsize d) with (idlsize d + 0) by lia.
-  eapply tr_init_struct_size; eauto. simpl.
-  unfold lookup_composite in H. destruct (ge.(genv_cenv)!id) as [co'|] eqn:?; inv H.
-  erewrite co_consistent_sizeof by (eapply ce_consistent; eauto).
-  unfold sizeof_composite. rewrite H0. apply align_le.
-  destruct (co_alignof_two_p co) as [n EQ]. rewrite EQ. apply two_power_nat_pos.
-+ rewrite idlsize_app, padding_size. 
-  exploit tr_init_size; eauto. intros EQ; rewrite EQ. lia.
-  simpl. unfold lookup_composite in H. destruct (ge.(genv_cenv)!id) as [co'|] eqn:?; inv H.
-  apply Z.le_trans with (sizeof_union ge (co_members co)).
-  eapply union_field_size; eauto.
-  erewrite co_consistent_sizeof by (eapply ce_consistent; eauto).
-  unfold sizeof_composite. rewrite H0. apply align_le.
-  destruct (co_alignof_two_p co) as [n EQ]. rewrite EQ. apply two_power_nat_pos.
-
-- destruct 1; simpl.
-+ lia.
-+ rewrite Z.mul_comm.
-  assert (0 <= sizeof ge ty * sz).
-  { apply Zmult_gt_0_le_0_compat. lia. generalize (sizeof_pos ge ty); lia. }
-  extlia.
-+ rewrite idlsize_app. 
-  erewrite tr_init_size by eauto. 
-  erewrite tr_init_array_size by eauto.
-  ring.
-
-- destruct 1; simpl; intros.
-+ rewrite padding_size by auto. lia.
-+ rewrite ! idlsize_app, padding_size. 
-  erewrite tr_init_size by eauto. 
-  rewrite <- (tr_init_struct_size _ _ _ _ _ H0 H1). lia.
-  unfold pos1. apply align_le. apply alignof_pos. 
-Qed.
+(* Hypothesis ce_consistent: composite_env_consistent ge. *)
 
 (** A semantics for general initializers *)
 
 Definition dummy_function := mkfunction Tvoid cc_default nil nil Sskip.
 
-Fixpoint fields_of_struct (fl: members) (pos: Z) : list (Z * type) :=
-  match fl with
-  | nil => nil
-  | (id1, ty1) :: fl' =>
-      (align pos (alignof ge ty1), ty1) :: fields_of_struct fl' (align pos (alignof ge ty1) + sizeof ge ty1)
+Fixpoint initialized_fields_of_struct (ms: members) (pos: Z) : res (list (Z * bitfield * type)) :=
+  match ms with
+  | nil =>
+      OK nil
+  | m :: ms' =>
+      let pos' := next_field ge.(genv_cenv) pos m in
+      if member_not_initialized m
+      then initialized_fields_of_struct ms' pos'
+      else
+        do ofs_bf <- layout_field ge.(genv_cenv) pos m;
+        do l <- initialized_fields_of_struct ms' pos';
+        OK ((ofs_bf, type_member m) :: l)
   end.
 
-Inductive exec_init: mem -> block -> Z -> type -> initializer -> mem -> Prop :=
-  | exec_init_single: forall m b ofs ty a v1 ty1 chunk m' v m'',
+Inductive exec_init: mem -> block -> Z -> bitfield -> type -> initializer -> mem -> Prop :=
+  | exec_init_single_: forall m b ofs bf ty a v1 ty1 m' v m'',
       star step ge (ExprState dummy_function a Kstop empty_env m)
                 E0 (ExprState dummy_function (Eval v1 ty1) Kstop empty_env m') ->
       sem_cast v1 ty1 ty m' = Some v ->
-      access_mode ty = By_value chunk ->
-      Mem.store chunk m' b ofs v = Some m'' ->
-      exec_init m b ofs ty (Init_single a) m''
+      exec_assign m' b ofs bf ty v m'' ->
+      exec_init m b ofs bf ty (Init_single a) m''
   | exec_init_array_: forall m b ofs ty sz a il m',
       exec_init_array m b ofs ty sz il m' ->
-      exec_init m b ofs (Tarray ty sz a) (Init_array il) m'
-  | exec_init_struct: forall m b ofs id a il co m',
+      exec_init m b ofs Full (Tarray ty sz a) (Init_array il) m'
+  | exec_init_struct_: forall m b ofs id a il co flds m',
       ge.(genv_cenv)!id = Some co -> co_su co = Struct ->
-      exec_init_list m b ofs (fields_of_struct (co_members co) 0) il m' ->
-      exec_init m b ofs (Tstruct id a) (Init_struct il) m'
-  | exec_init_union: forall m b ofs id a f i ty co m',
+      initialized_fields_of_struct (co_members co) 0 = OK flds ->
+      exec_init_struct m b ofs flds il m' ->
+      exec_init m b ofs Full (Tstruct id a) (Init_struct il) m'
+  | exec_init_union_: forall m b ofs id a f i co ty pos bf m',
       ge.(genv_cenv)!id = Some co -> co_su co = Union ->
       field_type f (co_members co) = OK ty ->
-      exec_init m b ofs ty i m' ->
-      exec_init m b ofs (Tunion id a) (Init_union f i) m'
+      union_field_offset ge f (co_members co) = OK (pos, bf) ->
+      exec_init m b (ofs + pos) bf ty i m' ->
+      exec_init m b ofs Full (Tunion id a) (Init_union f i) m'
 
 with exec_init_array: mem -> block -> Z -> type -> Z -> initializer_list -> mem -> Prop :=
   | exec_init_array_nil: forall m b ofs ty sz,
       sz >= 0 ->
       exec_init_array m b ofs ty sz Init_nil m
   | exec_init_array_cons: forall m b ofs ty sz i1 il m' m'',
-      exec_init m b ofs ty i1 m' ->
+      exec_init m b ofs Full ty i1 m' ->
       exec_init_array m' b (ofs + sizeof ge ty) ty (sz - 1) il m'' ->
       exec_init_array m b ofs ty sz (Init_cons i1 il) m''
 
-with exec_init_list: mem -> block -> Z -> list (Z * type) -> initializer_list -> mem -> Prop :=
-  | exec_init_list_nil: forall m b ofs,
-      exec_init_list m b ofs nil Init_nil m
-  | exec_init_list_cons: forall m b ofs pos ty l i1 il m' m'',
-      exec_init m b (ofs + pos) ty i1 m' ->
-      exec_init_list m' b ofs l il m'' ->
-      exec_init_list m b ofs ((pos, ty) :: l) (Init_cons i1 il) m''.
+with exec_init_struct: mem -> block -> Z -> list (Z * bitfield * type) -> initializer_list -> mem -> Prop :=
+  | exec_init_struct_nil: forall m b ofs,
+      exec_init_struct m b ofs nil Init_nil m
+  | exec_init_struct_cons: forall m b ofs pos bf ty l i1 il m' m'',
+      exec_init m b (ofs + pos) bf ty i1 m' ->
+      exec_init_struct m' b ofs l il m'' ->
+      exec_init_struct m b ofs ((pos, bf, ty) :: l) (Init_cons i1 il) m''.
 
 Scheme exec_init_ind3 := Minimality for exec_init Sort Prop
   with exec_init_array_ind3 := Minimality for exec_init_array Sort Prop
-  with exec_init_list_ind3 := Minimality for exec_init_list Sort Prop.
-Combined Scheme exec_init_scheme from exec_init_ind3, exec_init_array_ind3, exec_init_list_ind3.
+  with exec_init_struct_ind3 := Minimality for exec_init_struct Sort Prop.
+Combined Scheme exec_init_scheme from exec_init_ind3, exec_init_array_ind3, exec_init_struct_ind3.
 
 Remark exec_init_array_length:
   forall m b ofs ty sz il m',
@@ -809,87 +1256,95 @@ Proof.
   induction 1; lia.
 Qed.
 
-Lemma store_init_data_list_app:
-  forall data1 m b ofs m' data2 m'',
-  Genv.store_init_data_list ge m b ofs data1 = Some m' ->
-  Genv.store_init_data_list ge m' b (ofs + idlsize data1) data2 = Some m'' ->
-  Genv.store_init_data_list ge m b ofs (data1 ++ data2) = Some m''.
-Proof.
-  induction data1; simpl; intros.
-  inv H. rewrite Z.add_0_r in H0. auto.
-  destruct (Genv.store_init_data ge m b ofs a); try discriminate.
-  rewrite Z.add_assoc in H0. eauto.
-Qed.
-
-Remark store_init_data_list_padding:
-  forall frm to b ofs m,
-  Genv.store_init_data_list ge m b ofs (tr_padding frm to) = Some m.
+Lemma transl_init_rec_sound:
+   (forall m b ofs bf ty i m',
+    exec_init m b ofs bf ty i m' ->
+    forall s s',
+    match_state s m b ->
+    match bf with
+    | Full => transl_init_rec ge s ty i ofs
+    | Bits sz sg p w => transl_init_bitfield ge s ty sz p w i ofs
+    end = OK s' ->
+    match_state s' m' b)
+/\ (forall m b ofs ty sz il m',
+    exec_init_array m b ofs ty sz il m' ->
+    forall s s',
+    match_state s m b ->
+    transl_init_array ge s ty il ofs = OK s' ->
+    match_state s' m' b)
+/\ (forall m b ofs flds il m',
+    exec_init_struct m b ofs flds il m' ->
+    forall s s' ms pos,
+    match_state s m b ->
+    initialized_fields_of_struct ms pos = OK flds ->
+    transl_init_struct ge s ms il ofs pos = OK s' ->
+    match_state s' m' b).
 Proof.
-  intros. unfold tr_padding. destruct (zlt frm to); auto.
-Qed.
-
-Lemma tr_init_sound:
-  (forall m b ofs ty i m', exec_init m b ofs ty i m' ->
-   forall data, tr_init ty i data ->
-   Genv.store_init_data_list ge m b ofs data = Some m')
-/\(forall m b ofs ty sz il m', exec_init_array m b ofs ty sz il m' ->
-   forall data, tr_init_array ty il sz data ->
-   Genv.store_init_data_list ge m b ofs data = Some m')
-/\(forall m b ofs l il m', exec_init_list m b ofs l il m' ->
-   forall ty fl data pos,
-   l = fields_of_struct fl pos ->
-   tr_init_struct ty fl il pos data ->
-   Genv.store_init_data_list ge m b (ofs + pos) data = Some m').
-Proof.
-Local Opaque sizeof.
-  apply exec_init_scheme; simpl; intros.
+  apply exec_init_scheme.
 - (* single *)
-  inv H3. simpl. erewrite transl_init_single_steps by eauto. auto.
+  intros until m''; intros STEP CAST ASG s s' MS TR. destruct bf; monadInv TR.
+  + (* full *)
+    exploit transl_init_single_sound; eauto. intros [P Q].
+    eapply store_data_correct; eauto. 
+  + (* bitfield *)
+    destruct x; monadInv EQ0. monadInv EQ.
+    exploit constval_steps; eauto. intros [A [B C]]. subst m' ty1.
+    exploit sem_cast_match; eauto. intros D.
+    inv ASG. inv D.
+    set (f := first_bit sz pos width) in *.
+    assert (E: Vint c = Vint x) by (eapply load_int_correct; eauto).
+    inv E.
+    eapply store_int_correct; eauto.
 - (* array *)
-  inv H1. replace (Z.max 0 sz) with sz in H7. eauto.
-  assert (sz >= 0) by (eapply exec_init_array_length; eauto). extlia.
+  intros. monadInv H2. eauto.
 - (* struct *)
-  inv H3. unfold lookup_composite in H7. rewrite H in H7. inv H7. 
-  replace ofs with (ofs + 0) by lia. eauto.
+  intros. monadInv H5. unfold lookup_composite in EQ. rewrite H in EQ. inv EQ.
+  rewrite H0 in EQ0. eauto.
 - (* union *)
-  inv H4. unfold lookup_composite in H9. rewrite H in H9. inv H9. rewrite H1 in H12; inv H12. 
-  eapply store_init_data_list_app. eauto.
-  apply store_init_data_list_padding.
-
-- (* array, empty *)
-  inv H0; auto.
-- (* array, nonempty *)
-  inv H3.
-  eapply store_init_data_list_app.
-  eauto.
-  rewrite (tr_init_size _ _ _ H7). eauto.
-
-- (* struct, empty *)
-  inv H0. apply store_init_data_list_padding.
-- (* struct, nonempty *)
-  inv H4. simpl in H3; inv H3. 
-  eapply store_init_data_list_app. apply store_init_data_list_padding.
-  rewrite padding_size.
-  replace (ofs + pos0 + (pos2 - pos0)) with (ofs + pos2) by lia.
-  eapply store_init_data_list_app.
+  intros. monadInv H6. unfold lookup_composite in EQ. rewrite H in EQ. inv EQ. rewrite H0 in EQ0.
+  rewrite H1, H2 in EQ0. simpl in EQ0. eauto.
+- (* array nil *)
+  intros. monadInv H1. auto.
+- (* array cons *)
+  intros. monadInv H4. eauto.
+- (* struct nil *)
+  intros. monadInv H1. auto.
+- (* struct cons *)
+  intros. simpl in H5. revert H4 H5. generalize pos0. induction ms as [ | m1 ms]. discriminate.
+  simpl. destruct (member_not_initialized m1).
+  intros; eapply IHms; eauto.
+  clear IHms. intros. monadInv H5. rewrite EQ in H4. monadInv H4. inv EQ0.
   eauto.
-  rewrite (tr_init_size _ _ _ H9).
-  rewrite <- Z.add_assoc. eapply H2. eauto. eauto.
-  apply align_le. apply alignof_pos.
 Qed.
 
 End SOUNDNESS.
 
 Theorem transl_init_sound:
-  forall p m b ty i m' data,
-  exec_init (globalenv p) m b 0 ty i m' ->
+  forall p m b ty i m1 data,
+  let sz := sizeof (prog_comp_env p) ty in
+  Mem.range_perm m b 0 sz Cur Writable ->
+  reads_as_zeros m b 0 sz ->
+  exec_init (globalenv p) m b 0 Full ty i m1 ->
   transl_init (prog_comp_env p) ty i = OK data ->
-  Genv.store_init_data_list (globalenv p) m b 0 data = Some m'.
+  exists m2,
+     Genv.store_init_data_list (globalenv p) m b 0 data = Some m2
+  /\ Mem.loadbytes m2 b 0 (init_data_list_size data) = Mem.loadbytes m1 b 0 sz.
 Proof.
   intros.
   set (ge := globalenv p) in *.
-  change (prog_comp_env p) with (genv_cenv ge) in H0.
-  destruct (tr_init_sound ge) as (A & B & C).
-  eapply build_composite_env_consistent. apply prog_comp_env_eq.
-  eapply A; eauto. apply transl_init_spec; auto.
+  change (prog_comp_env p) with (genv_cenv ge) in *.
+  unfold transl_init in H2; monadInv H2.
+  fold sz in EQ. set (s0 := initial_state sz) in *.
+  assert (match_state ge s0 m b).
+  { constructor; simpl.
+  - generalize (sizeof_pos ge ty). fold sz. lia.
+  - apply Mem.loadbytes_empty. lia.
+  - auto.
+  - assumption.
+  }
+  assert (match_state ge x m1 b).
+  { eapply (proj1 (transl_init_rec_sound ge)); eauto. }
+  assert (total_size x = sz).
+  { change sz with s0.(total_size). eapply total_size_transl_init_rec; eauto. }
+  rewrite <- H4. eapply init_data_list_of_state_correct; eauto; rewrite H4; auto.
 Qed.
diff --git a/cfrontend/PrintCsyntax.ml b/cfrontend/PrintCsyntax.ml
index 75c85d60..16cdfc41 100644
--- a/cfrontend/PrintCsyntax.ml
+++ b/cfrontend/PrintCsyntax.ml
@@ -204,7 +204,7 @@ let rec expr p (prec, e) =
   then fprintf p "@[<hov 2>("
   else fprintf p "@[<hov 2>";
   begin match e with
-  | Eloc(b, ofs, _) ->
+  | Eloc(b, ofs, _, _) ->
       fprintf p "<loc%a>" !print_pointer_hook (b, ofs)
   | Evar(id, _) ->
       fprintf p "%s" (extern_atom id)
@@ -534,13 +534,18 @@ let struct_or_union = function Struct -> "struct" | Union -> "union"
 let declare_composite p (Composite(id, su, m, a)) =
   fprintf p "%s %s;@ " (struct_or_union su) (extern_atom id)
 
+let print_member p = function
+  | Member_plain(id, ty) ->
+      fprintf p "@ %s;" (name_cdecl (extern_atom id) ty)
+  | Member_bitfield(id, sz, sg, attr, w, _is_padding) ->
+      fprintf p "@ %s : %s;"
+              (name_cdecl (extern_atom id) (Tint(sz, sg, attr)))
+              (Z.to_string w)
+
 let define_composite p (Composite(id, su, m, a)) =
   fprintf p "@[<v 2>%s %s%s {"
           (struct_or_union su) (extern_atom id) (attributes a);
-  List.iter
-    (fun (fid, fty) ->
-      fprintf p "@ %s;" (name_cdecl (extern_atom fid) fty))
-    m;
+  List.iter (print_member p) m;
   fprintf p "@;<0 -2>};@]@ @ "
 
 let print_program p prog =
diff --git a/cfrontend/SimplExpr.v b/cfrontend/SimplExpr.v
index c7e57a54..bb1dbe38 100644
--- a/cfrontend/SimplExpr.v
+++ b/cfrontend/SimplExpr.v
@@ -13,17 +13,8 @@
 (** Translation from Compcert C to Clight.
     Side effects are pulled out of Compcert C expressions. *)
 
-Require Import Coqlib.
-Require Import Errors.
-Require Import Integers.
-Require Import Floats.
-Require Import Values.
-Require Import Memory.
-Require Import AST.
-Require Import Ctypes.
-Require Import Cop.
-Require Import Csyntax.
-Require Import Clight.
+Require Import Coqlib Maps Integers Floats Values AST Memory Errors.
+Require Import Ctypes Cop Csyntax Clight.
 
 Local Open Scope string_scope.
 Local Open Scope list_scope.
@@ -71,8 +62,6 @@ Notation "'do' ( X , Y ) <- A ; B" := (bind2 A (fun X Y => B))
    (at level 200, X ident, Y ident, A at level 100, B at level 200)
    : gensym_monad_scope.
 
-Local Open Scope gensym_monad_scope.
-
 Parameter first_unused_ident: unit -> ident.
 
 Definition initial_generator (x: unit) : generator :=
@@ -96,6 +85,12 @@ Fixpoint makeseq_rec (s: statement) (l: list statement) : statement :=
 Definition makeseq (l: list statement) : statement :=
   makeseq_rec Sskip l.
 
+Section SIMPL_EXPR.
+
+Local Open Scope gensym_monad_scope.
+
+Variable ce: composite_env.
+
 (** Smart constructor for [if ... then ... else]. *)
 
 Fixpoint eval_simpl_expr (a: expr) : option val :=
@@ -144,16 +139,64 @@ Definition transl_incrdecr (id: incr_or_decr) (a: expr) (ty: type) : expr :=
   | Decr => Ebinop Osub a (Econst_int Int.one type_int32s) (incrdecr_type ty)
   end.
 
-(** Generate a [Sset] or [Sbuiltin] operation as appropriate
-  to dereference a l-value [l] and store its result in temporary variable [id]. *)
+(** Given a simple l-value expression [l], determine whether it
+    designates a bitfield.  *)
+
+Definition is_bitfield_access_aux
+              (fn: composite_env -> ident -> members -> res (Z * bitfield))
+              (id: ident) (fld: ident) : mon bitfield :=
+  match ce!id with
+  | None => error (MSG "unknown composite " :: CTX id :: nil)
+  | Some co =>
+      match fn ce fld (co_members co) with
+      | OK (_, bf) => ret bf
+      | Error _ => error (MSG "unknown field " :: CTX fld :: nil)
+      end
+  end.
 
-Definition chunk_for_volatile_type (ty: type) : option memory_chunk :=
-  if type_is_volatile ty
-  then match access_mode ty with By_value chunk => Some chunk | _ => None end
+Definition is_bitfield_access (l: expr) : mon bitfield :=
+  match l with
+  | Efield r f _ =>
+      match typeof r with
+      | Tstruct id _ => is_bitfield_access_aux field_offset id f
+      | Tunion id _  => is_bitfield_access_aux union_field_offset id f
+      | _ => error (msg "is_bitfield_access")
+      end
+  | _ => ret Full
+  end.
+
+(** According to the CompCert C semantics, an access to a l-value of
+    volatile-qualified type can either
+  - produce an event in the trace of observable events, or
+  - produce no event and behave as if no volatile qualifier was there.
+
+    The latter case, where the volatile qualifier is ignored, happens if
+  - the l-value is a struct or union
+  - the l-value is an access to a bit field.
+
+    The [chunk_for_volatile_type] function distinguishes between the two
+    cases.  It returns [Some chunk] if the semantics is to produce
+    an observable event of the [Event_vload chunk] or [Event_vstore chunk]
+    kind.  It returns [None] if the semantics is that of a non-volatile
+    access. *)
+
+Definition chunk_for_volatile_type (ty: type) (bf: bitfield) : option memory_chunk :=
+  if type_is_volatile ty then
+    match access_mode ty with
+    | By_value chunk =>
+        match bf with
+        | Full => Some chunk
+        | Bits _ _ _ _ => None
+        end
+    | _ => None
+    end
   else None.
 
-Definition make_set (id: ident) (l: expr) : statement :=
-  match chunk_for_volatile_type (typeof l) with
+(** Generate a [Sset] or [Sbuiltin] operation as appropriate
+  to dereference a l-value [l] and store its result in temporary variable [id]. *)
+
+Definition make_set (bf: bitfield) (id: ident) (l: expr) : statement :=
+  match chunk_for_volatile_type (typeof l) bf with
   | None => Sset id l
   | Some chunk =>
       let typtr := Tpointer (typeof l) noattr in
@@ -165,13 +208,15 @@ Definition make_set (id: ident) (l: expr) : statement :=
 
 Definition transl_valof (ty: type) (l: expr) : mon (list statement * expr) :=
   if type_is_volatile ty
-  then do t <- gensym ty; ret (make_set t l :: nil, Etempvar t ty)
+  then do t <- gensym ty;
+       do bf <- is_bitfield_access l;
+       ret (make_set bf t l :: nil, Etempvar t ty)
   else ret (nil, l).
 
 (** Translation of an assignment. *)
 
-Definition make_assign (l r: expr) : statement :=
-  match chunk_for_volatile_type (typeof l) with
+Definition make_assign (bf: bitfield) (l r: expr) : statement :=
+  match chunk_for_volatile_type (typeof l) bf with
   | None =>
       Sassign l r
   | Some chunk =>
@@ -181,6 +226,30 @@ Definition make_assign (l r: expr) : statement :=
                     (Eaddrof l typtr :: r :: nil)
   end.
 
+(** Translation of the value of an assignment expression.
+    For non-bitfield assignments, it's the value of the right-hand side
+    converted to the type of the left-hand side.
+    For assignments to bitfields, an additional normalization to
+    the width and signedness of the bitfield is required. *)
+
+Definition make_normalize (sz: intsize) (sg: signedness) (width: Z) (r: expr) :=
+  let intconst (n: Z) := Econst_int (Int.repr n) type_int32s in
+  if intsize_eq sz IBool || signedness_eq sg Unsigned then
+    let mask := two_p width - 1 in
+    Ebinop Oand r (intconst mask) (typeof r)
+  else
+    let amount := Int.zwordsize - width in
+    Ebinop Oshr
+           (Ebinop Oshl r (intconst amount) type_int32s)
+           (intconst amount)
+           (typeof r).
+
+Definition make_assign_value (bf: bitfield) (r: expr): expr :=
+  match bf with
+  | Full => r
+  | Bits sz sg pos width => make_normalize sz sg width r
+  end.
+
 (** Translation of expressions.  Return a pair [(sl, a)] of
     a list of statements [sl] and a pure expression [a].
 - If the [dst] argument is [For_val], the statements [sl]
@@ -229,7 +298,7 @@ Definition sd_seqbool_set (ty: type) (sd: set_destination) :=
 
 Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement * expr) :=
   match a with
-  | Csyntax.Eloc b ofs ty =>
+  | Csyntax.Eloc b ofs bf ty =>
       error (msg "SimplExpr.transl_expr: Eloc")
   | Csyntax.Evar x ty =>
       ret (finish dst nil (Evar x ty))
@@ -335,16 +404,17 @@ Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement
   | Csyntax.Eassign l1 r2 ty =>
       do (sl1, a1) <- transl_expr For_val l1;
       do (sl2, a2) <- transl_expr For_val r2;
+      do bf <- is_bitfield_access a1;
       let ty1 := Csyntax.typeof l1 in
       let ty2 := Csyntax.typeof r2 in
       match dst with
       | For_val | For_set _ =>
           do t <- gensym ty1;
           ret (finish dst
-                 (sl1 ++ sl2 ++ Sset t (Ecast a2 ty1) :: make_assign a1 (Etempvar t ty1) :: nil)
-                 (Etempvar t ty1))
+                 (sl1 ++ sl2 ++ Sset t (Ecast a2 ty1) :: make_assign bf a1 (Etempvar t ty1) :: nil)
+                 (make_assign_value bf (Etempvar t ty1)))
       | For_effects =>
-          ret (sl1 ++ sl2 ++ make_assign a1 a2 :: nil,
+          ret (sl1 ++ sl2 ++ make_assign bf a1 a2 :: nil,
                dummy_expr)
       end
   | Csyntax.Eassignop op l1 r2 tyres ty =>
@@ -352,31 +422,33 @@ Fixpoint transl_expr (dst: destination) (a: Csyntax.expr) : mon (list statement
       do (sl1, a1) <- transl_expr For_val l1;
       do (sl2, a2) <- transl_expr For_val r2;
       do (sl3, a3) <- transl_valof ty1 a1;
+      do bf <- is_bitfield_access a1;
       match dst with
       | For_val | For_set _ =>
           do t <- gensym ty1;
           ret (finish dst
                  (sl1 ++ sl2 ++ sl3 ++
                   Sset t (Ecast (Ebinop op a3 a2 tyres) ty1) ::
-                  make_assign a1 (Etempvar t ty1) :: nil)
-                 (Etempvar t ty1))
+                  make_assign bf a1 (Etempvar t ty1) :: nil)
+                 (make_assign_value bf (Etempvar t ty1)))
       | For_effects =>
-          ret (sl1 ++ sl2 ++ sl3 ++ make_assign a1 (Ebinop op a3 a2 tyres) :: nil,
+          ret (sl1 ++ sl2 ++ sl3 ++ make_assign bf a1 (Ebinop op a3 a2 tyres) :: nil,
                dummy_expr)
       end
   | Csyntax.Epostincr id l1 ty =>
       let ty1 := Csyntax.typeof l1 in
       do (sl1, a1) <- transl_expr For_val l1;
+      do bf <- is_bitfield_access a1;
       match dst with
       | For_val | For_set _ =>
           do t <- gensym ty1;
           ret (finish dst
-                 (sl1 ++ make_set t a1 ::
-                  make_assign a1 (transl_incrdecr id (Etempvar t ty1) ty1) :: nil)
+                 (sl1 ++ make_set bf t a1 ::
+                  make_assign bf a1 (transl_incrdecr id (Etempvar t ty1) ty1) :: nil)
                  (Etempvar t ty1))
       | For_effects =>
           do (sl2, a2) <- transl_valof ty1 a1;
-          ret (sl1 ++ sl2 ++ make_assign a1 (transl_incrdecr id a2 ty1) :: nil,
+          ret (sl1 ++ sl2 ++ make_assign bf a1 (transl_incrdecr id a2 ty1) :: nil,
                dummy_expr)
       end
   | Csyntax.Ecomma r1 r2 ty =>
@@ -424,12 +496,6 @@ Definition transl_expression (r: Csyntax.expr) : mon (statement * expr) :=
 Definition transl_expr_stmt (r: Csyntax.expr) : mon statement :=
   do (sl, a) <- transl_expr For_effects r; ret (makeseq sl).
 
-(*
-Definition transl_if (r: Csyntax.expr) (s1 s2: statement) : mon statement :=
-  do (sl, a) <- transl_expr For_val r;
-  ret (makeseq (sl ++ makeif a s1 s2 :: nil)).
-*)
-
 Definition transl_if (r: Csyntax.expr) (s1 s2: statement) : mon statement :=
   do (sl, a) <- transl_expr For_val r;
   ret (makeseq (sl ++ makeif a s1 s2 :: nil)).
@@ -533,8 +599,12 @@ Definition transl_fundef (fd: Csyntax.fundef) : res fundef :=
       OK (External ef targs tres cc)
   end.
 
+End SIMPL_EXPR.
+
+Local Open Scope error_monad_scope.
+
 Definition transl_program (p: Csyntax.program) : res program :=
-  do p1 <- AST.transform_partial_program transl_fundef p;
+  do p1 <- AST.transform_partial_program (transl_fundef p.(prog_comp_env)) p;
   OK {| prog_defs := AST.prog_defs p1;
         prog_public := AST.prog_public p1;
         prog_main := AST.prog_main p1;
diff --git a/cfrontend/SimplExprproof.v b/cfrontend/SimplExprproof.v
index 2d059ddd..67bf0e51 100644
--- a/cfrontend/SimplExprproof.v
+++ b/cfrontend/SimplExprproof.v
@@ -22,7 +22,7 @@ Require Import SimplExpr SimplExprspec.
 (** ** Relational specification of the translation. *)
 
 Definition match_prog (p: Csyntax.program) (tp: Clight.program) :=
-    match_program (fun ctx f tf => tr_fundef f tf) eq p tp
+    match_program_gen tr_fundef eq p p tp
  /\ prog_types tp = prog_types p.
 
 Lemma transf_program_match:
@@ -30,8 +30,9 @@ Lemma transf_program_match:
 Proof.
   unfold transl_program; intros. monadInv H. split; auto.
   unfold program_of_program; simpl. destruct x; simpl.
-  eapply match_transform_partial_program_contextual. eexact EQ. 
-  intros. apply transl_fundef_spec; auto. 
+  eapply match_transform_partial_program2; eauto.
+- intros. apply transl_fundef_spec; auto.
+- intros. inv H. auto.
 Qed.
 
 (** ** Semantic preservation *)
@@ -65,25 +66,19 @@ Proof (Genv.senv_match (proj1 TRANSL)).
 Lemma function_ptr_translated:
   forall b f,
   Genv.find_funct_ptr ge b = Some f ->
-  exists tf,
-  Genv.find_funct_ptr tge b = Some tf /\ tr_fundef f tf.
-Proof.
-  intros.
-  edestruct (Genv.find_funct_ptr_match (proj1 TRANSL)) as (ctx & tf & A & B & C); eauto.
-Qed.
+  exists cu tf,
+  Genv.find_funct_ptr tge b = Some tf /\ tr_fundef cu f tf /\ linkorder cu prog.
+Proof (Genv.find_funct_ptr_match (proj1 TRANSL)).
 
 Lemma functions_translated:
   forall v f,
   Genv.find_funct ge v = Some f ->
-  exists tf,
-  Genv.find_funct tge v = Some tf /\ tr_fundef f tf.
-Proof.
-  intros.
-  edestruct (Genv.find_funct_match (proj1 TRANSL)) as (ctx & tf & A & B & C); eauto.
-Qed.
+  exists cu tf,
+  Genv.find_funct tge v = Some tf /\ tr_fundef cu f tf /\ linkorder cu prog.
+Proof (Genv.find_funct_match (proj1 TRANSL)).
 
 Lemma type_of_fundef_preserved:
-  forall f tf, tr_fundef f tf ->
+  forall cu f tf, tr_fundef cu f tf ->
   type_of_fundef tf = Csyntax.type_of_fundef f.
 Proof.
   intros. inv H.
@@ -92,7 +87,7 @@ Proof.
 Qed.
 
 Lemma function_return_preserved:
-  forall f tf, tr_function f tf ->
+  forall ce f tf, tr_function ce f tf ->
   fn_return tf = Csyntax.fn_return f.
 Proof.
   intros. inv H; auto.
@@ -100,10 +95,16 @@ Qed.
 
 (** Properties of smart constructors. *)
 
+Section TRANSLATION.
+
+Variable cunit: Csyntax.program.
+Hypothesis LINKORDER: linkorder cunit prog.
+Let ce := cunit.(prog_comp_env).
+
 Lemma eval_Ederef':
   forall ge e le m a t l ofs,
   eval_expr ge e le m a (Vptr l ofs) ->
-  eval_lvalue ge e le m (Ederef' a t) l ofs.
+  eval_lvalue ge e le m (Ederef' a t) l ofs Full.
 Proof.
   intros. unfold Ederef'; destruct a; auto using eval_Ederef.
   destruct (type_eq t (typeof a)); auto using eval_Ederef.
@@ -120,7 +121,7 @@ Qed.
 
 Lemma eval_Eaddrof':
   forall ge e le m a t l ofs,
-  eval_lvalue ge e le m a l ofs ->
+  eval_lvalue ge e le m a l ofs Full ->
   eval_expr ge e le m (Eaddrof' a t) (Vptr l ofs).
 Proof.
   intros. unfold Eaddrof'; destruct a; auto using eval_Eaddrof.
@@ -134,12 +135,45 @@ Proof.
   unfold Eaddrof'; intros; destruct a; auto. destruct (type_eq t (typeof a)); auto. 
 Qed.
 
+Lemma eval_make_normalize:
+  forall ge e le m a n sz sg sg1 attr width,
+  0 < width -> width <= bitsize_intsize sz ->
+  typeof a = Tint sz sg1 attr ->
+  eval_expr ge e le m a (Vint n) ->
+  eval_expr ge e le m (make_normalize sz sg width a) (Vint (bitfield_normalize sz sg width n)).
+Proof.
+  intros. unfold make_normalize, bitfield_normalize.
+  assert (bitsize_intsize sz <= Int.zwordsize) by (destruct sz; compute; congruence).
+  destruct (intsize_eq sz IBool || signedness_eq sg Unsigned).
+- rewrite Int.zero_ext_and by lia. econstructor. eauto. econstructor. 
+  rewrite H1; simpl. unfold sem_and, sem_binarith.
+  assert (A: exists sg2, classify_binarith (Tint sz sg1 attr) type_int32s = bin_case_i sg2).
+  { unfold classify_binarith. unfold type_int32s. destruct sz, sg1; econstructor; eauto. }
+  destruct A as (sg2 & A); rewrite A.
+  unfold binarith_type.
+  assert (B: forall i sz0 sg0 attr0,
+             sem_cast (Vint i) (Tint sz0 sg0 attr0) (Tint I32 sg2 noattr) m = Some (Vint i)).
+  { intros. unfold sem_cast, classify_cast. destruct Archi.ptr64; reflexivity. }
+  unfold type_int32s; rewrite ! B. auto.
+- rewrite Int.sign_ext_shr_shl by lia.
+  set (amount := Int.repr (Int.zwordsize - width)).
+  assert (LT: Int.ltu amount Int.iwordsize = true).
+  { unfold Int.ltu. rewrite Int.unsigned_repr_wordsize. apply zlt_true.
+    unfold amount; rewrite Int.unsigned_repr. lia.
+    assert (Int.zwordsize < Int.max_unsigned) by reflexivity. lia. }
+  econstructor.
+  econstructor. eauto. econstructor.
+  rewrite H1. unfold sem_binary_operation, sem_shl, sem_shift. rewrite LT. destruct sz, sg1; reflexivity.
+  econstructor.
+  unfold sem_binary_operation, sem_shr, sem_shift. rewrite LT. reflexivity.
+Qed.
+
 (** Translation of simple expressions. *)
 
 Lemma tr_simple_nil:
-  (forall le dst r sl a tmps, tr_expr le dst r sl a tmps ->
+  (forall le dst r sl a tmps, tr_expr ce le dst r sl a tmps ->
    dst = For_val \/ dst = For_effects -> simple r = true -> sl = nil)
-/\(forall le rl sl al tmps, tr_exprlist le rl sl al tmps ->
+/\(forall le rl sl al tmps, tr_exprlist ce le rl sl al tmps ->
    simplelist rl = true -> sl = nil).
 Proof.
   assert (A: forall dst a, dst = For_val \/ dst = For_effects -> final dst a = nil).
@@ -160,52 +194,104 @@ Proof.
 Qed.
 
 Lemma tr_simple_expr_nil:
-  forall le dst r sl a tmps, tr_expr le dst r sl a tmps ->
+  forall le dst r sl a tmps, tr_expr ce le dst r sl a tmps ->
   dst = For_val \/ dst = For_effects -> simple r = true -> sl = nil.
 Proof (proj1 tr_simple_nil).
 
 Lemma tr_simple_exprlist_nil:
-  forall le rl sl al tmps, tr_exprlist le rl sl al tmps ->
+  forall le rl sl al tmps, tr_exprlist ce le rl sl al tmps ->
   simplelist rl = true -> sl = nil.
 Proof (proj2 tr_simple_nil).
 
 (** Translation of [deref_loc] and [assign_loc] operations. *)
 
 Remark deref_loc_translated:
-  forall ty m b ofs t v,
-  Csem.deref_loc ge ty m b ofs t v ->
-  match chunk_for_volatile_type ty with
-  | None => t = E0 /\ Clight.deref_loc ty m b ofs v
-  | Some chunk => volatile_load tge chunk m b ofs t v
+  forall ty m b ofs bf t v,
+  Csem.deref_loc ge ty m b ofs bf t v ->
+  match chunk_for_volatile_type ty bf with
+  | None => t = E0 /\ Clight.deref_loc ty m b ofs bf v
+  | Some chunk => bf = Full /\ volatile_load tge chunk m b ofs t v
   end.
 Proof.
   intros. unfold chunk_for_volatile_type. inv H.
-  (* By_value, not volatile *)
+- (* By_value, not volatile *)
   rewrite H1. split; auto. eapply deref_loc_value; eauto.
-  (* By_value, volatile *)
-  rewrite H0; rewrite H1. eapply volatile_load_preserved with (ge1 := ge); auto. apply senv_preserved.
-  (* By reference *)
+- (* By_value, volatile *)
+  rewrite H0, H1. split; auto. eapply volatile_load_preserved with (ge1 := ge); auto. apply senv_preserved.
+- (* By reference *)
   rewrite H0. destruct (type_is_volatile ty); split; auto; eapply deref_loc_reference; eauto.
-  (* By copy *)
+- (* By copy *)
   rewrite H0. destruct (type_is_volatile ty); split; auto; eapply deref_loc_copy; eauto.
+- (* Bitfield *)
+  destruct (type_is_volatile ty); [destruct (access_mode ty)|]; auto using deref_loc_bitfield.
 Qed.
 
 Remark assign_loc_translated:
-  forall ty m b ofs v t m',
-  Csem.assign_loc ge ty m b ofs v t m' ->
-  match chunk_for_volatile_type ty with
-  | None => t = E0 /\ Clight.assign_loc tge ty m b ofs v m'
-  | Some chunk => volatile_store tge chunk m b ofs v t m'
+  forall ty m b ofs bf v t m' v',
+  Csem.assign_loc ge ty m b ofs bf v t m' v' ->
+  match chunk_for_volatile_type ty bf with
+  | None => t = E0 /\ Clight.assign_loc tge ty m b ofs bf v m'
+  | Some chunk => bf = Full /\ volatile_store tge chunk m b ofs v t m'
   end.
 Proof.
   intros. unfold chunk_for_volatile_type. inv H.
-  (* By_value, not volatile *)
+- (* By_value, not volatile *)
   rewrite H1. split; auto. eapply assign_loc_value; eauto.
-  (* By_value, volatile *)
-  rewrite H0; rewrite H1. eapply volatile_store_preserved with (ge1 := ge); auto. apply senv_preserved.
-  (* By copy *)
+- (* By_value, volatile *)
+  rewrite H0, H1. split; auto. eapply volatile_store_preserved with (ge1 := ge); auto. apply senv_preserved.
+- (* By copy *)
   rewrite H0. rewrite <- comp_env_preserved in *.
   destruct (type_is_volatile ty); split; auto; eapply assign_loc_copy; eauto.
+- (* Bitfield *)
+  destruct (type_is_volatile ty); [destruct (access_mode ty)|]; eauto using assign_loc_bitfield.
+Qed.
+
+(** Bitfield accesses *)
+
+Lemma is_bitfield_access_sound: forall e le m a b ofs bf bf',
+  eval_lvalue tge e le m a b ofs bf ->
+  tr_is_bitfield_access ce a bf' ->
+  bf' = bf.
+Proof.
+  assert (A: forall id co co',
+             tge.(genv_cenv)!id = Some co -> ce!id = Some co' ->
+             co' = co /\ complete_members ce (co_members co) = true).
+  { intros. rewrite comp_env_preserved in H.
+    assert (ge.(Csem.genv_cenv) ! id = Some co') by (apply LINKORDER; auto).
+    replace co' with co in * by congruence.
+    split; auto. apply co_consistent_complete.
+    eapply build_composite_env_consistent. eapply prog_comp_env_eq. eauto.
+  } 
+  induction 1; simpl; auto.
+- rewrite H0. intros (co' & delta' & E1 & E2). rewrite comp_env_preserved in H2.
+  exploit A; eauto. intros (E3 & E4). subst co'.
+  assert (field_offset ge i (co_members co) = field_offset ce i (co_members co)).
+  { apply field_offset_stable. apply LINKORDER. auto. }
+  congruence.
+- rewrite H0. intros (co' & delta' & E1 & E2). rewrite comp_env_preserved in H2.
+  exploit A; eauto. intros (E3 & E4). subst co'.
+  assert (union_field_offset ge i (co_members co) = union_field_offset ce i (co_members co)).
+  { apply union_field_offset_stable. apply LINKORDER. auto. }
+  congruence.
+Qed.
+
+Lemma make_assign_value_sound:
+  forall ty m b ofs bf v t m' v',
+  Csem.assign_loc ge ty m b ofs bf v t m' v' ->
+  forall tge e le m'' r,
+  typeof r = ty ->
+  eval_expr tge e le m'' r v ->
+  eval_expr tge e le m'' (make_assign_value bf r) v'.
+Proof.
+  unfold make_assign_value; destruct 1; intros; auto.
+  inv H. eapply eval_make_normalize; eauto; lia.
+Qed.
+
+Lemma typeof_make_assign_value: forall bf r,
+  typeof (make_assign_value bf r) = typeof r.
+Proof.
+  intros. destruct bf; simpl; auto. unfold make_normalize.
+  destruct (intsize_eq sz IBool || signedness_eq sg Unsigned); auto.
 Qed.
 
 (** Evaluation of simple expressions and of their translation *)
@@ -215,7 +301,7 @@ Lemma tr_simple:
  (forall r v,
   eval_simple_rvalue ge e m r v ->
   forall le dst sl a tmps,
-  tr_expr le dst r sl a tmps ->
+  tr_expr ce le dst r sl a tmps ->
   match dst with
   | For_val => sl = nil /\ Csyntax.typeof r = typeof a /\ eval_expr tge e le m a v
   | For_effects => sl = nil
@@ -225,11 +311,11 @@ Lemma tr_simple:
              /\ eval_expr tge e le m b v
   end)
 /\
- (forall l b ofs,
-  eval_simple_lvalue ge e m l b ofs ->
+ (forall l b ofs bf,
+  eval_simple_lvalue ge e m l b ofs bf ->
   forall le sl a tmps,
-  tr_expr le For_val l sl a tmps ->
-  sl = nil /\ Csyntax.typeof l = typeof a /\ eval_lvalue tge e le m a b ofs).
+  tr_expr ce le For_val l sl a tmps ->
+  sl = nil /\ Csyntax.typeof l = typeof a /\ eval_lvalue tge e le m a b ofs bf).
 Proof.
 Opaque makeif.
   intros e m.
@@ -306,7 +392,7 @@ Lemma tr_simple_rvalue:
   forall e m r v,
   eval_simple_rvalue ge e m r v ->
   forall le dst sl a tmps,
-  tr_expr le dst r sl a tmps ->
+  tr_expr ce le dst r sl a tmps ->
   match dst with
   | For_val => sl = nil /\ Csyntax.typeof r = typeof a /\ eval_expr tge e le m a v
   | For_effects => sl = nil
@@ -320,18 +406,18 @@ Proof.
 Qed.
 
 Lemma tr_simple_lvalue:
-  forall e m l b ofs,
-  eval_simple_lvalue ge e m l b ofs ->
+  forall e m l b ofs bf,
+  eval_simple_lvalue ge e m l b ofs bf ->
   forall le sl a tmps,
-  tr_expr le For_val l sl a tmps ->
-  sl = nil /\ Csyntax.typeof l = typeof a /\ eval_lvalue tge e le m a b ofs.
+  tr_expr ce le For_val l sl a tmps ->
+  sl = nil /\ Csyntax.typeof l = typeof a /\ eval_lvalue tge e le m a b ofs bf.
 Proof.
   intros e m. exact (proj2 (tr_simple e m)).
 Qed.
 
 Lemma tr_simple_exprlist:
   forall le rl sl al tmps,
-  tr_exprlist le rl sl al tmps ->
+  tr_exprlist ce le rl sl al tmps ->
   forall e m tyl vl,
   eval_simple_list ge e m rl tyl vl ->
   sl = nil /\ eval_exprlist tge e le m al tyl vl.
@@ -362,29 +448,29 @@ Lemma tr_expr_leftcontext_rec:
  (
   forall from to C, leftcontext from to C ->
   forall le e dst sl a tmps,
-  tr_expr le dst (C e) sl a tmps ->
+  tr_expr ce le dst (C e) sl a tmps ->
   exists dst', exists sl1, exists sl2, exists a', exists tmp',
-  tr_expr le dst' e sl1 a' tmp'
+  tr_expr ce le dst' e sl1 a' tmp'
   /\ sl = sl1 ++ sl2
   /\ incl tmp' tmps
   /\ (forall le' e' sl3,
-        tr_expr le' dst' e' sl3 a' tmp' ->
+        tr_expr ce le' dst' e' sl3 a' tmp' ->
         (forall id, ~In id tmp' -> le'!id = le!id) ->
         Csyntax.typeof e' = Csyntax.typeof e ->
-        tr_expr le' dst (C e') (sl3 ++ sl2) a tmps)
+        tr_expr ce le' dst (C e') (sl3 ++ sl2) a tmps)
  ) /\ (
   forall from C, leftcontextlist from C ->
   forall le e sl a tmps,
-  tr_exprlist le (C e) sl a tmps ->
+  tr_exprlist ce le (C e) sl a tmps ->
   exists dst', exists sl1, exists sl2, exists a', exists tmp',
-  tr_expr le dst' e sl1 a' tmp'
+  tr_expr ce le dst' e sl1 a' tmp'
   /\ sl = sl1 ++ sl2
   /\ incl tmp' tmps
   /\ (forall le' e' sl3,
-        tr_expr le' dst' e' sl3 a' tmp' ->
+        tr_expr ce le' dst' e' sl3 a' tmp' ->
         (forall id, ~In id tmp' -> le'!id = le!id) ->
         Csyntax.typeof e' = Csyntax.typeof e ->
-        tr_exprlist le' (C e') (sl3 ++ sl2) a tmps)
+        tr_exprlist ce le' (C e') (sl3 ++ sl2) a tmps)
 ).
 Proof.
 
@@ -553,7 +639,7 @@ Ltac UNCHANGED :=
   red; auto.
   intros. rewrite <- app_ass. econstructor. apply S; auto.
   eapply tr_expr_invariant; eauto. UNCHANGED.
-  auto. auto. auto.
+  auto. auto. auto. auto.
 + (* for val *)
   exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]].
   TR. subst sl1. rewrite app_ass. eauto.
@@ -561,7 +647,7 @@ Ltac UNCHANGED :=
   intros. rewrite <- app_ass. econstructor. apply S; auto.
   eapply tr_expr_invariant; eauto. UNCHANGED.
   auto. auto. auto. auto. auto. auto.
-  eapply typeof_context; eauto.
+  eapply typeof_context. eauto. auto. eauto.
   auto.
 - (* assign right *)
   inv H2.
@@ -573,7 +659,7 @@ Ltac UNCHANGED :=
   intros. rewrite <- app_ass. change (sl3 ++ sl2') with (nil ++ (sl3 ++ sl2')). rewrite app_ass.
   econstructor.
   eapply tr_expr_invariant; eauto. UNCHANGED.
-  apply S; auto. auto. auto. auto.
+  apply S; auto. auto. auto. auto. auto.
 + (* for val *)
   assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl.
   exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]].
@@ -583,7 +669,7 @@ Ltac UNCHANGED :=
   econstructor.
   eapply tr_expr_invariant; eauto. UNCHANGED.
   apply S; auto. auto. auto. auto. auto. auto. auto. auto.
-  eapply typeof_context; eauto.
+  eapply typeof_context; eauto. auto.
 - (* assignop left *)
   inv H1.
 + (* for effects *)
@@ -593,7 +679,7 @@ Ltac UNCHANGED :=
   intros. rewrite <- app_ass. econstructor. apply S; auto.
   eapply tr_expr_invariant; eauto. UNCHANGED.
   symmetry; eapply typeof_context; eauto. eauto.
-  auto. auto. auto. auto. auto. auto.
+  auto. auto. auto. auto. auto. auto. auto.
 + (* for val *)
   exploit H0; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]].
   TR. subst sl1. rewrite app_ass. eauto.
@@ -601,7 +687,7 @@ Ltac UNCHANGED :=
   intros. rewrite <- app_ass. econstructor. apply S; auto.
   eapply tr_expr_invariant; eauto. UNCHANGED.
   eauto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto.
-  eapply typeof_context; eauto.
+  eapply typeof_context; eauto. auto.
 - (* assignop right *)
   inv H2.
 + (* for effects *)
@@ -611,7 +697,7 @@ Ltac UNCHANGED :=
   red; auto.
   intros. rewrite <- app_ass. change (sl0 ++ sl2') with (nil ++ sl0 ++ sl2'). rewrite app_ass. econstructor.
   eapply tr_expr_invariant; eauto. UNCHANGED.
-  apply S; auto. auto. eauto. auto. auto. auto. auto. auto. auto.
+  apply S; auto. auto. eauto. auto. auto. auto. auto. auto. auto. auto.
 + (* for val *)
   assert (sl1 = nil) by (eapply tr_simple_expr_nil; eauto). subst sl1; simpl.
   exploit H1; eauto. intros [dst' [sl1' [sl2' [a' [tmp' [P [Q [R S]]]]]]]].
@@ -619,7 +705,7 @@ Ltac UNCHANGED :=
   red; auto.
   intros. rewrite <- app_ass. change (sl0 ++ sl2') with (nil ++ sl0 ++ sl2'). rewrite app_ass. econstructor.
   eapply tr_expr_invariant; eauto. UNCHANGED.
-  apply S; auto. eauto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto.
+  apply S; auto. eauto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto. auto.
 - (* postincr *)
   inv H1.
 + (* for effects *)
@@ -725,35 +811,35 @@ Qed.
 Theorem tr_expr_leftcontext:
   forall C le r dst sl a tmps,
   leftcontext RV RV C ->
-  tr_expr le dst (C r) sl a tmps ->
+  tr_expr ce le dst (C r) sl a tmps ->
   exists dst', exists sl1, exists sl2, exists a', exists tmp',
-  tr_expr le dst' r sl1 a' tmp'
+  tr_expr ce le dst' r sl1 a' tmp'
   /\ sl = sl1 ++ sl2
   /\ incl tmp' tmps
   /\ (forall le' r' sl3,
-        tr_expr le' dst' r' sl3 a' tmp' ->
+        tr_expr ce le' dst' r' sl3 a' tmp' ->
         (forall id, ~In id tmp' -> le'!id = le!id) ->
         Csyntax.typeof r' = Csyntax.typeof r ->
-        tr_expr le' dst (C r') (sl3 ++ sl2) a tmps).
+        tr_expr ce le' dst (C r') (sl3 ++ sl2) a tmps).
 Proof.
   intros. eapply (proj1 tr_expr_leftcontext_rec); eauto.
 Qed.
 
 Theorem tr_top_leftcontext:
   forall e le m dst rtop sl a tmps,
-  tr_top tge e le m dst rtop sl a tmps ->
+  tr_top ce tge e le m dst rtop sl a tmps ->
   forall r C,
   rtop = C r ->
   leftcontext RV RV C ->
   exists dst', exists sl1, exists sl2, exists a', exists tmp',
-  tr_top tge e le m dst' r sl1 a' tmp'
+  tr_top ce tge e le m dst' r sl1 a' tmp'
   /\ sl = sl1 ++ sl2
   /\ incl tmp' tmps
   /\ (forall le' m' r' sl3,
-        tr_expr le' dst' r' sl3 a' tmp' ->
+        tr_expr ce le' dst' r' sl3 a' tmp' ->
         (forall id, ~In id tmp' -> le'!id = le!id) ->
         Csyntax.typeof r' = Csyntax.typeof r ->
-        tr_top tge e le' m' dst (C r') (sl3 ++ sl2) a tmps).
+        tr_top ce tge e le' m' dst (C r') (sl3 ++ sl2) a tmps).
 Proof.
   induction 1; intros.
 (* val for val *)
@@ -835,17 +921,18 @@ Proof.
 Qed.
 
 Lemma step_make_set:
-  forall id a ty m b ofs t v e le f k,
-  Csem.deref_loc ge ty m b ofs t v ->
-  eval_lvalue tge e le m a b ofs ->
+  forall id a ty m b ofs bf t v e le f k,
+  Csem.deref_loc ge ty m b ofs bf t v ->
+  eval_lvalue tge e le m a b ofs bf ->
   typeof a = ty ->
-  step1 tge (State f (make_set id a) k e le m)
+  step1 tge (State f (make_set bf id a) k e le m)
           t (State f Sskip k e (PTree.set id v le) m).
 Proof.
   intros. exploit deref_loc_translated; eauto. rewrite <- H1.
-  unfold make_set. destruct (chunk_for_volatile_type (typeof a)) as [chunk|].
+  unfold make_set. destruct (chunk_for_volatile_type (typeof a) bf) as [chunk|].
 (* volatile case *)
-  intros. change (PTree.set id v le) with (set_opttemp (Some id) v le). econstructor.
+  intros [A B]. subst bf.
+  change (PTree.set id v le) with (set_opttemp (Some id) v le). econstructor.
   econstructor. constructor. eauto.
   simpl. unfold sem_cast. simpl. eauto. constructor.
   simpl. econstructor; eauto.
@@ -854,19 +941,19 @@ Proof.
 Qed.
 
 Lemma step_make_assign:
-  forall a1 a2 ty m b ofs t v m' v2 e le f k,
-  Csem.assign_loc ge ty m b ofs v t m' ->
-  eval_lvalue tge e le m a1 b ofs ->
+  forall a1 a2 ty m b ofs bf t v m' v' v2 e le f k,
+  Csem.assign_loc ge ty m b ofs bf v t m' v' ->
+  eval_lvalue tge e le m a1 b ofs bf ->
   eval_expr tge e le m a2 v2 ->
   sem_cast v2 (typeof a2) ty m = Some v ->
   typeof a1 = ty ->
-  step1 tge (State f (make_assign a1 a2) k e le m)
+  step1 tge (State f (make_assign bf a1 a2) k e le m)
           t (State f Sskip k e le m').
 Proof.
   intros. exploit assign_loc_translated; eauto. rewrite <- H3.
-  unfold make_assign. destruct (chunk_for_volatile_type (typeof a1)) as [chunk|].
+  unfold make_assign. destruct (chunk_for_volatile_type (typeof a1) bf) as [chunk|].
 (* volatile case *)
-  intros. change le with (set_opttemp None Vundef le) at 2. econstructor.
+  intros [A B]. subst bf. change le with (set_opttemp None Vundef le) at 2. econstructor.
   econstructor. constructor. eauto.
   simpl. unfold sem_cast. simpl. eauto.
   econstructor; eauto. rewrite H3; eauto. constructor.
@@ -900,10 +987,10 @@ Proof.
 Qed.
 
 Lemma step_tr_rvalof:
-  forall ty m b ofs t v e le a sl a' tmp f k,
-  Csem.deref_loc ge ty m b ofs t v ->
-  eval_lvalue tge e le m a b ofs ->
-  tr_rvalof ty a sl a' tmp ->
+  forall ty m b ofs bf t v e le a sl a' tmp f k,
+  Csem.deref_loc ge ty m b ofs bf t v ->
+  eval_lvalue tge e le m a b ofs bf ->
+  tr_rvalof ce ty a sl a' tmp ->
   typeof a = ty ->
   exists le',
     star step1 tge (State f Sskip (Kseqlist sl k) e le m)
@@ -920,141 +1007,149 @@ Proof.
   split. eapply eval_Elvalue; eauto.
   auto.
   (* volatile *)
-  intros. exists (PTree.set t0 v le); split.
+  intros.
+  exploit is_bitfield_access_sound; eauto. intros EQ; subst bf0. 
+  exists (PTree.set t0 v le); split.
   simpl. eapply star_two. econstructor. eapply step_make_set; eauto. traceEq.
   split. constructor. apply PTree.gss.
   split. auto.
   intros. apply PTree.gso. congruence.
 Qed.
 
+End TRANSLATION.
+
+
 (** Matching between continuations *)
 
-Inductive match_cont : Csem.cont -> cont -> Prop :=
-  | match_Kstop:
-      match_cont Csem.Kstop Kstop
-  | match_Kseq: forall s k ts tk,
-      tr_stmt s ts ->
-      match_cont k tk ->
-      match_cont (Csem.Kseq s k) (Kseq ts tk)
-  | match_Kwhile2: forall r s k s' ts tk,
-      tr_if r Sskip Sbreak s' ->
-      tr_stmt s ts ->
-      match_cont k tk ->
-      match_cont (Csem.Kwhile2 r s k)
-                 (Kloop1 (Ssequence s' ts) Sskip tk)
-  | match_Kdowhile1: forall r s k s' ts tk,
-      tr_if r Sskip Sbreak s' ->
-      tr_stmt s ts ->
-      match_cont k tk ->
-      match_cont (Csem.Kdowhile1 r s k)
-                 (Kloop1 ts s' tk)
-  | match_Kfor3: forall r s3 s k ts3 s' ts tk,
-      tr_if r Sskip Sbreak s' ->
-      tr_stmt s3 ts3 ->
-      tr_stmt s ts ->
-      match_cont k tk ->
-      match_cont (Csem.Kfor3 r s3 s k)
-                 (Kloop1 (Ssequence s' ts) ts3 tk)
-  | match_Kfor4: forall r s3 s k ts3 s' ts tk,
-      tr_if r Sskip Sbreak s' ->
-      tr_stmt s3 ts3 ->
-      tr_stmt s ts ->
-      match_cont k tk ->
-      match_cont (Csem.Kfor4 r s3 s k)
-                 (Kloop2 (Ssequence s' ts) ts3 tk)
-  | match_Kswitch2: forall k tk,
-      match_cont k tk ->
-      match_cont (Csem.Kswitch2 k) (Kswitch tk)
-  | match_Kcall: forall f e C ty k optid tf le sl tk a dest tmps,
-      tr_function f tf ->
-      leftcontext RV RV C ->
-      (forall v m, tr_top tge e (set_opttemp optid v le) m dest (C (Csyntax.Eval v ty)) sl a tmps) ->
-      match_cont_exp dest a k tk ->
-      match_cont (Csem.Kcall f e C ty k)
-                 (Kcall optid tf e le (Kseqlist sl tk))
-(*
-  | match_Kcall_some: forall f e C ty k dst tf le sl tk a dest tmps,
-      transl_function f = Errors.OK tf ->
+Inductive match_cont : composite_env -> Csem.cont -> cont -> Prop :=
+  | match_Kstop: forall ce,
+      match_cont ce Csem.Kstop Kstop
+  | match_Kseq: forall ce s k ts tk,
+      tr_stmt ce s ts ->
+      match_cont ce k tk ->
+      match_cont ce (Csem.Kseq s k) (Kseq ts tk)
+  | match_Kwhile2: forall ce r s k s' ts tk,
+      tr_if ce r Sskip Sbreak s' ->
+      tr_stmt ce s ts ->
+      match_cont ce k tk ->
+      match_cont ce (Csem.Kwhile2 r s k)
+                    (Kloop1 (Ssequence s' ts) Sskip tk)
+  | match_Kdowhile1: forall ce r s k s' ts tk,
+      tr_if ce r Sskip Sbreak s' ->
+      tr_stmt ce s ts ->
+      match_cont ce k tk ->
+      match_cont ce (Csem.Kdowhile1 r s k)
+                    (Kloop1 ts s' tk)
+  | match_Kfor3: forall ce r s3 s k ts3 s' ts tk,
+      tr_if ce r Sskip Sbreak s' ->
+      tr_stmt ce s3 ts3 ->
+      tr_stmt ce s ts ->
+      match_cont ce k tk ->
+      match_cont ce (Csem.Kfor3 r s3 s k)
+                    (Kloop1 (Ssequence s' ts) ts3 tk)
+  | match_Kfor4: forall ce r s3 s k ts3 s' ts tk,
+      tr_if ce r Sskip Sbreak s' ->
+      tr_stmt ce s3 ts3 ->
+      tr_stmt ce s ts ->
+      match_cont ce k tk ->
+      match_cont ce (Csem.Kfor4 r s3 s k)
+                    (Kloop2 (Ssequence s' ts) ts3 tk)
+  | match_Kswitch2: forall ce k tk,
+      match_cont ce k tk ->
+      match_cont ce (Csem.Kswitch2 k) (Kswitch tk)
+  | match_Kcall: forall f e C ty k optid tf le sl tk a dest tmps cu ce,
+      linkorder cu prog ->
+      tr_function cu.(prog_comp_env) f tf ->
       leftcontext RV RV C ->
-      (forall v m, tr_top tge e (PTree.set dst v le) m dest (C (C.Eval v ty)) sl a tmps) ->
-      match_cont_exp dest a k tk ->
-      match_cont (Csem.Kcall f e C ty k)
-                 (Kcall (Some dst) tf e le (Kseqlist sl tk))
-*)
-
-with match_cont_exp : destination -> expr -> Csem.cont -> cont -> Prop :=
-  | match_Kdo: forall k a tk,
-      match_cont k tk ->
-      match_cont_exp For_effects a (Csem.Kdo k) tk
-  | match_Kifthenelse_empty: forall a k tk,
-      match_cont k tk ->
-      match_cont_exp For_val a (Csem.Kifthenelse Csyntax.Sskip Csyntax.Sskip k) (Kseq Sskip tk)
-  | match_Kifthenelse_1: forall a s1 s2 k ts1 ts2 tk,
-      tr_stmt s1 ts1 -> tr_stmt s2 ts2 ->
-      match_cont k tk ->
-      match_cont_exp For_val a (Csem.Kifthenelse s1 s2 k) (Kseq (Sifthenelse a ts1 ts2) tk)
-  | match_Kwhile1: forall r s k s' a ts tk,
-      tr_if r Sskip Sbreak s' ->
-      tr_stmt s ts ->
-      match_cont k tk ->
-      match_cont_exp For_val a
+      (forall v m, tr_top cu.(prog_comp_env) tge e (set_opttemp optid v le) m dest (C (Csyntax.Eval v ty)) sl a tmps) ->
+      match_cont_exp cu.(prog_comp_env) dest a k tk ->
+      match_cont ce (Csem.Kcall f e C ty k)
+                    (Kcall optid tf e le (Kseqlist sl tk))
+
+with match_cont_exp : composite_env -> destination -> expr -> Csem.cont -> cont -> Prop :=
+  | match_Kdo: forall ce k a tk,
+      match_cont ce k tk ->
+      match_cont_exp ce For_effects a (Csem.Kdo k) tk
+  | match_Kifthenelse_empty: forall ce a k tk,
+      match_cont ce k tk ->
+      match_cont_exp ce For_val a (Csem.Kifthenelse Csyntax.Sskip Csyntax.Sskip k) (Kseq Sskip tk)
+  | match_Kifthenelse_1: forall ce a s1 s2 k ts1 ts2 tk,
+      tr_stmt ce s1 ts1 -> tr_stmt ce s2 ts2 ->
+      match_cont ce k tk ->
+      match_cont_exp ce For_val a (Csem.Kifthenelse s1 s2 k) (Kseq (Sifthenelse a ts1 ts2) tk)
+  | match_Kwhile1: forall ce r s k s' a ts tk,
+      tr_if ce r Sskip Sbreak s' ->
+      tr_stmt ce s ts ->
+      match_cont ce k tk ->
+      match_cont_exp ce For_val a
          (Csem.Kwhile1 r s k)
          (Kseq (makeif a Sskip Sbreak)
            (Kseq ts (Kloop1 (Ssequence s' ts) Sskip tk)))
-  | match_Kdowhile2: forall r s k s' a ts tk,
-      tr_if r Sskip Sbreak s' ->
-      tr_stmt s ts ->
-      match_cont k tk ->
-      match_cont_exp For_val a
+  | match_Kdowhile2: forall ce r s k s' a ts tk,
+      tr_if ce r Sskip Sbreak s' ->
+      tr_stmt ce s ts ->
+      match_cont ce k tk ->
+      match_cont_exp ce For_val a
         (Csem.Kdowhile2 r s k)
         (Kseq (makeif a Sskip Sbreak) (Kloop2 ts s' tk))
-  | match_Kfor2: forall r s3 s k s' a ts3 ts tk,
-      tr_if r Sskip Sbreak s' ->
-      tr_stmt s3 ts3 ->
-      tr_stmt s ts ->
-      match_cont k tk ->
-      match_cont_exp For_val a
+  | match_Kfor2: forall ce r s3 s k s' a ts3 ts tk,
+      tr_if ce r Sskip Sbreak s' ->
+      tr_stmt ce s3 ts3 ->
+      tr_stmt ce s ts ->
+      match_cont ce k tk ->
+      match_cont_exp ce For_val a
         (Csem.Kfor2 r s3 s k)
         (Kseq (makeif a Sskip Sbreak)
           (Kseq ts (Kloop1 (Ssequence s' ts) ts3 tk)))
-  | match_Kswitch1: forall ls k a tls tk,
-      tr_lblstmts ls tls ->
-      match_cont k tk ->
-      match_cont_exp For_val a (Csem.Kswitch1 ls k) (Kseq (Sswitch a tls) tk)
-  | match_Kreturn: forall k a tk,
-      match_cont k tk ->
-      match_cont_exp For_val a (Csem.Kreturn k) (Kseq (Sreturn (Some a)) tk).
-
-Lemma match_cont_call:
-  forall k tk,
-  match_cont k tk ->
-  match_cont (Csem.call_cont k) (call_cont tk).
+  | match_Kswitch1: forall ce ls k a tls tk,
+      tr_lblstmts ce ls tls ->
+      match_cont ce k tk ->
+      match_cont_exp ce For_val a (Csem.Kswitch1 ls k) (Kseq (Sswitch a tls) tk)
+  | match_Kreturn: forall ce k a tk,
+      match_cont ce k tk ->
+      match_cont_exp ce For_val a (Csem.Kreturn k) (Kseq (Sreturn (Some a)) tk).
+
+Lemma match_cont_is_call_cont:
+  forall ce k tk,
+  match_cont ce k tk -> Csem.is_call_cont k ->
+  forall ce', match_cont ce' k tk.
 Proof.
-  induction 1; simpl; auto. constructor. econstructor; eauto.
+  destruct 1; simpl; intros; try contradiction; econstructor; eauto.
+Qed. 
+
+Lemma match_cont_call_cont:
+  forall ce k tk,
+  match_cont ce k tk ->
+  forall ce', match_cont ce' (Csem.call_cont k) (call_cont tk).
+Proof.
+  induction 1; simpl; auto; intros; econstructor; eauto.
 Qed.
 
 (** Matching between states *)
 
 Inductive match_states: Csem.state -> state -> Prop :=
-  | match_exprstates: forall f r k e m tf sl tk le dest a tmps,
-      tr_function f tf ->
-      tr_top tge e le m dest r sl a tmps ->
-      match_cont_exp dest a k tk ->
+  | match_exprstates: forall f r k e m tf sl tk le dest a tmps cu
+      (LINK: linkorder cu prog)
+      (TRF: tr_function cu.(prog_comp_env) f tf)
+      (TR: tr_top cu.(prog_comp_env) tge e le m dest r sl a tmps)
+      (MK: match_cont_exp cu.(prog_comp_env) dest a k tk),
       match_states (Csem.ExprState f r k e m)
                    (State tf Sskip (Kseqlist sl tk) e le m)
-  | match_regularstates: forall f s k e m tf ts tk le,
-      tr_function f tf ->
-      tr_stmt s ts ->
-      match_cont k tk ->
+  | match_regularstates: forall f s k e m tf ts tk le cu
+      (LINK: linkorder cu prog)
+      (TRF: tr_function cu.(prog_comp_env) f tf)
+      (TR: tr_stmt cu.(prog_comp_env) s ts)
+      (MK: match_cont cu.(prog_comp_env) k tk),
       match_states (Csem.State f s k e m)
                    (State tf ts tk e le m)
-  | match_callstates: forall fd args k m tfd tk,
-      tr_fundef fd tfd ->
-      match_cont k tk ->
+  | match_callstates: forall fd args k m tfd tk cu
+      (LINK: linkorder cu prog)
+      (TR: tr_fundef cu fd tfd)
+      (MK: forall ce, match_cont ce k tk),
       match_states (Csem.Callstate fd args k m)
                    (Callstate tfd args tk m)
-  | match_returnstates: forall res k m tk,
-      match_cont k tk ->
+  | match_returnstates: forall res k m tk
+      (MK: forall ce, match_cont ce k tk),
       match_states (Csem.Returnstate res k m)
                    (Returnstate res tk m)
   | match_stuckstate: forall S,
@@ -1063,21 +1158,22 @@ Inductive match_states: Csem.state -> state -> Prop :=
 (** Additional results on translation of statements *)
 
 Lemma tr_select_switch:
-  forall n ls tls,
-  tr_lblstmts ls tls ->
-  tr_lblstmts (Csem.select_switch n ls) (select_switch n tls).
+  forall ce n ls tls,
+  tr_lblstmts ce ls tls ->
+  tr_lblstmts ce (Csem.select_switch n ls) (select_switch n tls).
 Proof.
+  intros ce.
   assert (DFL: forall ls tls,
-      tr_lblstmts ls tls ->
-      tr_lblstmts (Csem.select_switch_default ls) (select_switch_default tls)).
+      tr_lblstmts ce ls tls ->
+      tr_lblstmts ce (Csem.select_switch_default ls) (select_switch_default tls)).
   { induction 1; simpl. constructor. destruct c; auto. constructor; auto. }
   assert (CASE: forall n ls tls,
-      tr_lblstmts ls tls ->
+      tr_lblstmts ce ls tls ->
       match Csem.select_switch_case n ls with
       | None =>
           select_switch_case n tls = None
       | Some ls' =>
-          exists tls', select_switch_case n tls = Some tls' /\ tr_lblstmts ls' tls'
+          exists tls', select_switch_case n tls = Some tls' /\ tr_lblstmts ce ls' tls'
       end).
   { induction 1; simpl; intros.
     auto.
@@ -1091,9 +1187,9 @@ Proof.
 Qed.
 
 Lemma tr_seq_of_labeled_statement:
-  forall ls tls,
-  tr_lblstmts ls tls ->
-  tr_stmt (Csem.seq_of_labeled_statement ls) (seq_of_labeled_statement tls).
+  forall ce ls tls,
+  tr_lblstmts ce ls tls ->
+  tr_stmt ce (Csem.seq_of_labeled_statement ls) (seq_of_labeled_statement tls).
 Proof.
   induction 1; simpl; constructor; auto.
 Qed.
@@ -1102,6 +1198,7 @@ Qed.
 
 Section FIND_LABEL.
 
+Variable ce: composite_env.
 Variable lbl: label.
 
 Definition nolabel (s: statement) : Prop :=
@@ -1137,21 +1234,21 @@ Proof.
 Qed.
 
 Lemma make_set_nolabel:
-  forall t a, nolabel (make_set t a).
+  forall bf t a, nolabel (make_set bf t a).
 Proof.
   unfold make_set; intros; red; intros.
-  destruct (chunk_for_volatile_type (typeof a)); auto.
+  destruct (chunk_for_volatile_type (typeof a) bf); auto.
 Qed.
 
 Lemma make_assign_nolabel:
-  forall l r, nolabel (make_assign l r).
+  forall bf l r, nolabel (make_assign bf l r).
 Proof.
   unfold make_assign; intros; red; intros.
-  destruct (chunk_for_volatile_type (typeof l)); auto.
+  destruct (chunk_for_volatile_type (typeof l) bf); auto.
 Qed.
 
 Lemma tr_rvalof_nolabel:
-  forall ty a sl a' tmp, tr_rvalof ty a sl a' tmp -> nolabel_list sl.
+  forall ce ty a sl a' tmp, tr_rvalof ce ty a sl a' tmp -> nolabel_list sl.
 Proof.
   destruct 1; simpl; intuition. apply make_set_nolabel.
 Qed.
@@ -1177,16 +1274,16 @@ Ltac NoLabelTac :=
   | [ H: _ -> nolabel_list ?x |- nolabel_list ?x ] => apply H; NoLabelTac
   | [ |- nolabel (makeseq _) ] => apply makeseq_nolabel; NoLabelTac
   | [ |- nolabel (makeif _ _ _) ] => apply makeif_nolabel; NoLabelTac
-  | [ |- nolabel (make_set _ _) ] => apply make_set_nolabel
-  | [ |- nolabel (make_assign _ _) ] => apply make_assign_nolabel
+  | [ |- nolabel (make_set _ _ _) ] => apply make_set_nolabel
+  | [ |- nolabel (make_assign _ _ _) ] => apply make_assign_nolabel
   | [ |- nolabel _ ] => red; intros; simpl; auto
   | [ |- _ /\ _ ] => split; NoLabelTac
   | _ => auto
   end.
 
 Lemma tr_find_label_expr:
-  (forall le dst r sl a tmps, tr_expr le dst r sl a tmps -> nolabel_list sl)
-/\(forall le rl sl al tmps, tr_exprlist le rl sl al tmps -> nolabel_list sl).
+  (forall le dst r sl a tmps, tr_expr ce le dst r sl a tmps -> nolabel_list sl)
+/\(forall le rl sl al tmps, tr_exprlist ce le rl sl al tmps -> nolabel_list sl).
 Proof.
   apply tr_expr_exprlist; intros; NoLabelTac.
   apply nolabel_do_set.
@@ -1200,14 +1297,14 @@ Qed.
 
 Lemma tr_find_label_top:
   forall e le m dst r sl a tmps,
-  tr_top tge e le m dst r sl a tmps -> nolabel_list sl.
+  tr_top ce tge e le m dst r sl a tmps -> nolabel_list sl.
 Proof.
   induction 1; intros; NoLabelTac.
   eapply (proj1 tr_find_label_expr); eauto.
 Qed.
 
 Lemma tr_find_label_expression:
-  forall r s a, tr_expression r s a -> forall k, find_label lbl s k = None.
+  forall r s a, tr_expression ce r s a -> forall k, find_label lbl s k = None.
 Proof.
   intros. inv H.
   assert (nolabel (makeseq sl)). apply makeseq_nolabel.
@@ -1216,7 +1313,7 @@ Proof.
 Qed.
 
 Lemma tr_find_label_expr_stmt:
-  forall r s, tr_expr_stmt r s -> forall k, find_label lbl s k = None.
+  forall r s, tr_expr_stmt ce r s -> forall k, find_label lbl s k = None.
 Proof.
   intros. inv H.
   assert (nolabel (makeseq sl)). apply makeseq_nolabel.
@@ -1226,7 +1323,7 @@ Qed.
 
 Lemma tr_find_label_if:
   forall r s,
-  tr_if r Sskip Sbreak s ->
+  tr_if ce r Sskip Sbreak s ->
   forall k, find_label lbl s k = None.
 Proof.
   intros. inv H.
@@ -1241,29 +1338,29 @@ Qed.
 
 Lemma tr_find_label:
   forall s k ts tk
-    (TR: tr_stmt s ts)
-    (MC: match_cont k tk),
+    (TR: tr_stmt ce s ts)
+    (MC: match_cont ce k tk),
   match Csem.find_label lbl s k with
   | None =>
       find_label lbl ts tk = None
   | Some (s', k') =>
       exists ts', exists tk',
           find_label lbl ts tk = Some (ts', tk')
-       /\ tr_stmt s' ts'
-       /\ match_cont k' tk'
+       /\ tr_stmt ce s' ts'
+       /\ match_cont ce k' tk'
   end
 with tr_find_label_ls:
   forall s k ts tk
-    (TR: tr_lblstmts s ts)
-    (MC: match_cont k tk),
+    (TR: tr_lblstmts ce s ts)
+    (MC: match_cont ce k tk),
   match Csem.find_label_ls lbl s k with
   | None =>
       find_label_ls lbl ts tk = None
   | Some (s', k') =>
       exists ts', exists tk',
           find_label_ls lbl ts tk = Some (ts', tk')
-       /\ tr_stmt s' ts'
-       /\ match_cont k' tk'
+       /\ tr_stmt ce s' ts'
+       /\ match_cont ce k' tk'
   end.
 Proof.
   induction s; intros; inversion TR; subst; clear TR; simpl.
@@ -1362,7 +1459,7 @@ The following measure decreases for these stuttering steps. *)
 
 Fixpoint esize (a: Csyntax.expr) : nat :=
   match a with
-  | Csyntax.Eloc _ _ _ => 1%nat
+  | Csyntax.Eloc _ _ _ _ => 1%nat
   | Csyntax.Evar _ _ => 1%nat
   | Csyntax.Ederef r1 _ => S(esize r1)
   | Csyntax.Efield l1 _ _ => S(esize l1)
@@ -1423,12 +1520,12 @@ Qed.
 (** Forward simulation for expressions. *)
 
 Lemma tr_val_gen:
-  forall le dst v ty a tmp,
+  forall ce le dst v ty a tmp,
   typeof a = ty ->
   (forall tge e le' m,
       (forall id, In id tmp -> le'!id = le!id) ->
       eval_expr tge e le' m a v) ->
-  tr_expr le dst (Csyntax.Eval v ty) (final dst a) a tmp.
+  tr_expr ce le dst (Csyntax.Eval v ty) (final dst a) a tmp.
 Proof.
   intros. destruct dst; simpl; econstructor; auto.
 Qed.
@@ -1441,43 +1538,53 @@ Lemma estep_simulation:
        (star step1 tge S1' t S2' /\ measure S2 < measure S1)%nat)
   /\ match_states S2 S2'.
 Proof.
+
+Ltac NOTIN :=
+  match goal with
+  | [ H1: In ?x ?l, H2: list_disjoint ?l _ |- ~In ?x _ ] =>
+        red; intro; elim (H2 x x); auto; fail
+  | [ H1: In ?x ?l, H2: list_disjoint _ ?l |- ~In ?x _ ] =>
+        red; intro; elim (H2 x x); auto; fail
+  end.
+
   induction 1; intros; inv MS.
-(* expr *)
-  assert (tr_expr le dest r sl a tmps).
-    inv H9. contradiction. auto.
+- (* expr *)
+  assert (tr_expr (prog_comp_env cu) le dest r sl a tmps).
+  { inv TR. contradiction. auto. }
   exploit tr_simple_rvalue; eauto. destruct dest.
-  (* for val *)
++ (* for val *)
   intros [SL1 [TY1 EV1]]. subst sl.
   econstructor; split.
   right; split. apply star_refl. destruct r; simpl; (contradiction || lia).
   econstructor; eauto.
   instantiate (1 := tmps). apply tr_top_val_val; auto.
-  (* for effects *)
++ (* for effects *)
   intros SL1. subst sl.
   econstructor; split.
   right; split. apply star_refl. destruct r; simpl; (contradiction || lia).
   econstructor; eauto.
   instantiate (1 := tmps). apply tr_top_base. constructor.
-  (* for set *)
-  inv H10.
-(* rval volatile *)
-  exploit tr_top_leftcontext; eauto. clear H11.
++ (* for set *)
+  inv MK.
+- (* rval volatile *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H2. inv H7; try congruence.
   exploit tr_simple_lvalue; eauto. intros [SL [TY EV]]. subst sl0; simpl.
+  exploit is_bitfield_access_sound; eauto. intros EQ; subst bf0.
   econstructor; split.
   left. eapply plus_two. constructor. eapply step_make_set; eauto. traceEq.
   econstructor; eauto.
   change (final dst' (Etempvar t0 (Csyntax.typeof l)) ++ sl2) with (nil ++ (final dst' (Etempvar t0 (Csyntax.typeof l)) ++ sl2)).
   apply S. apply tr_val_gen. auto.
-  intros. constructor. rewrite H5; auto. apply PTree.gss.
-  intros. apply PTree.gso. red; intros; subst; elim H5; auto.
+  intros. constructor. rewrite H7; auto. apply PTree.gss.
+  intros. apply PTree.gso. red; intros; subst; elim H7; auto.
   auto.
-(* seqand true *)
-  exploit tr_top_leftcontext; eauto. clear H9.
+- (* seqand true *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H2.
-  (* for val *)
++ (* for val *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1488,7 +1595,7 @@ Proof.
   eapply match_exprstates; eauto.
   apply S. apply tr_paren_val with (a1 := a2); auto.
   apply tr_expr_monotone with tmp2; eauto. auto. auto.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1499,7 +1606,7 @@ Proof.
   eapply match_exprstates; eauto.
   apply S. apply tr_paren_effects with (a1 := a2); auto.
   apply tr_expr_monotone with tmp2; eauto. auto. auto.
-  (* for set *)
++  (* for set *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1510,11 +1617,11 @@ Proof.
   eapply match_exprstates; eauto.
   apply S. apply tr_paren_set with (a1 := a2) (t := sd_temp sd); auto.
   apply tr_expr_monotone with tmp2; eauto. auto. auto.
-(* seqand false *)
-  exploit tr_top_leftcontext; eauto. clear H9.
+- (* seqand false *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H2.
-  (* for val *)
++ (* for val *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1526,7 +1633,7 @@ Proof.
   intros. constructor. rewrite H2. apply PTree.gss. auto.
   intros. apply PTree.gso. congruence.
   auto.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1536,7 +1643,7 @@ Proof.
   eapply match_exprstates; eauto.
   change sl2 with (nil ++ sl2). apply S. econstructor; eauto.
   auto. auto.
-  (* for set *)
++ (* for set *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1546,11 +1653,11 @@ Proof.
   rewrite <- Kseqlist_app.
   eapply match_exprstates; eauto.
   apply S. econstructor; eauto. intros. constructor. auto. auto.
-(* seqor true *)
-  exploit tr_top_leftcontext; eauto. clear H9.
+- (* seqor true *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H2.
-  (* for val *)
++ (* for val *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1562,7 +1669,7 @@ Proof.
   intros. constructor. rewrite H2. apply PTree.gss. auto.
   intros. apply PTree.gso. congruence.
   auto.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1572,7 +1679,7 @@ Proof.
   eapply match_exprstates; eauto.
   change sl2 with (nil ++ sl2). apply S. econstructor; eauto.
   auto. auto.
-  (* for set *)
++ (* for set *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1582,11 +1689,11 @@ Proof.
   rewrite <- Kseqlist_app.
   eapply match_exprstates; eauto.
   apply S. econstructor; eauto. intros. constructor. auto. auto.
-(* seqand false *)
-  exploit tr_top_leftcontext; eauto. clear H9.
+- (* seqand false *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H2.
-  (* for val *)
++ (* for val *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1597,7 +1704,7 @@ Proof.
   eapply match_exprstates; eauto.
   apply S. apply tr_paren_val with (a1 := a2); auto.
   apply tr_expr_monotone with tmp2; eauto. auto. auto.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1608,7 +1715,7 @@ Proof.
   eapply match_exprstates; eauto.
   apply S. apply tr_paren_effects with (a1 := a2); auto.
   apply tr_expr_monotone with tmp2; eauto. auto. auto.
-  (* for set *)
++ (* for set *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist.
   econstructor; split.
@@ -1619,11 +1726,11 @@ Proof.
   eapply match_exprstates; eauto.
   apply S. apply tr_paren_set with (a1 := a2) (t := sd_temp sd); auto.
   apply tr_expr_monotone with tmp2; eauto. auto. auto.
-(* condition *)
-  exploit tr_top_leftcontext; eauto. clear H9.
+- (* condition *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H2.
-  (* for value *)
++ (* for value *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist. destruct b.
   econstructor; split.
@@ -1640,7 +1747,7 @@ Proof.
   rewrite <- Kseqlist_app.
   eapply match_exprstates; eauto.
   apply S. econstructor; eauto. apply tr_expr_monotone with tmp3; eauto. auto. auto.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist. destruct b.
   econstructor; split.
@@ -1649,7 +1756,7 @@ Proof.
   apply push_seq.
   reflexivity. traceEq.
   rewrite <- Kseqlist_app.
-  econstructor. eauto. apply S.
+  econstructor; eauto. apply S.
     econstructor; eauto. apply tr_expr_monotone with tmp2; eauto.
     econstructor; eauto.
   auto. auto.
@@ -1659,11 +1766,11 @@ Proof.
   apply push_seq.
   reflexivity. traceEq.
   rewrite <- Kseqlist_app.
-  econstructor. eauto. apply S.
+  econstructor; eauto. apply S.
     econstructor; eauto. apply tr_expr_monotone with tmp3; eauto.
     econstructor; eauto.
-  auto. auto.
-  (* for set *)
+  auto.
++ (* for set *)
   exploit tr_simple_rvalue; eauto. intros [SL [TY EV]].
   subst sl0; simpl Kseqlist. destruct b.
   econstructor; split.
@@ -1672,40 +1779,42 @@ Proof.
   apply push_seq.
   reflexivity. traceEq.
   rewrite <- Kseqlist_app.
-  econstructor. eauto. apply S.
+  econstructor; eauto. apply S.
     econstructor; eauto. apply tr_expr_monotone with tmp2; eauto.
     econstructor; eauto.
-  auto. auto.
+  auto.
   econstructor; split.
   left. eapply plus_left. constructor.
   eapply star_trans. apply step_makeif with (b := false) (v1 := v); auto. congruence.
   apply push_seq.
   reflexivity. traceEq.
   rewrite <- Kseqlist_app.
-  econstructor. eauto. apply S.
+  econstructor; eauto. apply S.
     econstructor; eauto. apply tr_expr_monotone with tmp3; eauto.
     econstructor; eauto.
-  auto. auto.
-(* assign *)
-  exploit tr_top_leftcontext; eauto. clear H12.
+  auto.
+- (* assign *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H4.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]].
   exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
+  assert (bf0 = bf) by (eapply is_bitfield_access_sound; eauto).
   subst; simpl Kseqlist.
   econstructor; split.
   left. eapply plus_left. constructor.
   apply star_one. eapply step_make_assign; eauto.
   rewrite <- TY2; eauto. traceEq.
-  econstructor. auto. change sl2 with (nil ++ sl2). apply S.
-  constructor. auto. auto. auto.
-  (* for value *)
+  econstructor; eauto. change sl2 with (nil ++ sl2). apply S.
+  constructor. auto. auto.
++ (* for value *)
   exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]].
   exploit tr_simple_lvalue. eauto.
-    eapply tr_expr_invariant with (le' := PTree.set t0 v' le). eauto.
+    eapply tr_expr_invariant with (le' := PTree.set t0 v1 le). eauto.
     intros. apply PTree.gso. intuition congruence.
   intros [SL1 [TY1 EV1]].
+  assert (bf0 = bf) by (eapply is_bitfield_access_sound; eauto).
   subst; simpl Kseqlist.
   econstructor; split.
   left. eapply plus_left. constructor.
@@ -1714,22 +1823,24 @@ Proof.
   apply star_one. eapply step_make_assign; eauto.
   constructor. apply PTree.gss. simpl. eapply cast_idempotent; eauto. 
   reflexivity. reflexivity. traceEq.
-  econstructor. auto. apply S.
-  apply tr_val_gen. auto. intros. constructor.
-  rewrite H4; auto. apply PTree.gss.
+  econstructor; eauto. apply S.
+  apply tr_val_gen. rewrite typeof_make_assign_value; auto.
+  intros. eapply make_assign_value_sound; eauto. 
+  constructor. rewrite H4; auto. apply PTree.gss.
   intros. apply PTree.gso. intuition congruence.
-  auto. auto.
-(* assignop *)
-  exploit tr_top_leftcontext; eauto. clear H15.
+  auto.
+- (* assignop *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H6.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
   exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]].
   exploit tr_simple_lvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto.
   intros. apply INV. NOTIN. intros [? [? EV1']].
   exploit tr_simple_rvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto.
   intros. apply INV. NOTIN. simpl. intros [SL2 [TY2 EV2]].
+  assert (bf0 = bf) by (eapply is_bitfield_access_sound; eauto).
   subst; simpl Kseqlist.
   econstructor; split.
   left. eapply star_plus_trans. rewrite app_ass. rewrite Kseqlist_app. eexact EXEC.
@@ -1737,9 +1848,9 @@ Proof.
     econstructor. eexact EV3. eexact EV2.
     rewrite TY3; rewrite <- TY1; rewrite <- TY2; rewrite comp_env_preserved; auto.
   reflexivity. traceEq.
-  econstructor. auto. change sl2 with (nil ++ sl2). apply S.
-  constructor. auto. auto. auto.
-  (* for value *)
+  econstructor; eauto. change sl2 with (nil ++ sl2). apply S.
+  constructor. auto. auto.
++ (* for value *)
   exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
   exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]].
   exploit tr_simple_lvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto.
@@ -1750,6 +1861,7 @@ Proof.
     eapply tr_expr_invariant with (le := le) (le' := PTree.set t v4 le'). eauto.
     intros. rewrite PTree.gso. apply INV. NOTIN. intuition congruence.
   intros [? [? EV1'']].
+  assert (bf0 = bf) by (eapply is_bitfield_access_sound; eauto).
   subst; simpl Kseqlist.
   econstructor; split.
   left. rewrite app_ass. rewrite Kseqlist_app.
@@ -1761,18 +1873,19 @@ Proof.
   econstructor. eapply step_make_assign; eauto.
     constructor. apply PTree.gss. simpl. eapply cast_idempotent; eauto.
     reflexivity. traceEq.
-  econstructor. auto. apply S.
-  apply tr_val_gen. auto. intros. constructor.
-  rewrite H10; auto. apply PTree.gss.
+  econstructor; eauto. apply S.
+  apply tr_val_gen. rewrite typeof_make_assign_value; auto.
+  intros. eapply make_assign_value_sound; eauto.
+  constructor. rewrite H10; auto. apply PTree.gss.
   intros. rewrite PTree.gso. apply INV.
   red; intros; elim H10; auto.
   intuition congruence.
-  auto. auto.
-(* assignop stuck *)
-  exploit tr_top_leftcontext; eauto. clear H12.
+  auto.
+- (* assignop stuck *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H4.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
   exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]].
   exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]].
@@ -1781,7 +1894,7 @@ Proof.
   right; split. rewrite app_ass. rewrite Kseqlist_app. eexact EXEC.
   simpl. lia.
   constructor.
-  (* for value *)
++ (* for value *)
   exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
   exploit tr_simple_rvalue; eauto. intros [SL2 [TY2 EV2]].
   exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]].
@@ -1790,15 +1903,16 @@ Proof.
   right; split. rewrite app_ass. rewrite Kseqlist_app. eexact EXEC.
   simpl. lia.
   constructor.
-(* postincr *)
-  exploit tr_top_leftcontext; eauto. clear H14.
+- (* postincr *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H5.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
   exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]].
   exploit tr_simple_lvalue. eauto. eapply tr_expr_invariant with (le := le) (le' := le'). eauto.
   intros. apply INV. NOTIN. intros [? [? EV1']].
+  assert (bf0 = bf) by (eapply is_bitfield_access_sound; eauto).
   subst; simpl Kseqlist.
   econstructor; split.
   left. rewrite app_ass; rewrite Kseqlist_app.
@@ -1810,14 +1924,15 @@ Proof.
   econstructor. eauto. constructor. rewrite TY3; rewrite <- TY1; rewrite comp_env_preserved. simpl; eauto.
   destruct id; auto.
   reflexivity. traceEq.
-  econstructor. auto. change sl2 with (nil ++ sl2). apply S.
-  constructor. auto. auto. auto.
-  (* for value *)
+  econstructor; eauto. change sl2 with (nil ++ sl2). apply S.
+  constructor. auto. auto.
++ (* for value *)
   exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
   exploit tr_simple_lvalue. eauto.
     eapply tr_expr_invariant with (le' := PTree.set t v1 le). eauto.
     intros. apply PTree.gso. intuition congruence.
   intros [SL2 [TY2 EV2]].
+  assert (bf0 = bf) by (eapply is_bitfield_access_sound; eauto).
   subst; simpl Kseqlist.
   econstructor; split.
   left. eapply plus_four. constructor.
@@ -1831,16 +1946,16 @@ Proof.
   rewrite comp_env_preserved; simpl; eauto.
   destruct id; auto.
   traceEq.
-  econstructor. auto. apply S.
+  econstructor; eauto. apply S.
   apply tr_val_gen. auto. intros. econstructor; eauto.
   rewrite H5; auto. apply PTree.gss.
   intros. apply PTree.gso. intuition congruence.
-  auto. auto.
-(* postincr stuck *)
-  exploit tr_top_leftcontext; eauto. clear H11.
+  auto.
+- (* postincr stuck *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H3.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
   exploit step_tr_rvalof; eauto. intros [le' [EXEC [EV3 [TY3 INV]]]].
   subst. simpl Kseqlist.
@@ -1848,15 +1963,16 @@ Proof.
   right; split. rewrite app_ass; rewrite Kseqlist_app. eexact EXEC.
   simpl; lia.
   constructor.
-  (* for value *)
++ (* for value *)
   exploit tr_simple_lvalue; eauto. intros [SL1 [TY1 EV1]].
+  assert (bf0 = bf) by (eapply is_bitfield_access_sound; eauto).
   subst. simpl Kseqlist.
   econstructor; split.
   left. eapply plus_two. constructor. eapply step_make_set; eauto.
   traceEq.
   constructor.
-(* comma *)
-  exploit tr_top_leftcontext; eauto. clear H9.
+- (* comma *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H1.
   exploit tr_simple_rvalue; eauto. simpl; intro SL1.
@@ -1867,11 +1983,11 @@ Proof.
   econstructor; eauto. apply S.
   eapply tr_expr_monotone; eauto.
   auto. auto.
-(* paren *)
-  exploit tr_top_leftcontext; eauto. clear H9.
+- (* paren *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H2.
-  (* for value *)
++ (* for value *)
   exploit tr_simple_rvalue; eauto. intros [b [SL1 [TY1 EV1]]].
   subst sl1; simpl Kseqlist.
   econstructor; split.
@@ -1882,14 +1998,14 @@ Proof.
   constructor. auto. intros. constructor. rewrite H2; auto. apply PTree.gss.
   intros. apply PTree.gso. intuition congruence.
   auto.
-  (* for effects *)
++ (* for effects *)
   econstructor; split.
   right; split. apply star_refl. simpl. apply plus_lt_compat_r.
   apply (leftcontext_size _ _ _ H). simpl. lia.
   econstructor; eauto.
   exploit tr_simple_rvalue; eauto. simpl. intros A. subst sl1.
   apply S. constructor; auto. auto. auto.
-  (* for set *)
++ (* for set *)
   exploit tr_simple_rvalue; eauto. simpl. intros [b [SL1 [TY1 EV1]]]. subst sl1.
   simpl Kseqlist.
   econstructor; split.
@@ -1901,46 +2017,46 @@ Proof.
   intros. apply PTree.gso. congruence.
   auto.
 
-(* call *)
-  exploit tr_top_leftcontext; eauto. clear H12.
+- (* call *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H5.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_rvalue; eauto. intros [SL1 [TY1 EV1]].
   exploit tr_simple_exprlist; eauto. intros [SL2 EV2].
   subst. simpl Kseqlist.
-  exploit functions_translated; eauto. intros [tfd [J K]].
+  exploit functions_translated; eauto. intros (cu' & tfd & J & K & L).
   econstructor; split.
   left. eapply plus_left. constructor.  apply star_one.
   econstructor; eauto. rewrite <- TY1; eauto.
   exploit type_of_fundef_preserved; eauto. congruence.
   traceEq.
-  constructor; auto. econstructor; eauto.
+  econstructor. eexact L. eauto. econstructor. eexact LINK. auto. auto.
   intros. change sl2 with (nil ++ sl2). apply S.
-  constructor. auto. auto.
-  (* for value *)
+  constructor. auto. auto. auto.
++ (* for value *)
   exploit tr_simple_rvalue; eauto. intros [SL1 [TY1 EV1]].
   exploit tr_simple_exprlist; eauto. intros [SL2 EV2].
   subst. simpl Kseqlist.
-  exploit functions_translated; eauto. intros [tfd [J K]].
+  exploit functions_translated; eauto. intros (cu' & tfd & J & K & L).
   econstructor; split.
   left. eapply plus_left. constructor.  apply star_one.
   econstructor; eauto. rewrite <- TY1; eauto.
   exploit type_of_fundef_preserved; eauto. congruence.
   traceEq.
-  constructor; auto. econstructor; eauto.
+  econstructor. eexact L. eauto. econstructor. eexact LINK. auto. auto.
   intros. apply S.
   destruct dst'; constructor.
   auto. intros. constructor. rewrite H5; auto. apply PTree.gss.
   auto. intros. constructor. rewrite H5; auto. apply PTree.gss.
   intros. apply PTree.gso. intuition congruence.
-  auto.
+  auto. auto.
 
-(* builtin *)
-  exploit tr_top_leftcontext; eauto. clear H9.
+- (* builtin *)
+  exploit tr_top_leftcontext; eauto. clear TR.
   intros [dst' [sl1 [sl2 [a' [tmp' [P [Q [R S]]]]]]]].
   inv P. inv H2.
-  (* for effects *)
++ (* for effects *)
   exploit tr_simple_exprlist; eauto. intros [SL EV].
   subst. simpl Kseqlist.
   econstructor; split.
@@ -1950,7 +2066,7 @@ Proof.
   traceEq.
   econstructor; eauto.
   change sl2 with (nil ++ sl2). apply S. constructor. simpl; auto. auto.
-  (* for value *)
++ (* for value *)
   exploit tr_simple_exprlist; eauto. intros [SL EV].
   subst. simpl Kseqlist.
   econstructor; split.
@@ -1968,8 +2084,8 @@ Qed.
 (** Forward simulation for statements. *)
 
 Lemma tr_top_val_for_val_inv:
-  forall e le m v ty sl a tmps,
-  tr_top tge e le m For_val (Csyntax.Eval v ty) sl a tmps ->
+  forall ce e le m v ty sl a tmps,
+  tr_top ce tge e le m For_val (Csyntax.Eval v ty) sl a tmps ->
   sl = nil /\ typeof a = ty /\ eval_expr tge e le m a v.
 Proof.
   intros. inv H. auto. inv H0. auto.
@@ -2011,264 +2127,263 @@ Lemma sstep_simulation:
   /\ match_states S2 S2'.
 Proof.
   induction 1; intros; inv MS.
-(* do 1 *)
-  inv H6. inv H0.
+- (* do 1 *)
+  inv TR. inv H0.
   econstructor; split.
   right; split. apply push_seq.
   simpl. lia.
   econstructor; eauto. constructor. auto.
-(* do 2 *)
-  inv H7. inv H6. inv H.
+- (* do 2 *)
+  inv MK. inv TR. inv H.
   econstructor; split.
   right; split. apply star_refl. simpl. lia.
   econstructor; eauto. constructor.
 
-(* seq *)
-  inv H6. econstructor; split. left. apply plus_one. constructor.
+- (* seq *)
+  inv TR. econstructor; split. left. apply plus_one. constructor.
   econstructor; eauto. constructor; auto.
-(* skip seq *)
-  inv H6; inv H7. econstructor; split.
+- (* skip seq *)
+  inv TR; inv MK. econstructor; split.
   left. apply plus_one; constructor.
   econstructor; eauto.
-(* continue seq *)
-  inv H6; inv H7. econstructor; split.
+- (* continue seq *)
+  inv TR; inv MK. econstructor; split.
   left. apply plus_one; constructor.
   econstructor; eauto. constructor.
-(* break seq *)
-  inv H6; inv H7. econstructor; split.
+- (* break seq *)
+  inv TR; inv MK. econstructor; split.
   left. apply plus_one; constructor.
   econstructor; eauto. constructor.
-(* ifthenelse *)
-  inv H6.
-(* ifthenelse empty *)
+- (* ifthenelse *)
+  inv TR.
++ (* ifthenelse empty *)
   inv H3. econstructor; split.
   left. eapply plus_left. constructor. apply push_seq.
   econstructor; eauto.
   econstructor; eauto.
   econstructor; eauto.
-(* ifthenelse non empty *)
++ (* ifthenelse non empty *)
   inv H2. econstructor; split.
   left. eapply plus_left. constructor. apply push_seq. traceEq.
   econstructor; eauto. econstructor; eauto.
-(* ifthenelse *)
-  inv H8.
-(* ifthenelse empty *)
+- (* ifthenelse *)
+  inv MK.
++ (* ifthenelse empty *)
   exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
   econstructor; split; simpl.
   right. destruct b; econstructor; eauto.
   eapply star_left. apply step_skip_seq. econstructor. traceEq.
   eapply star_left. apply step_skip_seq. econstructor. traceEq.
   destruct b; econstructor; eauto. econstructor; eauto. econstructor; eauto.
-  (* ifthenelse non empty *)
++ (* ifthenelse non empty *)
   exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
   econstructor; split.
   left. eapply plus_two. constructor.
   apply step_ifthenelse with (v1 := v) (b := b); auto. traceEq.
   destruct b; econstructor; eauto.
-(* while *)
-  inv H6. inv H1. econstructor; split.
+- (* while *)
+  inv TR. inv H1. econstructor; split.
   left. eapply plus_left. constructor.
   eapply star_left. constructor.
   apply push_seq.
   reflexivity. traceEq. rewrite Kseqlist_app.
-  econstructor; eauto. simpl.  econstructor; eauto. econstructor; eauto.
-(* while false *)
-  inv H8.
+  econstructor; eauto. simpl. econstructor; eauto. econstructor; eauto.
+- (* while false *)
+  inv MK.
   exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
   econstructor; split.
   left. simpl. eapply plus_left. constructor.
   eapply star_trans. apply step_makeif with (v1 := v) (b := false); auto.
   eapply star_two. constructor. apply step_break_loop1.
   reflexivity. reflexivity. traceEq.
-  constructor; auto. constructor.
-(* while true *)
-  inv H8.
+  econstructor; eauto. constructor.
+- (* while true *)
+  inv MK.
   exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
   econstructor; split.
   left. simpl. eapply plus_left. constructor.
   eapply star_right. apply step_makeif with (v1 := v) (b := true); auto.
   constructor.
   reflexivity. traceEq.
-  constructor; auto. constructor; auto.
-(* skip-or-continue while *)
-  assert (ts = Sskip \/ ts = Scontinue). destruct H; subst s0; inv H7; auto.
-  inv H8.
+  econstructor; eauto. constructor; auto.
+- (* skip-or-continue while *)
+  assert (ts = Sskip \/ ts = Scontinue). { destruct H; subst s0; inv TR; auto. }
+  inv MK.
   econstructor; split.
   left. eapply plus_two. apply step_skip_or_continue_loop1; auto.
   apply step_skip_loop2. traceEq.
-  constructor; auto. constructor; auto.
-(* break while *)
-  inv H6. inv H7.
+  econstructor; eauto. constructor; auto.
+- (* break while *)
+  inv TR. inv MK.
   econstructor; split.
   left. apply plus_one. apply step_break_loop1.
-  constructor; auto. constructor.
+  econstructor; eauto. constructor.
 
-(* dowhile *)
-  inv H6.
+- (* dowhile *)
+  inv TR.
   econstructor; split.
   left. apply plus_one. apply step_loop.
-  constructor; auto. constructor; auto.
-(* skip_or_continue dowhile *)
-  assert (ts = Sskip \/ ts = Scontinue). destruct H; subst s0; inv H7; auto.
-  inv H8. inv H4.
+  econstructor; eauto. constructor; auto.
+- (* skip_or_continue dowhile *)
+  assert (ts = Sskip \/ ts = Scontinue). { destruct H; subst s0; inv TR; auto. }
+  inv MK. inv H5.
   econstructor; split.
   left. eapply plus_left. apply step_skip_or_continue_loop1. auto.
   apply push_seq.
   traceEq.
   rewrite Kseqlist_app.
   econstructor; eauto. simpl. econstructor; auto. econstructor; eauto.
-(* dowhile false *)
-  inv H8.
+- (* dowhile false *)
+  inv MK.
   exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
   econstructor; split.
   left. simpl. eapply plus_left. constructor.
   eapply star_right. apply step_makeif with (v1 := v) (b := false); auto.
   constructor.
   reflexivity. traceEq.
-  constructor; auto. constructor.
-(* dowhile true *)
-  inv H8.
+  econstructor; eauto. constructor.
+- (* dowhile true *)
+  inv MK.
   exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
   econstructor; split.
   left. simpl. eapply plus_left. constructor.
   eapply star_right. apply step_makeif with (v1 := v) (b := true); auto.
   constructor.
   reflexivity. traceEq.
-  constructor; auto. constructor; auto.
-(* break dowhile *)
-  inv H6. inv H7.
+  econstructor; eauto. constructor; auto.
+- (* break dowhile *)
+  inv TR. inv MK.
   econstructor; split.
   left. apply plus_one. apply step_break_loop1.
-  constructor; auto. constructor.
+  econstructor; eauto. constructor.
 
-(* for start *)
-  inv H7. congruence.
+- (* for start *)
+  inv TR. congruence.
   econstructor; split.
   left; apply plus_one. constructor.
   econstructor; eauto. constructor; auto. econstructor; eauto.
-(* for *)
-  inv H6; try congruence. inv H2.
+- (* for *)
+  inv TR; try congruence. inv H2.
   econstructor; split.
   left. eapply plus_left. apply step_loop.
   eapply star_left. constructor. apply push_seq.
   reflexivity. traceEq.
   rewrite Kseqlist_app. econstructor; eauto. simpl. constructor; auto. econstructor; eauto.
-(* for false *)
-  inv H8. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
+- (* for false *)
+  inv MK. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
   econstructor; split.
   left. simpl. eapply plus_left. constructor.
   eapply star_trans. apply step_makeif with (v1 := v) (b := false); auto.
   eapply star_two. constructor. apply step_break_loop1.
   reflexivity. reflexivity. traceEq.
-  constructor; auto. constructor.
-(* for true *)
-  inv H8. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
+  econstructor; eauto. constructor.
+- (* for true *)
+  inv MK. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
   econstructor; split.
   left. simpl. eapply plus_left. constructor.
   eapply star_right. apply step_makeif with (v1 := v) (b := true); auto.
   constructor.
   reflexivity. traceEq.
-  constructor; auto. constructor; auto.
-(* skip_or_continue for3 *)
-  assert (ts = Sskip \/ ts = Scontinue). destruct H; subst x; inv H7; auto.
-  inv H8.
+  econstructor; eauto. constructor; auto.
+- (* skip_or_continue for3 *)
+  assert (ts = Sskip \/ ts = Scontinue). { destruct H; subst x; inv TR; auto. }
+  inv MK.
   econstructor; split.
   left. apply plus_one. apply step_skip_or_continue_loop1. auto.
   econstructor; eauto. econstructor; auto.
-(* break for3 *)
-  inv H6. inv H7.
+- (* break for3 *)
+  inv TR. inv MK.
   econstructor; split.
   left. apply plus_one. apply step_break_loop1.
   econstructor; eauto. constructor.
-(* skip for4 *)
-  inv H6. inv H7.
+- (* skip for4 *)
+  inv TR. inv MK.
   econstructor; split.
   left. apply plus_one. constructor.
   econstructor; eauto. constructor; auto.
 
-
-(* return none *)
-  inv H7. econstructor; split.
+- (* return none *)
+  inv TR. econstructor; split.
   left. apply plus_one. econstructor; eauto. rewrite blocks_of_env_preserved; eauto.
-  constructor. apply match_cont_call; auto.
-(* return some 1 *)
-  inv H6. inv H0. econstructor; split.
+  econstructor. intros; eapply match_cont_call_cont; eauto.
+- (* return some 1 *)
+  inv TR. inv H0. econstructor; split.
   left; eapply plus_left. constructor. apply push_seq. traceEq.
   econstructor; eauto. constructor. auto.
-(* return some 2 *)
-  inv H9. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
+- (* return some 2 *)
+  inv MK. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
   econstructor; split.
   left. eapply plus_two. constructor. econstructor. eauto.
   erewrite function_return_preserved; eauto. rewrite blocks_of_env_preserved; eauto.
   eauto. traceEq.
-  constructor. apply match_cont_call; auto.
-(* skip return *)
-  inv H8.
-  assert (is_call_cont tk). inv H9; simpl in *; auto.
+  econstructor. intros; eapply match_cont_call_cont; eauto.
+- (* skip return *)
+  inv TR.
+  assert (is_call_cont tk). { inv MK; simpl in *; auto. }
   econstructor; split.
   left. apply plus_one. apply step_skip_call; eauto. rewrite blocks_of_env_preserved; eauto.
-  constructor. auto.
+  econstructor. intros; eapply match_cont_is_call_cont; eauto.
 
-(* switch *)
-  inv H6. inv H1.
+- (* switch *)
+  inv TR. inv H1.
   econstructor; split.
   left; eapply plus_left. constructor. apply push_seq. traceEq.
   econstructor; eauto. constructor; auto.
-(* expr switch *)
-  inv H8. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
+- (* expr switch *)
+  inv MK. exploit tr_top_val_for_val_inv; eauto. intros [A [B C]]. subst.
   econstructor; split.
   left; eapply plus_two. constructor. econstructor; eauto. traceEq.
   econstructor; eauto.
   apply tr_seq_of_labeled_statement. apply tr_select_switch. auto.
   constructor; auto.
 
-(* skip-or-break switch *)
-  assert (ts = Sskip \/ ts = Sbreak). destruct H; subst x; inv H7; auto.
-  inv H8.
+- (* skip-or-break switch *)
+  assert (ts = Sskip \/ ts = Sbreak). { destruct H; subst x; inv TR; auto. }
+  inv MK.
   econstructor; split.
   left; apply plus_one. apply step_skip_break_switch. auto.
-  constructor; auto. constructor.
+  econstructor; eauto. constructor.
 
-(* continue switch *)
-  inv H6. inv H7.
+- (* continue switch *)
+  inv TR. inv MK.
   econstructor; split.
   left; apply plus_one. apply step_continue_switch.
-  constructor; auto. constructor.
+  econstructor; eauto. constructor.
 
-(* label *)
-  inv H6. econstructor; split.
+- (* label *)
+  inv TR. econstructor; split.
   left; apply plus_one. constructor.
-  constructor; auto.
+  econstructor; eauto.
 
-(* goto *)
-  inv H7.
-  inversion H6; subst.
-  exploit tr_find_label. eauto. apply match_cont_call. eauto.
+- (* goto *)
+  inv TR.
+  inversion TRF; subst.
+  exploit tr_find_label. eauto. eapply match_cont_call_cont; eauto.
   instantiate (1 := lbl). rewrite H.
   intros [ts' [tk' [P [Q R]]]].
   econstructor; split.
   left. apply plus_one. econstructor; eauto.
   econstructor; eauto.
 
-(* internal function *)
-  inv H7. inversion H3; subst.
+- (* internal function *)
+  inv TR. inversion H3; subst.
   econstructor; split.
   left; apply plus_one. eapply step_internal_function. econstructor.
   rewrite H6; rewrite H7; auto.
   rewrite H6; rewrite H7. eapply alloc_variables_preserved; eauto.
   rewrite H6. eapply bind_parameters_preserved; eauto.
   eauto.
-  constructor; auto.
+  econstructor; eauto. 
 
-(* external function *)
-  inv H5.
+- (* external function *)
+  inv TR.
   econstructor; split.
   left; apply plus_one. econstructor; eauto.
   eapply external_call_symbols_preserved; eauto. apply senv_preserved.
-  constructor; auto.
+  econstructor; eauto.
 
-(* return *)
-  inv H3.
+- (* return *)
+  specialize (MK (PTree.empty _)). inv MK.
   econstructor; split.
   left; apply plus_one. constructor.
   econstructor; eauto.
@@ -2295,7 +2410,7 @@ Lemma transl_initial_states:
   exists S', Clight.initial_state tprog S' /\ match_states S S'.
 Proof.
   intros. inv H.
-  exploit function_ptr_translated; eauto. intros [tf [FIND TR]].
+  exploit function_ptr_translated; eauto. intros (cu & tf & FIND & TR & L).
   econstructor; split.
   econstructor.
   eapply (Genv.init_mem_match (proj1 TRANSL)); eauto.
@@ -2303,15 +2418,15 @@ Proof.
   rewrite symbols_preserved. eauto. 
   destruct TRANSL. destruct H as (A & B & C). simpl in B. auto. 
   eexact FIND.
-  rewrite <- H3. apply type_of_fundef_preserved. auto.
-  constructor. auto. constructor.
+  rewrite <- H3. eapply type_of_fundef_preserved; eauto.
+  econstructor; eauto. intros; constructor.
 Qed.
 
 Lemma transl_final_states:
   forall S S' r,
   match_states S S' -> Csem.final_state S r -> Clight.final_state S' r.
 Proof.
-  intros. inv H0. inv H. inv H4. constructor.
+  intros. inv H0. inv H. specialize (MK (PTree.empty _)). inv MK. constructor.
 Qed.
 
 Theorem transl_program_correct:
@@ -2331,13 +2446,13 @@ End PRESERVATION.
 
 Instance TransfSimplExprLink : TransfLink match_prog.
 Proof.
-  red; intros. eapply Ctypes.link_match_program; eauto. 
+  red; intros. eapply Ctypes.link_match_program_gen; eauto. 
 - intros.
 Local Transparent Linker_fundef.
   simpl in *; unfold link_fundef in *. inv H3; inv H4; try discriminate.
-  destruct ef; inv H2. exists (Internal tf); split; auto. constructor; auto.
-  destruct ef; inv H2. exists (Internal tf); split; auto. constructor; auto.
+  destruct ef; inv H2. exists (Internal tf); split; auto. left; constructor; auto.
+  destruct ef; inv H2. exists (Internal tf); split; auto. right; constructor; auto.
   destruct (external_function_eq ef ef0 && typelist_eq targs targs0 &&
             type_eq tres tres0 && calling_convention_eq cconv cconv0); inv H2.
-  exists (External ef targs tres cconv); split; auto. constructor.
+  exists (External ef targs tres cconv); split; auto. left; constructor.
 Qed.
diff --git a/cfrontend/SimplExprspec.v b/cfrontend/SimplExprspec.v
index 98425311..b689bdeb 100644
--- a/cfrontend/SimplExprspec.v
+++ b/cfrontend/SimplExprspec.v
@@ -18,6 +18,8 @@ Require Import Ctypes Cop Csyntax Clight SimplExpr.
 
 Section SPEC.
 
+Variable ce: composite_env.
+
 Local Open Scope gensym_monad_scope.
 
 (** * Relational specification of the translation. *)
@@ -40,13 +42,28 @@ Definition final (dst: destination) (a: expr) : list statement :=
   | For_set sd => do_set sd a
   end.
 
+Definition tr_is_bitfield_access (l: expr) (bf: bitfield) : Prop :=
+  match l with
+  | Efield r f _ =>
+      exists co ofs,
+      match typeof r with
+      | Tstruct id _ =>
+          ce!id = Some co /\ field_offset ce f (co_members co) = OK (ofs, bf)
+      | Tunion id _ =>
+          ce!id = Some co /\ union_field_offset ce f (co_members co) = OK (ofs, bf)
+      | _ => False
+      end
+  | _ => bf = Full
+  end.
+
 Inductive tr_rvalof: type -> expr -> list statement -> expr -> list ident -> Prop :=
   | tr_rvalof_nonvol: forall ty a tmp,
       type_is_volatile ty = false ->
       tr_rvalof ty a nil a tmp
-  | tr_rvalof_vol: forall ty a t tmp,
+  | tr_rvalof_vol: forall ty a t bf tmp,
       type_is_volatile ty = true -> In t tmp ->
-      tr_rvalof ty a (make_set t a :: nil) (Etempvar t ty) tmp.
+      tr_is_bitfield_access a bf ->
+      tr_rvalof ty a (make_set bf t a :: nil) (Etempvar t ty) tmp.
 
 Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement -> expr -> list ident -> Prop :=
   | tr_var: forall le dst id ty tmp,
@@ -200,15 +217,16 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement ->
       tr_expr le (For_set sd) (Csyntax.Econdition e1 e2 e3 ty)
                        (sl1 ++ makeif a1 (makeseq sl2) (makeseq sl3) :: nil)
                        any tmp
-  | tr_assign_effects: forall le e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 any tmp,
+  | tr_assign_effects: forall le e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 bf any tmp,
       tr_expr le For_val e1 sl1 a1 tmp1 ->
       tr_expr le For_val e2 sl2 a2 tmp2 ->
       list_disjoint tmp1 tmp2 ->
       incl tmp1 tmp -> incl tmp2 tmp ->
+      tr_is_bitfield_access a1 bf ->
       tr_expr le For_effects (Csyntax.Eassign e1 e2 ty)
-                      (sl1 ++ sl2 ++ make_assign a1 a2 :: nil)
+                      (sl1 ++ sl2 ++ make_assign bf a1 a2 :: nil)
                       any tmp
-  | tr_assign_val: forall le dst e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 t tmp ty1 ty2,
+  | tr_assign_val: forall le dst e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 t tmp ty1 ty2 bf,
       tr_expr le For_val e1 sl1 a1 tmp1 ->
       tr_expr le For_val e2 sl2 a2 tmp2 ->
       incl tmp1 tmp -> incl tmp2 tmp ->
@@ -216,23 +234,25 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement ->
       In t tmp -> ~In t tmp1 -> ~In t tmp2 ->
       ty1 = Csyntax.typeof e1 ->
       ty2 = Csyntax.typeof e2 ->
+      tr_is_bitfield_access a1 bf ->
       tr_expr le dst (Csyntax.Eassign e1 e2 ty)
                    (sl1 ++ sl2 ++
                     Sset t (Ecast a2 ty1) ::
-                    make_assign a1 (Etempvar t ty1) ::
-                    final dst (Etempvar t ty1))
-                   (Etempvar t ty1) tmp
-  | tr_assignop_effects: forall le op e1 e2 tyres ty ty1 sl1 a1 tmp1 sl2 a2 tmp2 sl3 a3 tmp3 any tmp,
+                    make_assign bf a1 (Etempvar t ty1) ::
+                    final dst (make_assign_value bf (Etempvar t ty1)))
+                   (make_assign_value bf (Etempvar t ty1)) tmp
+  | tr_assignop_effects: forall le op e1 e2 tyres ty ty1 sl1 a1 tmp1 sl2 a2 tmp2 bf sl3 a3 tmp3 any tmp,
       tr_expr le For_val e1 sl1 a1 tmp1 ->
       tr_expr le For_val e2 sl2 a2 tmp2 ->
       ty1 = Csyntax.typeof e1 ->
       tr_rvalof ty1 a1 sl3 a3 tmp3 ->
       list_disjoint tmp1 tmp2 -> list_disjoint tmp1 tmp3 -> list_disjoint tmp2 tmp3 ->
       incl tmp1 tmp -> incl tmp2 tmp -> incl tmp3 tmp ->
+      tr_is_bitfield_access a1 bf ->
       tr_expr le For_effects (Csyntax.Eassignop op e1 e2 tyres ty)
-                      (sl1 ++ sl2 ++ sl3 ++ make_assign a1 (Ebinop op a3 a2 tyres) :: nil)
+                      (sl1 ++ sl2 ++ sl3 ++ make_assign bf a1 (Ebinop op a3 a2 tyres) :: nil)
                       any tmp
-  | tr_assignop_val: forall le dst op e1 e2 tyres ty sl1 a1 tmp1 sl2 a2 tmp2 sl3 a3 tmp3 t tmp ty1,
+  | tr_assignop_val: forall le dst op e1 e2 tyres ty sl1 a1 tmp1 sl2 a2 tmp2 sl3 a3 tmp3 t bf tmp ty1,
       tr_expr le For_val e1 sl1 a1 tmp1 ->
       tr_expr le For_val e2 sl2 a2 tmp2 ->
       tr_rvalof ty1 a1 sl3 a3 tmp3 ->
@@ -240,28 +260,31 @@ Inductive tr_expr: temp_env -> destination -> Csyntax.expr -> list statement ->
       incl tmp1 tmp -> incl tmp2 tmp -> incl tmp3 tmp ->
       In t tmp -> ~In t tmp1 -> ~In t tmp2 -> ~In t tmp3 ->
       ty1 = Csyntax.typeof e1 ->
+      tr_is_bitfield_access a1 bf ->
       tr_expr le dst (Csyntax.Eassignop op e1 e2 tyres ty)
                    (sl1 ++ sl2 ++ sl3 ++
                     Sset t (Ecast (Ebinop op a3 a2 tyres) ty1) ::
-                    make_assign a1 (Etempvar t ty1) ::
-                    final dst (Etempvar t ty1))
-                   (Etempvar t ty1) tmp
-  | tr_postincr_effects: forall le id e1 ty ty1 sl1 a1 tmp1 sl2 a2 tmp2 any tmp,
+                    make_assign bf a1 (Etempvar t ty1) ::
+                    final dst (make_assign_value bf (Etempvar t ty1)))
+                   (make_assign_value bf (Etempvar t ty1)) tmp
+  | tr_postincr_effects: forall le id e1 ty ty1 sl1 a1 tmp1 sl2 a2 tmp2 bf any tmp,
       tr_expr le For_val e1 sl1 a1 tmp1 ->
       tr_rvalof ty1 a1 sl2 a2 tmp2 ->
       ty1 = Csyntax.typeof e1 ->
       incl tmp1 tmp -> incl tmp2 tmp ->
       list_disjoint tmp1 tmp2 ->
+      tr_is_bitfield_access a1 bf ->
       tr_expr le For_effects (Csyntax.Epostincr id e1 ty)
-                      (sl1 ++ sl2 ++ make_assign a1 (transl_incrdecr id a2 ty1) :: nil)
+                      (sl1 ++ sl2 ++ make_assign bf a1 (transl_incrdecr id a2 ty1) :: nil)
                       any tmp
-  | tr_postincr_val: forall le dst id e1 ty sl1 a1 tmp1 t ty1 tmp,
+  | tr_postincr_val: forall le dst id e1 ty sl1 a1 tmp1 bf t ty1 tmp,
       tr_expr le For_val e1 sl1 a1 tmp1 ->
       incl tmp1 tmp -> In t tmp -> ~In t tmp1 ->
       ty1 = Csyntax.typeof e1 ->
+      tr_is_bitfield_access a1 bf ->
       tr_expr le dst (Csyntax.Epostincr id e1 ty)
-                   (sl1 ++ make_set t a1 ::
-                    make_assign a1 (transl_incrdecr id (Etempvar t ty1) ty1) ::
+                   (sl1 ++ make_set bf t a1 ::
+                    make_assign bf a1 (transl_incrdecr id (Etempvar t ty1) ty1) ::
                     final dst (Etempvar t ty1))
                    (Etempvar t ty1) tmp
   | tr_comma: forall le dst e1 e2 ty sl1 a1 tmp1 sl2 a2 tmp2 tmp,
@@ -746,14 +769,31 @@ Proof.
   intros. apply tr_expr_monotone with tmps; auto. apply add_dest_incl.
 Qed.
 
+Lemma is_bitfield_access_meets_spec: forall l g bf g' I,
+  is_bitfield_access ce l g = Res bf g' I ->
+  tr_is_bitfield_access l bf.
+Proof.
+  unfold is_bitfield_access; intros; red. destruct l; try (monadInv H; auto).
+  assert (AUX: forall fn id,
+               is_bitfield_access_aux ce fn id i g = Res bf g' I ->
+               exists co ofs,
+               ce!id = Some co /\ fn ce i (co_members co) = OK (ofs, bf)).
+  { unfold is_bitfield_access_aux; intros.
+    destruct ce!id as [co|]; try discriminate.
+    destruct (fn ce i (co_members co)) as [[ofs1 bf1]|] eqn:FN; inv H0.
+    exists co, ofs1; auto. }
+  destruct (typeof l); try discriminate; apply AUX; auto.
+Qed.
+
 Lemma transl_valof_meets_spec:
   forall ty a g sl b g' I,
-  transl_valof ty a g = Res (sl, b) g' I ->
+  transl_valof ce ty a g = Res (sl, b) g' I ->
   exists tmps, tr_rvalof ty a sl b tmps /\ contained tmps g g'.
 Proof.
   unfold transl_valof; intros.
   destruct (type_is_volatile ty) eqn:?; monadInv H.
-  exists (x :: nil); split; eauto with gensym. econstructor; eauto with coqlib.
+  exists (x :: nil); split; eauto with gensym.
+  econstructor; eauto using is_bitfield_access_meets_spec with coqlib.
   exists (@nil ident); split; eauto with gensym. constructor; auto.
 Qed.
 
@@ -763,12 +803,12 @@ Combined Scheme expr_exprlist_ind from expr_ind2, exprlist_ind2.
 
 Lemma transl_meets_spec:
    (forall r dst g sl a g' I,
-    transl_expr dst r g = Res (sl, a) g' I ->
+    transl_expr ce dst r g = Res (sl, a) g' I ->
     dest_below dst g ->
     exists tmps, (forall le, tr_expr le dst r sl a (add_dest dst tmps)) /\ contained tmps g g')
   /\
    (forall rl g sl al g' I,
-    transl_exprlist rl g = Res (sl, al) g' I ->
+    transl_exprlist ce rl g = Res (sl, al) g' I ->
     exists tmps, (forall le, tr_exprlist le rl sl al tmps) /\ contained tmps g g').
 Proof.
   apply expr_exprlist_ind; simpl add_dest; intros.
@@ -920,9 +960,10 @@ Opaque makeif.
 - (* assign *)
   monadInv H1. exploit H; eauto. intros [tmp1 [A B]].
   exploit H0; eauto. intros [tmp2 [Csyntax D]].
-  destruct dst; monadInv EQ2; simpl add_dest in *.
+  apply is_bitfield_access_meets_spec in EQ0.
+  destruct dst; monadInv EQ3; simpl add_dest in *.
 + (* for value *)
-  exists (x1 :: tmp1 ++ tmp2); split.
+  exists (x2 :: tmp1 ++ tmp2); split.
   intros. eapply tr_assign_val with (dst := For_val); eauto with gensym.
   apply contained_cons. eauto with gensym.
   apply contained_app; eauto with gensym.
@@ -931,7 +972,7 @@ Opaque makeif.
   econstructor; eauto with gensym.
   apply contained_app; eauto with gensym.
 + (* for set *)
-  exists (x1 :: tmp1 ++ tmp2); split.
+  exists (x2 :: tmp1 ++ tmp2); split.
   repeat rewrite app_ass. simpl.
   intros. eapply tr_assign_val with (dst := For_set sd); eauto with gensym.
   apply contained_cons. eauto with gensym.
@@ -940,37 +981,39 @@ Opaque makeif.
   monadInv H1. exploit H; eauto. intros [tmp1 [A B]].
   exploit H0; eauto. intros [tmp2 [Csyntax D]].
   exploit transl_valof_meets_spec; eauto. intros [tmp3 [E F]].
-  destruct dst; monadInv EQ3; simpl add_dest in *.
+  apply is_bitfield_access_meets_spec in EQ2.
+  destruct dst; monadInv EQ4; simpl add_dest in *.
 + (* for value *)
-  exists (x2 :: tmp1 ++ tmp2 ++ tmp3); split.
-  intros. eapply tr_assignop_val with (dst := For_val); eauto with gensym.
-  apply contained_cons. eauto with gensym.
-  apply contained_app; eauto with gensym.
+  exists (x3 :: tmp1 ++ tmp2 ++ tmp3); split.
+  intros. eapply tr_assignop_val with (dst := For_val); eauto 6 with gensym.
+  apply contained_cons. eauto 6 with gensym.
+  apply contained_app; eauto 6 with gensym.
 + (* for effects *)
   exists (tmp1 ++ tmp2 ++ tmp3); split.
   econstructor; eauto with gensym.
   apply contained_app; eauto with gensym.
 + (* for set *)
-  exists (x2 :: tmp1 ++ tmp2 ++ tmp3); split.
+  exists (x3 :: tmp1 ++ tmp2 ++ tmp3); split.
   repeat rewrite app_ass. simpl.
-  intros. eapply tr_assignop_val with (dst := For_set sd); eauto with gensym.
-  apply contained_cons. eauto with gensym.
-  apply contained_app; eauto with gensym.
+  intros. eapply tr_assignop_val with (dst := For_set sd); eauto 6 with gensym.
+  apply contained_cons. eauto 6 with gensym.
+  apply contained_app; eauto 6 with gensym.
 - (* postincr *)
   monadInv H0. exploit H; eauto. intros [tmp1 [A B]].
-  destruct dst; monadInv EQ0; simpl add_dest in *.
+  apply is_bitfield_access_meets_spec in EQ1.
+  destruct dst; monadInv EQ2; simpl add_dest in *.
 + (* for value *)
-  exists (x0 :: tmp1); split.
+  exists (x1 :: tmp1); split.
   econstructor; eauto with gensym.
   apply contained_cons; eauto with gensym.
 + (* for effects *)
-  exploit transl_valof_meets_spec; eauto. intros [tmp2 [Csyntax D]].
+  exploit transl_valof_meets_spec; eauto. intros [tmp2 [C D]].
   exists (tmp1 ++ tmp2); split.
   econstructor; eauto with gensym.
   eauto with gensym.
 + (* for set *)
   repeat rewrite app_ass; simpl.
-  exists (x0 :: tmp1); split.
+  exists (x1 :: tmp1); split.
   econstructor; eauto with gensym.
   apply contained_cons; eauto with gensym.
 - (* comma *)
@@ -1032,7 +1075,7 @@ Qed.
 
 Lemma transl_expr_meets_spec:
    forall r dst g sl a g' I,
-   transl_expr dst r g = Res (sl, a) g' I ->
+   transl_expr ce dst r g = Res (sl, a) g' I ->
    dest_below dst g ->
    exists tmps, forall ge e le m, tr_top ge e le m dst r sl a tmps.
 Proof.
@@ -1042,7 +1085,7 @@ Qed.
 
 Lemma transl_expression_meets_spec:
   forall r g s a g' I,
-  transl_expression r g = Res (s, a) g' I ->
+  transl_expression ce r g = Res (s, a) g' I ->
   tr_expression r s a.
 Proof.
   intros. monadInv H. exploit transl_expr_meets_spec; eauto.
@@ -1051,7 +1094,7 @@ Qed.
 
 Lemma transl_expr_stmt_meets_spec:
   forall r g s g' I,
-  transl_expr_stmt r g = Res s g' I ->
+  transl_expr_stmt ce r g = Res s g' I ->
   tr_expr_stmt r s.
 Proof.
   intros. monadInv H. exploit transl_expr_meets_spec; eauto.
@@ -1060,7 +1103,7 @@ Qed.
 
 Lemma transl_if_meets_spec:
   forall r s1 s2 g s g' I,
-  transl_if r s1 s2 g = Res s g' I ->
+  transl_if ce r s1 s2 g = Res s g' I ->
   tr_if r s1 s2 s.
 Proof.
   intros. monadInv H. exploit transl_expr_meets_spec; eauto.
@@ -1068,9 +1111,9 @@ Proof.
 Qed.
 
 Lemma transl_stmt_meets_spec:
-  forall s g ts g' I, transl_stmt s g = Res ts g' I -> tr_stmt s ts
+  forall s g ts g' I, transl_stmt ce s g = Res ts g' I -> tr_stmt s ts
 with transl_lblstmt_meets_spec:
-  forall s g ts g' I, transl_lblstmt s g = Res ts g' I -> tr_lblstmts s ts.
+  forall s g ts g' I, transl_lblstmt ce s g = Res ts g' I -> tr_lblstmts s ts.
 Proof.
   generalize transl_expression_meets_spec transl_expr_stmt_meets_spec transl_if_meets_spec; intros T1 T2 T3.
 Opaque transl_expression transl_expr_stmt.
@@ -1099,32 +1142,32 @@ Inductive tr_function: Csyntax.function -> Clight.function -> Prop :=
       fn_vars tf = Csyntax.fn_vars f ->
       tr_function f tf.
 
-Inductive tr_fundef: Csyntax.fundef -> Clight.fundef -> Prop :=
-  | tr_internal: forall f tf,
-      tr_function f tf ->
-      tr_fundef (Internal f) (Internal tf)
-  | tr_external: forall ef targs tres cconv,
-      tr_fundef (External ef targs tres cconv) (External ef targs tres cconv).
-
 Lemma transl_function_spec:
   forall f tf,
-  transl_function f = OK tf ->
+  transl_function ce f = OK tf ->
   tr_function f tf.
 Proof.
   unfold transl_function; intros.
-  destruct (transl_stmt (Csyntax.fn_body f) (initial_generator tt)) eqn:T; inv H.
+  destruct (transl_stmt ce (Csyntax.fn_body f) (initial_generator tt)) eqn:T; inv H.
   constructor; auto. simpl. eapply transl_stmt_meets_spec; eauto.
 Qed.
 
+End SPEC.
+
+Inductive tr_fundef (p: Csyntax.program): Csyntax.fundef -> Clight.fundef -> Prop :=
+  | tr_internal: forall f tf,
+      tr_function p.(prog_comp_env) f tf ->
+      tr_fundef p (Internal f) (Internal tf)
+  | tr_external: forall ef targs tres cconv,
+      tr_fundef p (External ef targs tres cconv) (External ef targs tres cconv).
+
 Lemma transl_fundef_spec:
-  forall fd tfd,
-  transl_fundef fd = OK tfd ->
-  tr_fundef fd tfd.
+  forall p fd tfd,
+  transl_fundef p.(prog_comp_env) fd = OK tfd ->
+  tr_fundef p fd tfd.
 Proof.
   unfold transl_fundef; intros.
   destruct fd; Errors.monadInv H.
 + constructor. eapply transl_function_spec; eauto.
 + constructor.
 Qed.
-
-End SPEC.
diff --git a/cfrontend/SimplLocalsproof.v b/cfrontend/SimplLocalsproof.v
index 988988a1..e4b759c4 100644
--- a/cfrontend/SimplLocalsproof.v
+++ b/cfrontend/SimplLocalsproof.v
@@ -391,7 +391,7 @@ Lemma match_envs_assign_lifted:
   e!id = Some(b, ty) ->
   val_casted v ty ->
   Val.inject f v tv ->
-  assign_loc ge ty m b Ptrofs.zero v m' ->
+  assign_loc ge ty m b Ptrofs.zero Full v m' ->
   VSet.mem id cenv = true ->
   match_envs f cenv e le m' lo hi te (PTree.set id tv tle) tlo thi.
 Proof.
@@ -1004,13 +1004,13 @@ Proof.
 Qed.
 
 Lemma assign_loc_inject:
-  forall f ty m loc ofs v m' tm loc' ofs' v',
-  assign_loc ge ty m loc ofs v m' ->
+  forall f ty m loc ofs bf v m' tm loc' ofs' v',
+  assign_loc ge ty m loc ofs bf v m' ->
   Val.inject f (Vptr loc ofs) (Vptr loc' ofs') ->
   Val.inject f v v' ->
   Mem.inject f m tm ->
   exists tm',
-     assign_loc tge ty tm loc' ofs' v' tm'
+     assign_loc tge ty tm loc' ofs' bf v' tm'
   /\ Mem.inject f m' tm'
   /\ (forall b chunk v,
       f b = None -> Mem.load chunk m b 0 = Some v -> Mem.load chunk m' b 0 = Some v).
@@ -1078,15 +1078,25 @@ Proof.
   split. auto.
   intros. rewrite <- H0. eapply Mem.load_storebytes_other; eauto.
   left. congruence.
+- (* bitfield *)
+  inv H3.
+  exploit Mem.loadv_inject; eauto. intros (vc' & LD' & INJ). inv INJ.
+  exploit Mem.storev_mapped_inject; eauto. intros [tm' [A B]].
+  inv H1.
+  exists tm'; split. eapply assign_loc_bitfield; eauto. econstructor; eauto.
+  split. auto.
+  intros. rewrite <- H3. eapply Mem.load_store_other; eauto.
+  left. inv H0. congruence.
 Qed.
 
 Lemma assign_loc_nextblock:
-  forall ge ty m b ofs v m',
-  assign_loc ge ty m b ofs v m' -> Mem.nextblock m' = Mem.nextblock m.
+  forall ge ty m b ofs bf v m',
+  assign_loc ge ty m b ofs bf v m' -> Mem.nextblock m' = Mem.nextblock m.
 Proof.
   induction 1.
   simpl in H0. eapply Mem.nextblock_store; eauto.
   eapply Mem.nextblock_storebytes; eauto.
+  inv H. eapply Mem.nextblock_store; eauto.
 Qed.
 
 Theorem store_params_correct:
@@ -1168,7 +1178,7 @@ Local Opaque Conventions1.parameter_needs_normalization.
   reflexivity. reflexivity.
   eexact U.
   traceEq.
-  rewrite (assign_loc_nextblock _ _ _ _ _ _ _ A) in Z. auto.
+  rewrite (assign_loc_nextblock _ _ _ _ _ _ _ _ A) in Z. auto.
 Qed.
 
 Lemma bind_parameters_nextblock:
@@ -1400,19 +1410,22 @@ Proof.
 Qed.
 
 Lemma deref_loc_inject:
-  forall ty loc ofs v loc' ofs',
-  deref_loc ty m loc ofs v ->
+  forall ty loc ofs bf v loc' ofs',
+  deref_loc ty m loc ofs bf v ->
   Val.inject f (Vptr loc ofs) (Vptr loc' ofs') ->
-  exists tv, deref_loc ty tm loc' ofs' tv /\ Val.inject f v tv.
+  exists tv, deref_loc ty tm loc' ofs' bf tv /\ Val.inject f v tv.
 Proof.
   intros. inv H.
-  (* by value *)
+- (* by value *)
   exploit Mem.loadv_inject; eauto. intros [tv [A B]].
   exists tv; split; auto. eapply deref_loc_value; eauto.
-  (* by reference *)
+- (* by reference *)
   exists (Vptr loc' ofs'); split; auto. eapply deref_loc_reference; eauto.
-  (* by copy *)
+- (* by copy *)
   exists (Vptr loc' ofs'); split; auto. eapply deref_loc_copy; eauto.
+- (* bitfield *)
+  inv H1.   exploit Mem.loadv_inject; eauto. intros [tc [A B]]. inv B. 
+  econstructor; split. eapply deref_loc_bitfield. econstructor; eauto. constructor.
 Qed.
 
 Lemma eval_simpl_expr:
@@ -1422,11 +1435,11 @@ Lemma eval_simpl_expr:
   exists tv, eval_expr tge te tle tm (simpl_expr cenv a) tv /\ Val.inject f v tv
 
 with eval_simpl_lvalue:
-  forall a b ofs,
-  eval_lvalue ge e le m a b ofs ->
+  forall a b ofs bf,
+  eval_lvalue ge e le m a b ofs bf ->
   compat_cenv (addr_taken_expr a) cenv ->
   match a with Evar id ty => VSet.mem id cenv = false | _ => True end ->
-  exists b', exists ofs', eval_lvalue tge te tle tm (simpl_expr cenv a) b' ofs' /\ Val.inject f (Vptr b ofs) (Vptr b' ofs').
+  exists b', exists ofs', eval_lvalue tge te tle tm (simpl_expr cenv a) b' ofs' bf /\ Val.inject f (Vptr b ofs) (Vptr b' ofs').
 
 Proof.
   destruct 1; simpl; intros.
@@ -1472,7 +1485,7 @@ Proof.
   subst a. simpl. rewrite OPT.
   exploit me_vars; eauto. instantiate (1 := id). intros MV.
   inv H; inv MV; try congruence.
-  rewrite ENV in H6; inv H6.
+  rewrite ENV in H7; inv H7.
   inv H0; try congruence.
   assert (chunk0 = chunk). simpl in H. congruence. subst chunk0.
   assert (v0 = v). unfold Mem.loadv in H2. rewrite Ptrofs.unsigned_zero in H2. congruence. subst v0.
@@ -1516,7 +1529,8 @@ Proof.
   exploit eval_simpl_expr; eauto. intros [tv [A B]].
   inversion B. subst.
   econstructor; econstructor; split.
-  eapply eval_Efield_union; eauto. rewrite typeof_simpl_expr; eauto. auto.
+  eapply eval_Efield_union; eauto. rewrite typeof_simpl_expr; eauto.
+  econstructor; eauto. repeat rewrite Ptrofs.add_assoc. decEq. apply Ptrofs.add_commut.
 Qed.
 
 Lemma eval_simpl_exprlist:
@@ -1607,18 +1621,20 @@ Qed.
 (** Invariance by assignment to location "above" *)
 
 Lemma match_cont_assign_loc:
-  forall f cenv k tk m bound tbound ty loc ofs v m',
+  forall f cenv k tk m bound tbound ty loc ofs bf v m',
   match_cont f cenv k tk m bound tbound ->
-  assign_loc ge ty m loc ofs v m' ->
+  assign_loc ge ty m loc ofs bf v m' ->
   Ple bound loc ->
   match_cont f cenv k tk m' bound tbound.
 Proof.
   intros. eapply match_cont_invariant; eauto.
   intros. rewrite <- H4. inv H0.
-  (* scalar *)
+- (* scalar *)
   simpl in H6. eapply Mem.load_store_other; eauto. left. unfold block; extlia.
-  (* block copy *)
+- (* block copy *)
   eapply Mem.load_storebytes_other; eauto. left. unfold block; extlia.
+- (* bitfield *)
+  inv H5. eapply Mem.load_store_other; eauto. left. unfold block; extlia.
 Qed.
 
 (** Invariance by external calls *)