Section extensions.
Context {CS: compspecs} {Espec: OracleKind}.
(*genv_cenv ge = cenv_cs*) cenv_sub cenv_cs (genv_cenv ge) -> exists jm', exists te', exists rho', rho' = mkEnviron (ge_of rho) (ve_of rho) (make_tenv te') /\ level jm = S (level jm') /\ guard_environ Delta' f rho'  /\ jstep (cl_core_sem ge) (State f c k ve te) jm (State f Sskip k ve te') jm' /\ ((F rho' * Q rho') && funassert Delta' rho) (m_phi jm')) -> semax Espec Delta (fun rho => B rho && |> P rho) c (normal_ret_assert Q).  Definition force_valid_pointers m v1 v2 := match v1, v2 with | Vptr b1 ofs1, Vptr b2 ofs2 => (Mem.valid_pointer m b1 (Ptrofs.unsigned ofs1) && Mem.valid_pointer m b2 (Ptrofs.unsigned ofs2))%bool | _, _ => false end.  Definition blocks_match op v1 v2 := match op with Cop.Olt | Cop.Ogt | Cop.Ole | Cop.Oge => match v1, v2 with Vptr b _, Vptr b2 _ => b=b2 | _, _ => False end | _ => True end.  Lemma later_sepcon2  {A} {JA: Join A}{PA: Perm_alg A}{SA: Sep_alg A}{AG: ageable A}{XA: Age_alg A}: forall P Q,  P * |> Q |-- |> (P * Q).   Lemma perm_order''_trans: forall x y z, perm_order'' x y -> perm_order'' y z -> perm_order'' x z.  Lemma mapsto_valid_pointer : forall b o sh t jm, nonidentity sh -> (mapsto_ sh (t) (Vptr b o) * TT)%pred (m_phi jm) -> Mem.valid_pointer (m_dry jm) b (Ptrofs.unsigned o) = true. intros. rename H into N.  destruct H0. destruct H. destruct H. destruct H0. unfold mapsto_,mapsto in H0.  unfold mapsto in *. destruct (readable_share_dec sh) as [H2 | H2]. * (* readable_share sh *)
destruct (access_mode t); try solve [ inv H0].
destruct (type_is_volatile t) eqn:VOL; try contradiction.
assert (exists v,  address_mapsto m v sh (b, Ptrofs.unsigned o) x).
destruct H0.
econstructor; apply H0. destruct H0 as [_ [v2' H0]]; exists v2'; apply H0.
clear H0; destruct H2 as [x1 H0].
pose proof mapsto_core_load m x1 sh (b, Ptrofs.unsigned o) (m_phi jm).
destruct H2. simpl; eauto.
simpl in H2.
destruct H2.
specialize (H3 (b, Ptrofs.unsigned o)).
if_tac in H3.
destruct H3.  destruct H3.
rewrite valid_pointer_nonempty_perm.
unfold perm.
assert (JMA := juicy_mem_access jm (b, Ptrofs.unsigned o)).
unfold access_at in *. simpl in JMA.
unfold perm_of_res in *.
rewrite H3 in JMA. simpl in JMA.
unfold perm_of_sh in *.
rewrite JMA.
repeat if_tac; try constructor. subst.
simpl in H3.
contradiction.
destruct H4.  repeat split. omega.
destruct m; simpl; omega.
* (* ~ readable_share sh *)
destruct (access_mode t) eqn:?; try contradiction.
destruct (type_is_volatile t); [inversion H0 |].
destruct H0 as [_ [? _]].
specialize (H0 (b, Ptrofs.unsigned o)).
simpl in H0.
rewrite if_true in H0
by (split; auto; pose proof (size_chunk_pos m); omega).
clear H1.
pose proof (resource_at_join _ _ _ (b, Ptrofs.unsigned o) H).
unfold resource_share in H0.
rewrite <- (Z.add_0_r (Ptrofs.unsigned o)).
apply (valid_pointer_dry b o 0 jm).
hnf.
rewrite Z.add_0_r.
destruct H0.
destruct  (x @ (b, Ptrofs.unsigned o)); inv H0; inv H1; simpl; auto.
intro.
apply split_identity in RJ; auto.
Qed.
Definition weak_mapsto_ sh e rho :=
match (eval_expr e rho) with
| Vptr b o => (mapsto_ sh (typeof e) (Vptr b o)) ||
(mapsto_ sh (typeof e) (Vptr b o))
| _ => FF
end.
Transparent Int.repr.
Opaque Int.repr.
(*   classify_cast (typeof e1) t1 <> cast_case_p2bool -> *)
intros. symmetry.
unfold retainer_part.
rewrite (comp_parts comp_Lsh_Rsh sh) at 1.
f_equal; auto.
unfold writable0_share in H.
apply leq_join_sub in H.  apply Share.ord_spec1 in H. auto.
Qed.

Lemma address_mapsto_can_store: forall jm ch v sh (wsh: writable0_share sh) b ofs v' my,
(address_mapsto ch v sh (b, Ptrofs.unsigned ofs) * exactly my)%pred (m_phi jm) ->
decode_val ch (encode_val ch v') = v' ->
exists m',
{H: Mem.store ch (m_dry jm) b (Ptrofs.unsigned ofs) v' = Some m'|
(address_mapsto ch v' sh (b, Ptrofs.unsigned ofs) * exactly my)%pred
(m_phi (store_juicy_mem _ _ _ _ _ _ H))}.