From a67fb83021f3e5d7ade972ff329ab6c3c4b23620 Mon Sep 17 00:00:00 2001 From: James Pollard Date: Wed, 24 Jun 2020 17:15:22 +0100 Subject: Finish ILoad proof with some assumptions: * EXPR_OK: Yann to work on this. * READ_BOUNDS: To axiomise (or find a better solution). * 32-bit range of register values. --- src/common/IntegerExtra.v | 347 ++++++++++++++++++++---------------------- src/translation/HTLgen.v | 6 +- src/translation/HTLgenproof.v | 36 ++++- 3 files changed, 197 insertions(+), 192 deletions(-) (limited to 'src') diff --git a/src/common/IntegerExtra.v b/src/common/IntegerExtra.v index ad01015..2f9aae6 100644 --- a/src/common/IntegerExtra.v +++ b/src/common/IntegerExtra.v @@ -11,6 +11,96 @@ Local Open Scope Z_scope. Module PtrofsExtra. + Ltac ptrofs_mod_match m := + match goal with + | [ H : ?x = 0 |- context[?x] ] => rewrite H + | [ _ : _ |- context[_ - 0] ] => rewrite Z.sub_0_r + | [ _ : _ |- context[0 + _] ] => rewrite Z.add_0_l + | [ _ : _ |- context[_ + 0] ] => rewrite Z.add_0_r + | [ _ : _ |- context[0 * _] ] => rewrite Z.mul_0_l + | [ _ : _ |- context[_ * 0] ] => rewrite Z.mul_0_r + | [ _ : _ |- context[?m mod ?m] ] => + rewrite Z_mod_same_full with (a := m) + | [ _ : _ |- context[0 mod _] ] => + rewrite Z.mod_0_l + | [ _ : _ |- context[(_ mod ?m) mod ?m] ] => + rewrite Zmod_mod + | [ _ : _ |- context[(_ mod Ptrofs.modulus) mod m ] ] => + rewrite <- Zmod_div_mod; + try (simplify; lia || assumption) + + | [ _ : _ |- context[Ptrofs.modulus mod m] ] => + rewrite Zdivide_mod with (a := Ptrofs.modulus); + try (lia || assumption) + + | [ _ : _ |- context[Ptrofs.signed ?a mod Ptrofs.modulus] ] => + rewrite Z.mod_small with (a := Ptrofs.signed a) (b := Ptrofs.modulus) + + | [ _ : _ |- context[(?x - ?y) mod ?m] ] => + rewrite Zminus_mod with (a := x) (b := y) (n := m) + + | [ _ : _ |- context[((?x + ?y) mod ?m) + _] ] => + rewrite Zplus_mod with (a := x) (b := y) (n := m) + | [ _ : _ |- context[(?x + ?y) mod ?m] ] => + rewrite Zplus_mod with (a := x) (b := y) (n := m) + + | [ _ : _ |- context[(?x * ?y) mod ?m] ] => + rewrite Zmult_mod with (a := x) (b := y) (n := m) + end. + + Ltac ptrofs_mod_tac m := + repeat (ptrofs_mod_match m); lia. + + Lemma of_int_mod : + forall x m, + Int.signed x mod m = 0 -> + Ptrofs.signed (Ptrofs.of_int x) mod m = 0. + Proof. + intros. + pose proof (Integers.Ptrofs.agree32_of_int eq_refl x) as A. + pose proof Ptrofs.agree32_signed. + apply H0 in A; try reflexivity. + rewrite A. assumption. + Qed. + + Lemma mul_mod : + forall x y m, + 0 < m -> + (m | Ptrofs.modulus) -> + Ptrofs.signed x mod m = 0 -> + Ptrofs.signed y mod m = 0 -> + (Ptrofs.signed (Ptrofs.mul x y)) mod m = 0. + Proof. + intros. unfold Ptrofs.mul. + rewrite Ptrofs.signed_repr_eq. + + repeat match goal with + | [ _ : _ |- context[if ?x then _ else _] ] => destruct x + | [ _ : _ |- context[_ mod Ptrofs.modulus mod m] ] => + rewrite <- Zmod_div_mod; try lia; try assumption + | [ _ : _ |- context[Ptrofs.unsigned _] ] => rewrite Ptrofs.unsigned_signed + end; try (simplify; lia); ptrofs_mod_tac m. + Qed. + + Lemma add_mod : + forall x y m, + 0 < m -> + (m | Ptrofs.modulus) -> + Ptrofs.signed x mod m = 0 -> + Ptrofs.signed y mod m = 0 -> + (Ptrofs.signed (Ptrofs.add x y)) mod m = 0. + Proof. + intros. unfold Ptrofs.add. + rewrite Ptrofs.signed_repr_eq. + + repeat match goal with + | [ _ : _ |- context[if ?x then _ else _] ] => destruct x + | [ _ : _ |- context[_ mod Ptrofs.modulus mod m] ] => + rewrite <- Zmod_div_mod; try lia; try assumption + | [ _ : _ |- context[Ptrofs.unsigned _] ] => rewrite Ptrofs.unsigned_signed + end; try (simplify; lia); ptrofs_mod_tac m. + Qed. + Lemma mul_divs : forall x y, 0 <= Ptrofs.signed y -> @@ -31,24 +121,6 @@ Module PtrofsExtra. congruence. Qed. - Lemma Z_div_distr_add : - forall x y z, - x mod z = 0 -> - y mod z = 0 -> - z <> 0 -> - x / z + y / z = (x + y) / z. - Proof. - intros. - - assert ((x + y) mod z = 0). - { rewrite <- Z.add_mod_idemp_l; try assumption. - rewrite H. assumption. } - - rewrite <- Z.mul_cancel_r with (p := z); try assumption. - rewrite Z.mul_add_distr_r. - repeat rewrite ZLib.div_mul_undo; lia. - Qed. - Lemma mul_unsigned : forall x y, Ptrofs.mul x y = @@ -58,178 +130,85 @@ Module PtrofsExtra. apply Ptrofs.eqm_samerepr. apply Ptrofs.eqm_mult; exists 0; lia. Qed. - - Lemma mul_repr : - forall x y, - Ptrofs.min_signed <= y <= Ptrofs.max_signed -> - Ptrofs.min_signed <= x <= Ptrofs.max_signed -> - Ptrofs.mul (Ptrofs.repr y) (Ptrofs.repr x) = Ptrofs.repr (x * y). - Proof. - intros; unfold Ptrofs.mul. - destruct (Z_ge_lt_dec x 0); destruct (Z_ge_lt_dec y 0). - - - f_equal. - repeat rewrite Ptrofs.unsigned_repr_eq. - repeat rewrite Z.mod_small; simplify; lia. - - - assert (Ptrofs.lt (Ptrofs.repr y) Ptrofs.zero = true). - { - unfold Ptrofs.lt. - rewrite Ptrofs.signed_repr; auto. - rewrite Ptrofs.signed_zero. - destruct (zlt y 0); try lia; auto. - } - - rewrite Ptrofs.unsigned_signed with (n := Ptrofs.repr y). - rewrite H1. - rewrite Ptrofs.signed_repr; auto. - rewrite Ptrofs.unsigned_repr_eq. - rewrite Z.mod_small; simplify; try lia. - rewrite Z.mul_add_distr_r. - apply Ptrofs.eqm_samerepr. - exists x. simplify. lia. - - - assert (Ptrofs.lt (Ptrofs.repr x) Ptrofs.zero = true). - { - unfold Ptrofs.lt. - rewrite Ptrofs.signed_repr; auto. - rewrite Ptrofs.signed_zero. - destruct (zlt x 0); try lia; auto. - } - - rewrite Ptrofs.unsigned_signed with (n := Ptrofs.repr x). - rewrite H1. - rewrite Ptrofs.signed_repr; auto. - rewrite Ptrofs.unsigned_repr_eq. - rewrite Z.mod_small; simplify; try lia. - rewrite Z.mul_add_distr_l. - apply Ptrofs.eqm_samerepr. - exists y. simplify. lia. - - - assert (Ptrofs.lt (Ptrofs.repr x) Ptrofs.zero = true). - { - unfold Ptrofs.lt. - rewrite Ptrofs.signed_repr; auto. - rewrite Ptrofs.signed_zero. - destruct (zlt x 0); try lia; auto. - } - assert (Ptrofs.lt (Ptrofs.repr y) Ptrofs.zero = true). - { - unfold Ptrofs.lt. - rewrite Ptrofs.signed_repr; auto. - rewrite Ptrofs.signed_zero. - destruct (zlt y 0); try lia; auto. - } - rewrite Ptrofs.unsigned_signed with (n := Ptrofs.repr x). - rewrite Ptrofs.unsigned_signed with (n := Ptrofs.repr y). - rewrite H2. - rewrite H1. - repeat rewrite Ptrofs.signed_repr; auto. - replace ((y + Ptrofs.modulus) * (x + Ptrofs.modulus)) with - (x * y + (x + y + Ptrofs.modulus) * Ptrofs.modulus) by lia. - apply Ptrofs.eqm_samerepr. - exists (x + y + Ptrofs.modulus). lia. - Qed. End PtrofsExtra. Module IntExtra. - Lemma mul_unsigned : - forall x y, - Int.mul x y = - Int.repr (Int.unsigned x * Int.unsigned y). + + Ltac int_mod_match m := + match goal with + | [ H : ?x = 0 |- context[?x] ] => rewrite H + | [ _ : _ |- context[_ - 0] ] => rewrite Z.sub_0_r + | [ _ : _ |- context[0 + _] ] => rewrite Z.add_0_l + | [ _ : _ |- context[_ + 0] ] => rewrite Z.add_0_r + | [ _ : _ |- context[0 * _] ] => rewrite Z.mul_0_l + | [ _ : _ |- context[_ * 0] ] => rewrite Z.mul_0_r + | [ _ : _ |- context[?m mod ?m] ] => + rewrite Z_mod_same_full with (a := m) + | [ _ : _ |- context[0 mod _] ] => + rewrite Z.mod_0_l + | [ _ : _ |- context[(_ mod ?m) mod ?m] ] => + rewrite Zmod_mod + | [ _ : _ |- context[(_ mod Int.modulus) mod m ] ] => + rewrite <- Zmod_div_mod; + try (simplify; lia || assumption) + + | [ _ : _ |- context[Int.modulus mod m] ] => + rewrite Zdivide_mod with (a := Int.modulus); + try (lia || assumption) + + | [ _ : _ |- context[Int.signed ?a mod Int.modulus] ] => + rewrite Z.mod_small with (a := Int.signed a) (b := Int.modulus) + + | [ _ : _ |- context[(?x - ?y) mod ?m] ] => + rewrite Zminus_mod with (a := x) (b := y) (n := m) + + | [ _ : _ |- context[((?x + ?y) mod ?m) + _] ] => + rewrite Zplus_mod with (a := x) (b := y) (n := m) + | [ _ : _ |- context[(?x + ?y) mod ?m] ] => + rewrite Zplus_mod with (a := x) (b := y) (n := m) + + | [ _ : _ |- context[(?x * ?y) mod ?m] ] => + rewrite Zmult_mod with (a := x) (b := y) (n := m) + end. + + Ltac int_mod_tac m := + repeat (int_mod_match m); lia. + + Lemma mul_mod : + forall x y m, + 0 < m -> + (m | Int.modulus) -> + Int.signed x mod m = 0 -> + Int.signed y mod m = 0 -> + (Int.signed (Int.mul x y)) mod m = 0. Proof. - intros; unfold Int.mul. - apply Int.eqm_samerepr. - apply Int.eqm_mult; exists 0; lia. + intros. unfold Int.mul. + rewrite Int.signed_repr_eq. + + repeat match goal with + | [ _ : _ |- context[if ?x then _ else _] ] => destruct x + | [ _ : _ |- context[_ mod Int.modulus mod m] ] => + rewrite <- Zmod_div_mod; try lia; try assumption + | [ _ : _ |- context[Int.unsigned _] ] => rewrite Int.unsigned_signed + end; try (simplify; lia); int_mod_tac m. Qed. - Lemma mul_repr : - forall x y, - Int.min_signed <= y <= Int.max_signed -> - Int.min_signed <= x <= Int.max_signed -> - Int.mul (Int.repr y) (Int.repr x) = Int.repr (x * y). + Lemma add_mod : + forall x y m, + 0 < m -> + (m | Int.modulus) -> + Int.signed x mod m = 0 -> + Int.signed y mod m = 0 -> + (Int.signed (Int.add x y)) mod m = 0. Proof. - intros; unfold Int.mul. - destruct (Z_ge_lt_dec x 0); destruct (Z_ge_lt_dec y 0). - - - f_equal. - repeat rewrite Int.unsigned_repr_eq. - repeat rewrite Z.mod_small; simplify; lia. - - - assert (Int.lt (Int.repr y) Int.zero = true). - { - unfold Int.lt. - rewrite Int.signed_repr; auto. - rewrite Int.signed_zero. - destruct (zlt y 0); try lia; auto. - } - - rewrite Int.unsigned_signed with (n := Int.repr y). - rewrite H1. - rewrite Int.signed_repr; auto. - rewrite Int.unsigned_repr_eq. - rewrite Z.mod_small; simplify; try lia. - rewrite Z.mul_add_distr_r. - apply Int.eqm_samerepr. - exists x. simplify. lia. - - - assert (Int.lt (Int.repr x) Int.zero = true). - { - unfold Int.lt. - rewrite Int.signed_repr; auto. - rewrite Int.signed_zero. - destruct (zlt x 0); try lia; auto. - } - - rewrite Int.unsigned_signed with (n := Int.repr x). - rewrite H1. - rewrite Int.signed_repr; auto. - rewrite Int.unsigned_repr_eq. - rewrite Z.mod_small; simplify; try lia. - rewrite Z.mul_add_distr_l. - apply Int.eqm_samerepr. - exists y. simplify. lia. - - - assert (Int.lt (Int.repr x) Int.zero = true). - { - unfold Int.lt. - rewrite Int.signed_repr; auto. - rewrite Int.signed_zero. - destruct (zlt x 0); try lia; auto. - } - assert (Int.lt (Int.repr y) Int.zero = true). - { - unfold Int.lt. - rewrite Int.signed_repr; auto. - rewrite Int.signed_zero. - destruct (zlt y 0); try lia; auto. - } - rewrite Int.unsigned_signed with (n := Int.repr x). - rewrite Int.unsigned_signed with (n := Int.repr y). - rewrite H2. - rewrite H1. - repeat rewrite Int.signed_repr; auto. - replace ((y + Int.modulus) * (x + Int.modulus)) with - (x * y + (x + y + Int.modulus) * Int.modulus) by lia. - apply Int.eqm_samerepr. - exists (x + y + Int.modulus). lia. + intros. unfold Int.add. + rewrite Int.signed_repr_eq. + + repeat match goal with + | [ _ : _ |- context[if ?x then _ else _] ] => destruct x + | [ _ : _ |- context[_ mod Int.modulus mod m] ] => + rewrite <- Zmod_div_mod; try lia; try assumption + | [ _ : _ |- context[Int.unsigned _] ] => rewrite Int.unsigned_signed + end; try (simplify; lia); int_mod_tac m. Qed. End IntExtra. - -Lemma mul_of_int : - forall x y, - 0 <= x < Integers.Ptrofs.modulus -> - Integers.Ptrofs.mul (Integers.Ptrofs.repr x) (Integers.Ptrofs.of_int y) = - Integers.Ptrofs.of_int (Integers.Int.mul (Integers.Int.repr x) y). -Proof. - intros. - pose proof (Integers.Ptrofs.agree32_of_int eq_refl y) as A. - pose proof (Integers.Ptrofs.agree32_to_int eq_refl (Integers.Ptrofs.repr x)) as B. - exploit Integers.Ptrofs.agree32_mul; [> reflexivity | exact B | exact A | intro C]. - unfold Integers.Ptrofs.to_int in C. - unfold Integers.Ptrofs.of_int in C. - rewrite Integers.Ptrofs.unsigned_repr_eq in C. - rewrite Z.mod_small in C; auto. - symmetry. - apply Integers.Ptrofs.agree32_of_int_eq; auto. -Qed. diff --git a/src/translation/HTLgen.v b/src/translation/HTLgen.v index 92e40f5..357d487 100644 --- a/src/translation/HTLgen.v +++ b/src/translation/HTLgen.v @@ -260,6 +260,10 @@ Definition translate_eff_addressing (a: Op.addressing) (args: list reg) : mon ex if (check_address_parameter scale) && (check_address_parameter offset) then ret (Vbinop Vadd (boplitz Vmul r1 scale) (Vlit (ZToValue 32 offset))) else error (Errors.msg "Veriloggen: translate_eff_addressing address misaligned") + | Op.Aindexed2 offset, r1::r2::nil => + if (check_address_parameter offset) + then ret (Vbinop Vadd (Vvar r1) (boplitz Vadd r2 offset)) + else error (Errors.msg "Veriloggen: translate_eff_addressing address misaligned") | Op.Aindexed2scaled scale offset, r1::r2::nil => (* Typical for dynamic array addressing *) if (check_address_parameter scale) && (check_address_parameter offset) then ret (Vbinop Vadd (boplitz Vadd r1 offset) (boplitz Vmul r2 scale)) @@ -363,7 +367,7 @@ Definition translate_arr_access (mem : AST.memory_chunk) (addr : Op.addressing) (ZToValue 32 4))) else error (Errors.msg "Veriloggen: translate_arr_access address misaligned") | Mint32, Op.Ainstack a, nil => (* We need to be sure that the base address is aligned *) - let a := Integers.Ptrofs.unsigned a in + let a := Integers.Ptrofs.signed a in if (check_address_parameter a) then ret (Vvari stack (Vlit (ZToValue 32 (a / 4)))) else error (Errors.msg "Veriloggen: eff_addressing misaligned stack offset") diff --git a/src/translation/HTLgenproof.v b/src/translation/HTLgenproof.v index 8e97c58..a502453 100644 --- a/src/translation/HTLgenproof.v +++ b/src/translation/HTLgenproof.v @@ -525,8 +525,16 @@ Section CORRECTNESS. assert (0 <= Integers.Ptrofs.signed OFFSET) as READ_BOUND_LOW by admit. assert (Integers.Ptrofs.signed OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH by admit. - (** Modular Preservation proof *) - assert (Integers.Ptrofs.signed OFFSET mod 4 = 0) as MOD_PRESERVE by admit. + (** Modular preservation proof *) + assert (Integers.Ptrofs.signed OFFSET mod 4 = 0) as MOD_PRESERVE. + { rewrite HeqOFFSET. + apply PtrofsExtra.add_mod; simplify; try lia. + exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *) + rewrite Integers.Ptrofs.signed_repr; try assumption. + admit. (* FIXME: Register bounds. *) + apply PtrofsExtra.of_int_mod. + rewrite Integers.Int.signed_repr; simplify; try split; try assumption. + } (** Normalisation proof *) assert (Integers.Ptrofs.repr @@ -734,8 +742,22 @@ Section CORRECTNESS. assert (0 <= Integers.Ptrofs.signed OFFSET) as READ_BOUND_LOW by admit. assert (Integers.Ptrofs.signed OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH by admit. - (** Modular Preservation proof *) - assert (Integers.Ptrofs.signed OFFSET mod 4 = 0) as MOD_PRESERVE by admit. + (** Modular preservation proof *) + assert (Integers.Ptrofs.signed OFFSET mod 4 = 0) as MOD_PRESERVE. + { rewrite HeqOFFSET. + apply PtrofsExtra.add_mod; simplify; try lia. + exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *) + rewrite Integers.Ptrofs.signed_repr; try assumption. + admit. (* FIXME: Register bounds. *) + apply PtrofsExtra.of_int_mod. + apply IntExtra.add_mod; simplify; try lia. + exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *) + apply IntExtra.mul_mod; simplify; try lia. + exists 1073741824. reflexivity. (* FIXME: This is sadness inducing. *) + admit. (* FIXME: Register bounds. *) + rewrite Integers.Int.signed_repr; simplify; try split; try assumption. + rewrite Integers.Int.signed_repr; simplify; try split; try assumption. + } (** Normalisation proof *) assert (Integers.Ptrofs.repr @@ -918,8 +940,8 @@ Section CORRECTNESS. assert (0 <= Integers.Ptrofs.signed OFFSET) as READ_BOUND_LOW by admit. assert (Integers.Ptrofs.signed OFFSET < f.(RTL.fn_stacksize)) as READ_BOUND_HIGH by admit. - (** Modular Preservation proof *) - assert (Integers.Ptrofs.signed OFFSET mod 4 = 0) as MOD_PRESERVE by admit. + (** Modular preservation proof *) + rename H8 into MOD_PRESERVE. (** Normalisation proof *) assert (Integers.Ptrofs.repr @@ -1006,7 +1028,7 @@ Section CORRECTNESS. OFFSET (Integers.Ptrofs.repr 4))) = - valueToNat (ZToValue 32 (Integers.Ptrofs.unsigned OFFSET / 4))) + valueToNat (ZToValue 32 (Integers.Ptrofs.signed OFFSET / 4))) as EXPR_OK by admit. rewrite <- EXPR_OK. rewrite NORMALISE in I. -- cgit