Ltac unify_injection:=
match goal with
[H: ?mu ?x = _,H0: ?mu ?x = _ |- _] =>
match type of mu with
| meminj => rewrite H in H0; invert H0
| block -> option (block * Z) => rewrite H in H0; invert H0
end
end.
Local Ltac unify_mapping:=
match goal with
[H: ?a !! ?x ?y = Some _ ,
H0: ?a !! ?x ?y = _ |- _] => rewrite H in H0
| [H: ?a !! ?x ?y = None ,
H0: ?a !! ?x ?y = _ |- _] => rewrite H in H0
| [H: ?a !! ?x ?y = Some _ ,
H0: _ = ?a !! ?x ?y |- _] => rewrite H in H0
| [H: ?a !! ?x ?y = None ,
H0: _ = ?a !! ?x ?y |- _] => rewrite H in H0
end.
Definition inject_lock' size mu (b_lock:block) (ofs_lock: Z) (m1 m2:mem):=
exists b_lock' delt,
mu b_lock = Some (b_lock', delt) /\
( forall ofs0,
Intv.In ofs0 (ofs_lock, (ofs_lock + size)%Z) ->
memval_inject mu
(ZMap.get ofs0 (Mem.mem_contents m1) !! b_lock)
(ZMap.get (ofs0 + delt)%Z
(Mem.mem_contents m2) !! b_lock')).
Definition inject_lock := inject_lock' LKSIZE.
Instance inject_lock_morphism:
Proper (Logic.eq ==> Logic.eq ==> Logic.eq ==>
content_equiv ==> content_equiv ==> iff) inject_lock.
Definition option_implication {A B} (oa:option A) (ob: option B):=
match oa, ob with | Some _, None => False | _, _ => True end.
Definition map_option_implication {A B} (m1:PTree.t A) (m2:PTree.t B):=
forall b, option_implication (m1 ! b) (m2 ! b).
Definition at_least_Some {A} (x:option A):=
option_implication (Some tt) x.
Definition perm_image (f:meminj) (a1: access_map): Prop:=
forall b1 ofs, at_least_Some (a1 !! b1 ofs) ->
exists b2 delta, f b1 = Some (b2, delta).
Instance proper_perm_image:
Proper (Logic.eq ==> access_map_equiv ==> iff) perm_image.
(* The injection maps to every visible location *)
Definition perm_surj (mu:meminj) (a1 a2: access_map):=
forall b2 ofs_delt,
at_least_Some (a2 !! b2 ofs_delt) ->
exists b1 ofs delt, mu b1 = Some (b2, delt) /\
ofs_delt = ofs + delt /\
a2 !! b2 ofs_delt = a1 !! b1 ofs.
(* The injection maps all visible locations*)
Definition access_map_injected (f:meminj) (pmap1 pmap2: access_map):=
forall (b1 b2 : block) (delt ofs: Z),
f b1 = Some (b2, delt) ->
Mem.perm_order'' (pmap2 !! b2 (ofs+delt)%Z) (pmap1 !! b1 ofs).
intros. intros ?????.
do 2 rewrite getMaxPerm_correct.
destruct (permission_at m1 b1 ofs Max) eqn:HH.
- rewrite <- mem_lemmas.po_oo.
eapply Mem.mi_perm; eauto.
+ apply H.
+ unfold Mem.perm.
unfold permission_at in HH; rewrite HH.
simpl. apply perm_refl.
- apply event_semantics.po_None.
Qed.
intros. intros ?????.
do 2 rewrite getCurPerm_correct.
destruct (permission_at m1 b1 ofs Cur) eqn:HH.
- rewrite <- mem_lemmas.po_oo.
eapply Mem.mi_perm; eauto.
+ apply H.
+ unfold Mem.perm.
unfold permission_at in HH;
rewrite HH.
simpl.
apply perm_refl.
- apply event_semantics.po_None.
Qed.

Lemma setPermBlock_inject_permMapLt:
forall n (NZ: (0 < n)%nat)
(m1 m2 : mem)
(mu : meminj) cur_perm1 cur_perm2 max_perm1 max_perm2
(b : block) ofs P,
permMapLt (setPermBlock P b (ofs) cur_perm1 n)
max_perm1 ->
Mem.inject mu m1 m2 ->
access_map_injected mu max_perm1 max_perm2 ->
forall (b' : block) (delt : Z),
mu b = Some (b', delt) ->
permMapLt cur_perm2 max_perm2 ->
permMapLt (setPermBlock P b' (ofs + delt)
cur_perm2 n) max_perm2.