aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--aarch64/CSE2deps.v5
-rw-r--r--aarch64/CSE2depsproof.v75
-rw-r--r--arm/CSE2deps.v5
-rw-r--r--arm/CSE2depsproof.v74
-rw-r--r--backend/Tunnelingaux.ml4
-rw-r--r--kvx/CSE2deps.v5
-rw-r--r--kvx/CSE2depsproof.v29
-rw-r--r--powerpc/CSE2deps.v5
-rw-r--r--powerpc/CSE2depsproof.v71
-rw-r--r--riscV/CSE2deps.v5
-rw-r--r--riscV/CSE2depsproof.v12
-rw-r--r--x86/CSE2deps.v2
-rw-r--r--x86/CSE2depsproof.v82
13 files changed, 343 insertions, 31 deletions
diff --git a/aarch64/CSE2deps.v b/aarch64/CSE2deps.v
index a23e41a8..d5c7ee0f 100644
--- a/aarch64/CSE2deps.v
+++ b/aarch64/CSE2deps.v
@@ -28,5 +28,8 @@ Definition may_overlap chunk addr args chunk' addr' args' :=
(base :: nil), (base' :: nil) =>
if peq base base'
then negb (can_swap_accesses_ofs (Int64.unsigned ofs') chunk' (Int64.unsigned ofs) chunk)
- else true | _, _, _, _ => true
+ else true
+ | (Ainstack ofs), (Ainstack ofs'), _, _ =>
+ negb (can_swap_accesses_ofs (Ptrofs.unsigned ofs') chunk' (Ptrofs.unsigned ofs) chunk)
+ | _, _, _, _ => true
end.
diff --git a/aarch64/CSE2depsproof.v b/aarch64/CSE2depsproof.v
index dbd46142..653c88f4 100644
--- a/aarch64/CSE2depsproof.v
+++ b/aarch64/CSE2depsproof.v
@@ -104,9 +104,71 @@ Section MEMORY_WRITE.
Qed.
End INDEXED_AWAY.
End MEMORY_WRITE.
-End SOUNDNESS.
+Section STACK_WRITE.
+ Variable m m2 : mem.
+ Variable chunkw chunkr : memory_chunk.
+
+ Variable addrw addrr valw : val.
+ Hypothesis STORE : Mem.storev chunkw m addrw valw = Some m2.
+
+ Section INDEXED_AWAY.
+ Variable ofsw ofsr : ptrofs.
+ Hypothesis ADDRW : eval_addressing genv sp
+ (Ainstack ofsw) nil = Some addrw.
+ Hypothesis ADDRR : eval_addressing genv sp
+ (Ainstack ofsr) nil = Some addrr.
+
+ Lemma stack_load_store_away1 :
+ forall RANGEW : 0 <= Ptrofs.unsigned ofsw <= Ptrofs.modulus - largest_size_chunk,
+ forall RANGER : 0 <= Ptrofs.unsigned ofsr <= Ptrofs.modulus - largest_size_chunk,
+ forall SWAPPABLE : Ptrofs.unsigned ofsw + size_chunk chunkw <= Ptrofs.unsigned ofsr
+ \/ Ptrofs.unsigned ofsr + size_chunk chunkr <= Ptrofs.unsigned ofsw,
+ Mem.loadv chunkr m2 addrr = Mem.loadv chunkr m addrr.
+ Proof.
+ intros.
+
+ pose proof (max_size_chunk chunkr) as size_chunkr_bounded.
+ pose proof (max_size_chunk chunkw) as size_chunkw_bounded.
+ unfold largest_size_chunk in *.
+
+ rewrite ptrofs_modulus in *.
+ simpl in *.
+ inv ADDRR.
+ inv ADDRW.
+
+ destruct sp; try discriminate.
+ eapply Mem.load_store_other with (chunk := chunkw) (v := valw) (b := b).
+ exact STORE.
+ right.
+
+ all: try (destruct (Ptrofs.unsigned_add_either i ofsr) as [OFSR | OFSR];
+ rewrite OFSR).
+ all: try (destruct (Ptrofs.unsigned_add_either i ofsw) as [OFSW | OFSW];
+ rewrite OFSW).
+
+ all: try rewrite ptrofs_modulus in *.
+
+ all: intuition lia.
+ Qed.
+
+ Theorem stack_load_store_away :
+ can_swap_accesses_ofs (Ptrofs.unsigned ofsr) chunkr (Ptrofs.unsigned ofsw) chunkw = true ->
+ Mem.loadv chunkr m2 addrr = Mem.loadv chunkr m addrr.
+ Proof.
+ intro SWAP.
+ unfold can_swap_accesses_ofs in SWAP.
+ repeat rewrite andb_true_iff in SWAP.
+ repeat rewrite orb_true_iff in SWAP.
+ repeat rewrite Z.leb_le in SWAP.
+ apply stack_load_store_away1.
+ all: tauto.
+ Qed.
+ End INDEXED_AWAY.
+End STACK_WRITE.
+End SOUNDNESS.
+
Section SOUNDNESS.
Variable F V : Type.
Variable genv: Genv.t F V.
@@ -124,7 +186,7 @@ Proof.
intros until rs.
intros ADDR ADDR' OVERLAP STORE.
destruct addr; destruct addr'; try discriminate.
- { (* Aindexed / Aindexed *)
+ - (* Aindexed / Aindexed *)
destruct args as [ | base [ | ]]. 1,3: discriminate.
destruct args' as [ | base' [ | ]]. 1,3: discriminate.
simpl in OVERLAP.
@@ -134,7 +196,14 @@ Proof.
2: discriminate.
simpl in *.
eapply load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
- }
+- (* Ainstack / Ainstack *)
+ destruct args. 2: discriminate.
+ destruct args'. 2: discriminate.
+ cbn in OVERLAP.
+ destruct (can_swap_accesses_ofs (Ptrofs.unsigned ofs0) chunk' (Ptrofs.unsigned ofs) chunk) eqn:SWAP.
+ 2: discriminate.
+ cbn in *.
+ eapply stack_load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
Qed.
End SOUNDNESS.
diff --git a/arm/CSE2deps.v b/arm/CSE2deps.v
index d48dabf3..4592f408 100644
--- a/arm/CSE2deps.v
+++ b/arm/CSE2deps.v
@@ -28,5 +28,8 @@ Definition may_overlap chunk addr args chunk' addr' args' :=
(base :: nil), (base' :: nil) =>
if peq base base'
then negb (can_swap_accesses_ofs (Int.unsigned ofs') chunk' (Int.unsigned ofs) chunk)
- else true | _, _, _, _ => true
+ else true
+ | (Ainstack ofs), (Ainstack ofs'), _, _ =>
+ negb (can_swap_accesses_ofs (Ptrofs.unsigned ofs') chunk' (Ptrofs.unsigned ofs) chunk)
+ | _, _, _, _ => true
end.
diff --git a/arm/CSE2depsproof.v b/arm/CSE2depsproof.v
index 28ef41ca..7dd0914e 100644
--- a/arm/CSE2depsproof.v
+++ b/arm/CSE2depsproof.v
@@ -105,6 +105,68 @@ Section MEMORY_WRITE.
Qed.
End INDEXED_AWAY.
End MEMORY_WRITE.
+
+Section STACK_WRITE.
+ Variable m m2 : mem.
+ Variable chunkw chunkr : memory_chunk.
+
+ Variable addrw addrr valw : val.
+ Hypothesis STORE : Mem.storev chunkw m addrw valw = Some m2.
+
+ Section INDEXED_AWAY.
+ Variable ofsw ofsr : ptrofs.
+ Hypothesis ADDRW : eval_addressing genv sp
+ (Ainstack ofsw) nil = Some addrw.
+ Hypothesis ADDRR : eval_addressing genv sp
+ (Ainstack ofsr) nil = Some addrr.
+
+ Lemma stack_load_store_away1 :
+ forall RANGEW : 0 <= Ptrofs.unsigned ofsw <= Ptrofs.modulus - largest_size_chunk,
+ forall RANGER : 0 <= Ptrofs.unsigned ofsr <= Ptrofs.modulus - largest_size_chunk,
+ forall SWAPPABLE : Ptrofs.unsigned ofsw + size_chunk chunkw <= Ptrofs.unsigned ofsr
+ \/ Ptrofs.unsigned ofsr + size_chunk chunkr <= Ptrofs.unsigned ofsw,
+ Mem.loadv chunkr m2 addrr = Mem.loadv chunkr m addrr.
+ Proof.
+ intros.
+
+ pose proof (max_size_chunk chunkr) as size_chunkr_bounded.
+ pose proof (max_size_chunk chunkw) as size_chunkw_bounded.
+ unfold largest_size_chunk in *.
+
+ rewrite ptrofs_modulus in *.
+ simpl in *.
+ inv ADDRR.
+ inv ADDRW.
+
+ destruct sp; try discriminate.
+ eapply Mem.load_store_other with (chunk := chunkw) (v := valw) (b := b).
+ exact STORE.
+ right.
+
+ all: try (destruct (Ptrofs.unsigned_add_either i ofsr) as [OFSR | OFSR];
+ rewrite OFSR).
+ all: try (destruct (Ptrofs.unsigned_add_either i ofsw) as [OFSW | OFSW];
+ rewrite OFSW).
+
+ all: try rewrite ptrofs_modulus in *.
+
+ all: intuition lia.
+ Qed.
+
+ Theorem stack_load_store_away :
+ can_swap_accesses_ofs (Ptrofs.unsigned ofsr) chunkr (Ptrofs.unsigned ofsw) chunkw = true ->
+ Mem.loadv chunkr m2 addrr = Mem.loadv chunkr m addrr.
+ Proof.
+ intro SWAP.
+ unfold can_swap_accesses_ofs in SWAP.
+ repeat rewrite andb_true_iff in SWAP.
+ repeat rewrite orb_true_iff in SWAP.
+ repeat rewrite Z.leb_le in SWAP.
+ apply stack_load_store_away1.
+ all: tauto.
+ Qed.
+ End INDEXED_AWAY.
+End STACK_WRITE.
End SOUNDNESS.
@@ -125,7 +187,7 @@ Proof.
intros until rs.
intros ADDR ADDR' OVERLAP STORE.
destruct addr; destruct addr'; try discriminate.
- { (* Aindexed / Aindexed *)
+- (* Aindexed / Aindexed *)
destruct args as [ | base [ | ]]. 1,3: discriminate.
destruct args' as [ | base' [ | ]]. 1,3: discriminate.
simpl in OVERLAP.
@@ -135,7 +197,15 @@ Proof.
2: discriminate.
simpl in *.
eapply load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
- }
+
+- (* Ainstack / Ainstack *)
+ destruct args. 2: discriminate.
+ destruct args'. 2: discriminate.
+ cbn in OVERLAP.
+ destruct (can_swap_accesses_ofs (Ptrofs.unsigned i0) chunk' (Ptrofs.unsigned i) chunk) eqn:SWAP.
+ 2: discriminate.
+ cbn in *.
+ eapply stack_load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
Qed.
End SOUNDNESS.
diff --git a/backend/Tunnelingaux.ml b/backend/Tunnelingaux.ml
index af89adea..87e6d303 100644
--- a/backend/Tunnelingaux.ml
+++ b/backend/Tunnelingaux.ml
@@ -178,11 +178,11 @@ let final_export f c =
) else (
n.dist <- undef_dist; (* force [dist] to compute the actual [n.dist] *)
count := !count+1;
- (tn, n)::acc
+ n::acc
)
in
let nops = Hashtbl.fold filter_nops_init_dist c.nodes [] in
- let res = List.fold_left (fun acc (tn,n) -> PTree.set (lab_p n) (lab_p tn, Z.of_uint (dist n)) acc) PTree.empty nops in
+ let res = List.fold_left (fun acc n -> PTree.set (lab_p n) (lab_p n.link, Z.of_uint (dist n)) acc) PTree.empty nops in
debug "* Tunneling.branch_target: final number of eliminated nops = %d\n" !count;
res
diff --git a/kvx/CSE2deps.v b/kvx/CSE2deps.v
index b4b80e2f..c0deacf0 100644
--- a/kvx/CSE2deps.v
+++ b/kvx/CSE2deps.v
@@ -28,5 +28,8 @@ Definition may_overlap chunk addr args chunk' addr' args' :=
(base :: nil), (base' :: nil) =>
if peq base base'
then negb (can_swap_accesses_ofs (Ptrofs.unsigned ofs') chunk' (Ptrofs.unsigned ofs) chunk)
- else true | _, _, _, _ => true
+ else true
+ | (Ainstack ofs), (Ainstack ofs'), _, _ =>
+ negb (can_swap_accesses_ofs (Ptrofs.unsigned ofs') chunk' (Ptrofs.unsigned ofs) chunk)
+ | _, _, _, _ => true
end.
diff --git a/kvx/CSE2depsproof.v b/kvx/CSE2depsproof.v
index 6c584450..a5f7b317 100644
--- a/kvx/CSE2depsproof.v
+++ b/kvx/CSE2depsproof.v
@@ -123,17 +123,24 @@ Proof.
intros until rs.
intros ADDR ADDR' OVERLAP STORE.
destruct addr; destruct addr'; try discriminate.
- { (* Aindexed / Aindexed *)
- destruct args as [ | base [ | ]]. 1,3: discriminate.
- destruct args' as [ | base' [ | ]]. 1,3: discriminate.
- cbn in OVERLAP.
- destruct (peq base base'). 2: discriminate.
- subst base'.
- destruct (can_swap_accesses_ofs (Ptrofs.unsigned i0) chunk' (Ptrofs.unsigned i) chunk) eqn:SWAP.
- 2: discriminate.
- cbn in *.
- eapply load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
- }
+ - (* Aindexed / Aindexed *)
+ destruct args as [ | base [ | ]]. 1,3: discriminate.
+ destruct args' as [ | base' [ | ]]. 1,3: discriminate.
+ cbn in OVERLAP.
+ destruct (peq base base'). 2: discriminate.
+ subst base'.
+ destruct (can_swap_accesses_ofs (Ptrofs.unsigned i0) chunk' (Ptrofs.unsigned i) chunk) eqn:SWAP.
+ 2: discriminate.
+ cbn in *.
+ eapply load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
+ - (* Ainstack / Ainstack *)
+ destruct args. 2: discriminate.
+ destruct args'. 2: discriminate.
+ cbn in OVERLAP.
+ destruct (can_swap_accesses_ofs (Ptrofs.unsigned i0) chunk' (Ptrofs.unsigned i) chunk) eqn:SWAP.
+ 2: discriminate.
+ cbn in *.
+ eapply load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
Qed.
End SOUNDNESS.
diff --git a/powerpc/CSE2deps.v b/powerpc/CSE2deps.v
index d48dabf3..4592f408 100644
--- a/powerpc/CSE2deps.v
+++ b/powerpc/CSE2deps.v
@@ -28,5 +28,8 @@ Definition may_overlap chunk addr args chunk' addr' args' :=
(base :: nil), (base' :: nil) =>
if peq base base'
then negb (can_swap_accesses_ofs (Int.unsigned ofs') chunk' (Int.unsigned ofs) chunk)
- else true | _, _, _, _ => true
+ else true
+ | (Ainstack ofs), (Ainstack ofs'), _, _ =>
+ negb (can_swap_accesses_ofs (Ptrofs.unsigned ofs') chunk' (Ptrofs.unsigned ofs) chunk)
+ | _, _, _, _ => true
end.
diff --git a/powerpc/CSE2depsproof.v b/powerpc/CSE2depsproof.v
index 123341da..ede09dd6 100644
--- a/powerpc/CSE2depsproof.v
+++ b/powerpc/CSE2depsproof.v
@@ -111,6 +111,66 @@ Section MEMORY_WRITE.
Qed.
End INDEXED_AWAY.
End MEMORY_WRITE.
+
+Section STACK_WRITE.
+ Variable m m2 : mem.
+ Variable chunkw chunkr : memory_chunk.
+
+ Variable addrw addrr valw : val.
+ Hypothesis STORE : Mem.storev chunkw m addrw valw = Some m2.
+
+ Section INDEXED_AWAY.
+ Variable ofsw ofsr : ptrofs.
+ Hypothesis ADDRW : eval_addressing genv sp
+ (Ainstack ofsw) nil = Some addrw.
+ Hypothesis ADDRR : eval_addressing genv sp
+ (Ainstack ofsr) nil = Some addrr.
+
+ Lemma stack_load_store_away1 :
+ forall RANGEW : 0 <= Ptrofs.unsigned ofsw <= Ptrofs.modulus - largest_size_chunk,
+ forall RANGER : 0 <= Ptrofs.unsigned ofsr <= Ptrofs.modulus - largest_size_chunk,
+ forall SWAPPABLE : Ptrofs.unsigned ofsw + size_chunk chunkw <= Ptrofs.unsigned ofsr
+ \/ Ptrofs.unsigned ofsr + size_chunk chunkr <= Ptrofs.unsigned ofsw,
+ Mem.loadv chunkr m2 addrr = Mem.loadv chunkr m addrr.
+ Proof.
+ intros.
+
+ pose proof (max_size_chunk chunkr) as size_chunkr_bounded.
+ pose proof (max_size_chunk chunkw) as size_chunkw_bounded.
+ unfold largest_size_chunk in *.
+
+ inv ADDRR.
+ inv ADDRW.
+
+ destruct sp; try discriminate.
+ eapply Mem.load_store_other with (chunk := chunkw) (v := valw) (b := b).
+ exact STORE.
+ right.
+
+ all: try (destruct (Ptrofs.unsigned_add_either i ofsr) as [OFSR | OFSR];
+ rewrite OFSR).
+ all: try (destruct (Ptrofs.unsigned_add_either i ofsw) as [OFSW | OFSW];
+ rewrite OFSW).
+ all: try rewrite ptrofs_modulus in *.
+ all: destruct Archi.ptr64.
+
+ all: intuition lia.
+ Qed.
+
+ Theorem stack_load_store_away :
+ can_swap_accesses_ofs (Ptrofs.unsigned ofsr) chunkr (Ptrofs.unsigned ofsw) chunkw = true ->
+ Mem.loadv chunkr m2 addrr = Mem.loadv chunkr m addrr.
+ Proof.
+ intro SWAP.
+ unfold can_swap_accesses_ofs in SWAP.
+ repeat rewrite andb_true_iff in SWAP.
+ repeat rewrite orb_true_iff in SWAP.
+ repeat rewrite Z.leb_le in SWAP.
+ apply stack_load_store_away1.
+ all: tauto.
+ Qed.
+ End INDEXED_AWAY.
+End STACK_WRITE.
End SOUNDNESS.
@@ -131,7 +191,7 @@ Proof.
intros until rs.
intros ADDR ADDR' OVERLAP STORE.
destruct addr; destruct addr'; try discriminate.
- { (* Aindexed / Aindexed *)
+- (* Aindexed / Aindexed *)
destruct args as [ | base [ | ]]. 1,3: discriminate.
destruct args' as [ | base' [ | ]]. 1,3: discriminate.
simpl in OVERLAP.
@@ -141,7 +201,14 @@ Proof.
2: discriminate.
simpl in *.
eapply load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
- }
+- (* Ainstack / Ainstack *)
+ destruct args. 2: discriminate.
+ destruct args'. 2: discriminate.
+ cbn in OVERLAP.
+ destruct (can_swap_accesses_ofs (Ptrofs.unsigned i0) chunk' (Ptrofs.unsigned i) chunk) eqn:SWAP.
+ 2: discriminate.
+ cbn in *.
+ eapply stack_load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
Qed.
End SOUNDNESS.
diff --git a/riscV/CSE2deps.v b/riscV/CSE2deps.v
index b4b80e2f..c0deacf0 100644
--- a/riscV/CSE2deps.v
+++ b/riscV/CSE2deps.v
@@ -28,5 +28,8 @@ Definition may_overlap chunk addr args chunk' addr' args' :=
(base :: nil), (base' :: nil) =>
if peq base base'
then negb (can_swap_accesses_ofs (Ptrofs.unsigned ofs') chunk' (Ptrofs.unsigned ofs) chunk)
- else true | _, _, _, _ => true
+ else true
+ | (Ainstack ofs), (Ainstack ofs'), _, _ =>
+ negb (can_swap_accesses_ofs (Ptrofs.unsigned ofs') chunk' (Ptrofs.unsigned ofs) chunk)
+ | _, _, _, _ => true
end.
diff --git a/riscV/CSE2depsproof.v b/riscV/CSE2depsproof.v
index f283c8ac..cf9e62b1 100644
--- a/riscV/CSE2depsproof.v
+++ b/riscV/CSE2depsproof.v
@@ -123,7 +123,7 @@ Proof.
intros until rs.
intros ADDR ADDR' OVERLAP STORE.
destruct addr; destruct addr'; try discriminate.
- { (* Aindexed / Aindexed *)
+- (* Aindexed / Aindexed *)
destruct args as [ | base [ | ]]. 1,3: discriminate.
destruct args' as [ | base' [ | ]]. 1,3: discriminate.
simpl in OVERLAP.
@@ -133,7 +133,15 @@ Proof.
2: discriminate.
simpl in *.
eapply load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
- }
+
+- (* Ainstack / Ainstack *)
+ destruct args. 2: discriminate.
+ destruct args'. 2: discriminate.
+ cbn in OVERLAP.
+ destruct (can_swap_accesses_ofs (Ptrofs.unsigned i0) chunk' (Ptrofs.unsigned i) chunk) eqn:SWAP.
+ 2: discriminate.
+ cbn in *.
+ eapply load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
Qed.
End SOUNDNESS.
diff --git a/x86/CSE2deps.v b/x86/CSE2deps.v
index a4b47a5c..757966b8 100644
--- a/x86/CSE2deps.v
+++ b/x86/CSE2deps.v
@@ -32,5 +32,7 @@ Definition may_overlap chunk addr args chunk' addr' args' :=
if peq symb symb'
then negb (can_swap_accesses_ofs (Ptrofs.unsigned ofs') chunk' (Ptrofs.unsigned ofs) chunk)
else false
+ | (Ainstack ofs), (Ainstack ofs'), _, _ =>
+ negb (can_swap_accesses_ofs (Ptrofs.unsigned ofs') chunk' (Ptrofs.unsigned ofs) chunk)
| _, _, _, _ => true
end.
diff --git a/x86/CSE2depsproof.v b/x86/CSE2depsproof.v
index fd088962..e181b8f4 100644
--- a/x86/CSE2depsproof.v
+++ b/x86/CSE2depsproof.v
@@ -20,11 +20,79 @@ Require Import Registers Op RTL.
Require Import CSE2 CSE2deps.
Require Import Lia.
+Lemma ptrofs_modulus :
+ Ptrofs.modulus = if Archi.ptr64
+ then 18446744073709551616
+ else 4294967296.
+Proof.
+ reflexivity.
+Qed.
+
Section SOUNDNESS.
Variable F V : Type.
Variable genv: Genv.t F V.
Variable sp : val.
+Section STACK_WRITE.
+ Variable m m2 : mem.
+ Variable chunkw chunkr : memory_chunk.
+
+ Variable addrw addrr valw : val.
+ Hypothesis STORE : Mem.storev chunkw m addrw valw = Some m2.
+
+ Section INDEXED_AWAY.
+ Variable ofsw ofsr : ptrofs.
+ Hypothesis ADDRW : eval_addressing genv sp
+ (Ainstack ofsw) nil = Some addrw.
+ Hypothesis ADDRR : eval_addressing genv sp
+ (Ainstack ofsr) nil = Some addrr.
+
+ Lemma stack_load_store_away1 :
+ forall RANGEW : 0 <= Ptrofs.unsigned ofsw <= Ptrofs.modulus - largest_size_chunk,
+ forall RANGER : 0 <= Ptrofs.unsigned ofsr <= Ptrofs.modulus - largest_size_chunk,
+ forall SWAPPABLE : Ptrofs.unsigned ofsw + size_chunk chunkw <= Ptrofs.unsigned ofsr
+ \/ Ptrofs.unsigned ofsr + size_chunk chunkr <= Ptrofs.unsigned ofsw,
+ Mem.loadv chunkr m2 addrr = Mem.loadv chunkr m addrr.
+ Proof.
+ intros.
+
+ pose proof (max_size_chunk chunkr) as size_chunkr_bounded.
+ pose proof (max_size_chunk chunkw) as size_chunkw_bounded.
+ unfold largest_size_chunk in *.
+
+ inv ADDRR.
+ inv ADDRW.
+
+ destruct sp; try discriminate.
+ eapply Mem.load_store_other with (chunk := chunkw) (v := valw) (b := b).
+ exact STORE.
+ right.
+
+ all: try (destruct (Ptrofs.unsigned_add_either i ofsr) as [OFSR | OFSR];
+ rewrite OFSR).
+ all: try (destruct (Ptrofs.unsigned_add_either i ofsw) as [OFSW | OFSW];
+ rewrite OFSW).
+ all: try rewrite ptrofs_modulus in *.
+ all: destruct Archi.ptr64.
+
+ all: intuition lia.
+ Qed.
+
+ Theorem stack_load_store_away :
+ can_swap_accesses_ofs (Ptrofs.unsigned ofsr) chunkr (Ptrofs.unsigned ofsw) chunkw = true ->
+ Mem.loadv chunkr m2 addrr = Mem.loadv chunkr m addrr.
+ Proof.
+ intro SWAP.
+ unfold can_swap_accesses_ofs in SWAP.
+ repeat rewrite andb_true_iff in SWAP.
+ repeat rewrite orb_true_iff in SWAP.
+ repeat rewrite Z.leb_le in SWAP.
+ apply stack_load_store_away1.
+ all: tauto.
+ Qed.
+ End INDEXED_AWAY.
+End STACK_WRITE.
+
Section MEMORY_WRITE.
Variable m m2 : mem.
Variable chunkw chunkr : memory_chunk.
@@ -237,7 +305,7 @@ Proof.
intros until rs.
intros ADDR ADDR' OVERLAP STORE.
destruct addr; destruct addr'; try discriminate.
- { (* Aindexed / Aindexed *)
+- (* Aindexed / Aindexed *)
destruct args as [ | base [ | ]]. 1,3: discriminate.
destruct args' as [ | base' [ | ]]. 1,3: discriminate.
simpl in OVERLAP.
@@ -247,8 +315,7 @@ Proof.
2: discriminate.
simpl in *.
eapply load_store_away; eassumption.
- }
- { (* Aglobal / Aglobal *)
+- (* Aglobal / Aglobal *)
destruct args. 2: discriminate.
destruct args'. 2: discriminate.
simpl in *.
@@ -259,7 +326,14 @@ Proof.
eapply load_store_glob_away; eassumption.
}
eapply load_store_diff_globals; eassumption.
- }
+- (* Ainstack / Ainstack *)
+ destruct args. 2: discriminate.
+ destruct args'. 2: discriminate.
+ cbn in OVERLAP.
+ destruct (can_swap_accesses_ofs (Ptrofs.unsigned i0) chunk' (Ptrofs.unsigned i) chunk) eqn:SWAP.
+ 2: discriminate.
+ cbn in *.
+ eapply stack_load_store_away with (F:=F) (V:=V) (genv:=genv) (sp:=sp); eassumption.
Qed.
End SOUNDNESS.