Definition only_blocks {S: block -> Prop} (S_dec: forall b, {S b}+{~S b}) (w: rmap) : rmap.
refine (proj1_sig (make_rmap (fun loc => if S_dec (fst loc) then w @ loc else core (w @ loc))
_ (level w) _ (ghost_of_approx w))).
Definition upto_block (b: block) (w: rmap) : rmap :=  only_blocks (fun b' => plt b' b) w.
Definition beyond_block (b: block) (w: rmap) : rmap := only_blocks (not_dec (fun b' => plt b' b)) w.
Definition blockslice_rmap (S: block -> Prop) (phi: rmap) :=
forall loc: address, ~S (fst loc) -> identity (phi @ loc).
Definition eq_mod_blockslice (S: block -> Prop) (phi phi': rmap) :=
forall loc, (S (fst loc) -> phi @ loc = phi' @ loc) .
Definition blockslice_mpred (S: block -> Prop) (P: mpred) :=
(forall phi, P phi -> forall loc, ~S (fst loc) -> identity (phi @ loc)) /\
(forall phi phi', blockslice_rmap S phi -> blockslice_rmap S phi' ->
eq_mod_blockslice S phi phi' ->
P phi -> P phi').
Definition blockslice_mpred_rmap:
forall S (Sdec: forall b, {S b}+{~S b}) P phi,
blockslice_mpred S P -> P phi -> blockslice_rmap S phi.
Definition init_data2pred (d: init_data)  (sh: share) (a: val) (rho: environ) : mpred :=
match d with
| Init_int8 i => mapsto sh (Tint I8 Unsigned noattr) a (Vint (Int.zero_ext 8 i))
| Init_int16 i => mapsto sh (Tint I16 Unsigned noattr) a (Vint (Int.zero_ext 16 i))
| Init_int32 i => mapsto sh (Tint I32 Unsigned noattr) a (Vint i)
| Init_int64 i => mapsto sh (Tlong Unsigned noattr) a (Vlong i)
| Init_float32 r =>  mapsto sh (Tfloat F32 noattr) a (Vsingle r)
| Init_float64 r =>  mapsto sh (Tfloat F64 noattr) a (Vfloat r)
| Init_space n => mapsto_zeros n sh a
| Init_addrof symb ofs =>
match Map.get (ge_of rho) symb with
| Some b => mapsto sh (Tpointer Tvoid noattr) a (Vptr b ofs)
| _ => mapsto_ sh (Tpointer Tvoid noattr) a
end
end.
Fixpoint init_data_list2pred  (dl: list init_data)
(sh: share) (v: val)  : environ -> pred rmap :=
match dl with
| d::dl' =>
lift2 sepcon (init_data2pred d sh v)
(init_data_list2pred dl' sh (offset_val (init_data_size d) v))
| nil => lift0 emp
end.
Definition readonly2share (rdonly: bool) : share :=
if rdonly then Ers else Ews.
Definition globals_of_env (rho: environ) (i: ident) : val :=
match Map.get (ge_of rho) i with Some b => Vptr b Ptrofs.zero | None => Vundef end.
Definition globvar2pred (gv: ident->val) (idv: ident * globvar type) : assert :=
if (gvar_volatile (snd idv))
then  lift0 TT
else    init_data_list2pred (gvar_init (snd idv))
(readonly2share (gvar_readonly (snd idv))) (gv (fst idv)).
Definition globvars2pred (gv: ident->val) (vl: list (ident * globvar type)) : assert :=
(lift2 andp) (fun rho => prop (gv = globals_of_env rho))
(fold_right (lift2 sepcon) (lift0 emp) (map (globvar2pred gv) vl)).
Definition load_store_init_data1 (ge: Genv.t fundef type) (m: mem) (b: block) (p: Z) (d: init_data) : Prop :=
match d with
| Init_int8 n =>
Mem.load Mint8unsigned m b p = Some(Vint(Int.zero_ext 8 n))
| Init_int16 n =>
Mem.load Mint16unsigned m b p = Some(Vint(Int.zero_ext 16 n))
| Init_int32 n =>
Mem.load Mint32 m b p = Some(Vint n)
| Init_int64 n =>
Mem.load Mint64 m b p = Some(Vlong n)
| Init_float32 n =>
Mem.load Mfloat32 m b p = Some(Vsingle n)
| Init_float64 n =>
Mem.load Mfloat64 m b p = Some(Vfloat n)
| Init_addrof symb ofs =>
Mem.load Mptr m b p = Some
match Genv.find_symbol ge symb with
| Some b' => Vptr b' ofs
| None => Vint Int.zero
end
| Init_space n =>
forall z, 0 <= z < Z.max n 0 ->
Mem.load Mint8unsigned m b (p+z) = Some (Vint Int.zero)
end.
Definition initializer_aligned (z: Z) (d: init_data) : bool :=
match d with
| Init_int16 n => Zeq_bool (z mod 2) 0
| Init_int32 n => Zeq_bool (z mod 4) 0
| Init_int64 n => Zeq_bool (z mod 8) 0
| Init_float32 n =>  Zeq_bool (z mod 4) 0
| Init_float64 n =>  Zeq_bool (z mod 8) 0
| Init_addrof symb ofs =>  Zeq_bool (z mod (size_chunk Mptr)) 0
| _ => true
end.
Fixpoint initializers_aligned (z: Z) (dl: list init_data) : bool :=
match dl with
| nil => true
| d::dl' => andb (initializer_aligned z d) (initializers_aligned (z + init_data_size d) dl')
end.
Remark store_zeros_load_outside:
forall m b p n m',
store_zeros m b p n = Some m' ->
forall chunk b' p',
b' <> b \/ p' + size_chunk chunk <= p \/ p + n <= p' ->
Mem.load chunk m' b' p' = Mem.load chunk m b' p'.
Remark store_init_data_outside:
forall {F V} genv b i m p m',
@Genv.store_init_data F V genv m b p i = Some m' ->
forall chunk b' q,
b' <> b \/ q + size_chunk chunk <= p \/ p + init_data_size i <= q ->
Mem.load chunk m' b' q = Mem.load chunk m b' q.
Remark store_init_data_list_outside:
forall {F V} genv b il m p m',
@Genv.store_init_data_list F V genv m b p il = Some m' ->
forall chunk b' q,
b' <> b \/ q + size_chunk chunk <= p ->
Mem.load chunk m' b' q = Mem.load chunk m b' q.
(* Lemma read_sh_readonly: forall NU, read_sh = mk_lifted (readonly2share true) NU. *)
(* Lemma nonunit_readonly2share: forall v, nonunit (readonly2share (@gvar_readonly type v)). *)
(* Lemma readable_splice_extern: forall v, readable_share (Share.lub extern_retainer (readonly2share (@gvar_readonly type v))). *)
Definition all_initializers_aligned (prog: program) :=
forallb (fun idv => andb (initializers_aligned 0 (gvar_init (snd idv)))
(Zlt_bool (init_data_list_size (gvar_init (snd idv))) Ptrofs.modulus))
(prog_vars prog) = true.
Definition prog_var_block (rho: environ) (il: list ident) (b: block) : Prop :=
Exists (fun id => match ge_of rho id with Some b' => b'=b | _ => False end) il.
(* EXPERIMENT Lemma match_fdecs_nil: forall vl, match_fdecs vl nil. *)
Definition hackfun phi0 phi :=
level phi0 = level phi /\ ghost_of phi0 = ghost_of phi /\
forall loc, (identity (phi0 @ loc) <-> identity (phi @ loc)) /\
(~identity (phi0 @ loc) -> (phi0 @ loc = phi @ loc)).
(* Lemma alloc_global_inflate_identity_iff: forall gev m0 i f m G n loc, Genv.alloc_global gev m0 (i, Gfun f) = Some m -> (identity (inflate_initial_mem m0 (initial_core gev G n) @ loc) <-> identity (inflate_initial_mem m (initial_core gev G n) @ loc)). *)

Lemma alloc_global_identity_lemma3:
forall gev m0 i f m G n loc,
Genv.alloc_global gev m0 (i, Gfun f) = Some m ->
identity (inflate_initial_mem m (initial_core gev G n) @ loc) ->
identity (inflate_initial_mem m0 (initial_core gev G n) @ loc).