Proof with eauto 8 with renamings ge_renamings reg_renamings val_renamings.
intros.
assert (Hinjective := injective (weak_obs_eq Hmem_obs_eq)).
assert (Hstrong_obs := strong_obs_eq Hmem_obs_eq).
destruct i; simpl in *;
unfold goto_label in *;
repeat match goal with
| [H: context[match eval_testcond _ rs with _ => _ end] |- _] =>
erewrite eval_testcond_ren with (rs := rs) (rs' := rs') in H; eauto
end;
repeat match goal with
| [H1: context[match (rs ?R) with _ => _ end] |- _] =>
pose proof (Hrs_eq R); unfold reg_ren, Pregmap.get in *;
destruct (rs R);
match goal with
| [H2: val_obs _ _ _ |- _] =>
inv H2
end
end; auto;
repeat match goal with
| [H: match ?Expr with _ => _ end = _ |- _] =>
destruct Expr eqn:?
end; try discriminate;
try match goal with
| [H: exec_store ?G ?CHUNK ?M ?A ?RS ?RS0 _ = _ |- _] =>
unfold exec_store in *;
destruct (Mem.storev CHUNK M (eval_addrmode G A RS) (RS RS0)) eqn:?;
inv H; exists f
| [H: exec_load ?G ?CHUNK ?M ?A ?RS ?RD = _ |- _] =>
unfold exec_load in *;
destruct (Mem.loadv CHUNK M (eval_addrmode G A RS)) eqn:?;
inv H; exists f
| [H: Next _ _ = Next _ _, H2: Mem.alloc _ _ _ = _  |- _] =>
inv H
| [H: Next _ _ = Next _ _ |- _] =>
inv H; exists f
end;
try match goal with
| [H: Mem.loadv _ _ (eval_addrmode ?G ?A rs) = _ |- _] =>
eapply loadv_val_obs with
(f := f) (mf := m') (vptr2 := eval_addrmode G A rs') in H;
eauto with val_renamings reg_renamings;
destruct H as [? [? ?]]
| [H: Mem.storev _ _ (eval_addrmode ?G ?A rs) (rs ?R) = _ |- _] =>
pose proof (nextblock_storev _ _ _ _ H);
eapply storev_val_obs with
(vptr2 := eval_addrmode g a rs') (v2 := rs' R) in H;
eauto with val_renamings reg_renamings;
destruct H as [? [Hstore' ?]];
rewrite Hstore';
pose proof (nextblock_storev _ _ _ _ Hstore')
| [H: Val.divs _ _ = _, H2: Val.mods _ _ = _ |- _] =>
erewrite divs_ren with (v1' := rs' EAX) (v2' := rs' # EDX <- Vundef r1) in H;
eauto with reg_renamings val_renamings;
erewrite mods_ren with (v1' := rs' EAX) (v2' := rs' # EDX <- Vundef r1)
in H2; eauto with reg_renamings val_renamings
| [H: Val.divu _ _ = _, H2: Val.modu _ _ = _ |- _] =>
erewrite divu_ren with (v1' := rs' EAX) (v2' := rs' # EDX <- Vundef r1) in H;
eauto with reg_renamings val_renamings;
erewrite modu_ren with (v1' := rs' EAX) (v2' := rs' # EDX <- Vundef r1)
in H2; eauto with reg_renamings val_renamings
end;
repeat match goal with
| [|- exists _ _, _ ] => do 2 eexists; split; first by eauto
| [|- _ /\ _] => split; eauto 3 with renamings
| [H: Mem.loadv _ _ _ = _ |- _] =>
rewrite H; clear H
| [H: Val.divu _ _ = _ |- _] =>
rewrite H
| [H: Val.modu _ _ = _ |- _] =>
rewrite H
| [H: Val.divs _ _ = _ |- _] =>
rewrite H
| [H: Val.mods _ _ = _ |- _] =>
rewrite H
| [|- regset_ren _ _ _] =>
unfold nextinstr_nf, nextinstr, Vone, Vzero;
eauto 20 with reg_renamings ge_renamings val_renamings
| [|- forall _, _] => intros
end; try (by exfalso);
repeat match goal with
| [H: Mem.nextblock ?X = Mem.nextblock ?Y,
H2: Mem.valid_block ?X _ |- _] =>
unfold Mem.valid_block in *;
rewrite H in H2;
try by exfalso
| [|- regset_ren _ _ _] =>
autorewrite with reg_renamings;
first by eauto 25 with reg_renamings val_renamings
| [ |- ~ List.In _ _] =>
compute; intros ?
| [H: _ \/ _ |- _] =>
destruct H; try discriminate;
try auto
end;
(* unmapped blocks*)
repeat match goal with
| [|- permissions.permission_at _ _ _ _ = _] =>
do 2 rewrite <- permissions.getCurPerm_correct
| [H: Mem.storev _ _ _ _ = _ |- _] =>
destruct (mem_storev_store _ _ _ _ _ H) as (? & ? & ? & ?);
erewrite mem_store_cur by eauto;
reflexivity
end.
(* Cleaning up some cases manually, to avoid overcomplicating automation*)
apply regset_ren_set.
apply regset_ren_undef.
apply regset_ren_set...
apply val_obs_offset_ptr...
repeat match goal with
| [|- val_obs _ (undef_regs _ _ _) _] =>
rewrite gso_undef_regs
| [|- val_obs _ _ (undef_regs _ _ _)] =>
rewrite gso_undef_regs
| [ |- ~ List.In _ _] =>
compute; intros ?
| [H: _ \/ _ |- _] =>
destruct H; try discriminate;
try auto
end.
erewrite Pregmap.gso by congruence...
apply regset_ren_set.
apply regset_ren_undef.
apply regset_ren_set...
apply val_obs_offset_ptr...
repeat match goal with
| [|- val_obs _ (undef_regs _ _ _) _] =>
rewrite gso_undef_regs
| [|- val_obs _ _ (undef_regs _ _ _)] =>
rewrite gso_undef_regs
| [ |- ~ List.In _ _] =>
compute; intros ?
| [H: _ \/ _ |- _] =>
destruct H; try discriminate;
try auto
end.
erewrite Pregmap.gso by congruence...
erewrite !Pregmap.gso in * by discriminate.
pose proof (Hrs_eq PC) as HPC.
unfold reg_ren, Pregmap.get in HPC; rewrite Heqv in HPC; inv HPC.
repeat match goal with
| [|- exists _ _, _ ] => do 2 eexists; split; first by eauto
| [|- _ /\ _] => split; eauto 3 with renamings
| [|- regset_ren _ _ _] =>
unfold nextinstr_nf, nextinstr, Vone, Vzero;
eauto 20 with reg_renamings ge_renamings val_renamings
| [|- forall _, _] => intros
end; try (by exfalso).
(* Allocation case*)
destruct (Mem.alloc m' 0 sz) as [m0' b'] eqn:Halloc'.
destruct (alloc_obs_eq Hmem_obs_eq Heqp Halloc') as
(f' & Hf' & Hmem_obs_eq' & Hincr' & Hsep & Hnextblock & Hinverse & Hid).
exists f'.
pose proof (Mem.nextblock_store _ _ _ _ _ _ Heqo) as Hnext.
eapply store_val_obs with (f := f') (mf := m0') (b2 := b') in Heqo...
destruct Heqo as [m1' [Hstore' ?]].
pose proof (Mem.nextblock_store _ _ _ _ _ _ Hstore') as Hnext'.
pose proof (Mem.nextblock_store _ _ _ _ _ _ Heqo0) as Hnext0.
eapply store_val_obs with (f := f') (mf := m1') (b2 := b') in Heqo0...
destruct Heqo0 as [m2' [Hstore'' ?]].
pose proof (Mem.nextblock_store _ _ _ _ _ _ Hstore'') as Hnext0'.
unfold nextinstr. eexists. exists m2'.
unfold Mem.valid_block in *.
rewrite Hstore' Hstore''.
rewrite Hnext0' Hnext0 Hnext Hnext'.
repeat match goal with
| [|- exists _ _, _ ] => do 2 eexists; split; first by eauto
| [|- _ /\ _] => split; eauto 3 with renamings
| [|- regset_ren _ _ _] =>
unfold nextinstr_nf, nextinstr, Vone, Vzero;
eauto 20 using regset_ren_incr
with reg_renamings ge_renamings val_renamings
| [|- forall _, _] => intros
end; try (by exfalso).
assert (b2 <> b')
by (intros Hcontra; subst;
eauto).
erewrite permission_at_alloc_4 with (m := m') (m' := m0'); eauto.
do 2 rewrite <- permissions.getCurPerm_correct.
erewrite mem_store_cur by eauto.
erewrite mem_store_cur by eauto.
reflexivity.
(* Free case *)
pose proof (Mem.nextblock_free _ _ _ _ _ Heqo1) as Hnb.
eapply mem_free_obs in Heqo1...
destruct Heqo1 as [m2' [Hfree' ?]].
pose proof (Mem.nextblock_free _ _ _ _ _ Hfree') as Hnb'.
rewrite Hfree'.
eapply loadv_val_obs with
(f := f) (mf := m') (vptr2 := Val.offset_ptr (Vptr b2 i) ofs_ra) in Heqo;
eauto with val_renamings reg_renamings;
destruct Heqo as [? [Hload' ?]].
eapply loadv_val_obs with
(f := f) (mf := m') (vptr2 := Val.offset_ptr (Vptr b2 i) ofs_link) in Heqo0;
eauto with val_renamings reg_renamings;
destruct Heqo0 as [? [Hload2' ?]].
rewrite Hload' Hload2'.
eexists; exists m2'.
unfold nextinstr, Mem.valid_block.
rewrite Hnb' Hnb.
repeat match goal with
| [|- exists _ _, _ ] => do 2 eexists; split; first by eauto
| [|- _ /\ _] => split; eauto 3 with renamings
| [|- regset_ren _ _ _] =>
unfold nextinstr_nf, nextinstr, Vone, Vzero;
eauto 20 with reg_renamings ge_renamings val_renamings
| [|- forall _, _] => intros
end; try (by exfalso).
assert (b2 <> b0)
by (intros Hcontra; subst; eauto).
erewrite permission_at_free_2 by eauto.
reflexivity.
Qed.

(* Specifications: *)
Lemma extcall_arg_reg:
forall f rs rs' m m' locs arg
(Hrs_ren: regset_ren f rs rs')
(Hobs_eq: mem_obs_eq f m m')
(Harg: extcall_arg rs m locs arg),
exists arg',
extcall_arg rs' m' locs arg' /\
val_obs f arg arg'.