From a82c9c0e4a0b8e37c9c3ea5ae99714982563606f Mon Sep 17 00:00:00 2001 From: xleroy Date: Sat, 14 Jan 2012 14:23:26 +0000 Subject: Merge of the nonstrict-ops branch: - Most RTL operators now evaluate to Some Vundef instead of None when undefined behavior occurs. - More aggressive instruction selection. - "Bertotization" of pattern-matchings now implemented by a proper preprocessor. - Cast optimization moved to cfrontend/Cminorgen; removed backend/CastOptim. git-svn-id: https://yquem.inria.fr/compcert/svn/compcert/trunk@1790 fca1b0fc-160b-0410-b1d3-a4f43f01ea2e --- arm/Asm.v | 36 +- arm/Asmgen.v | 11 - arm/Asmgenproof.v | 11 +- arm/Asmgenproof1.v | 259 ++++----- arm/ConstpropOp.v | 1407 ++++++++++++++++++++--------------------------- arm/ConstpropOpproof.v | 603 +++++++++----------- arm/Op.v | 1298 ++++++++++++++++++++----------------------- arm/SelectOp.v | 1430 +++++++++++++++++++++++++----------------------- arm/SelectOpproof.v | 1261 +++++++++++++++++------------------------- 9 files changed, 2830 insertions(+), 3486 deletions(-) (limited to 'arm') diff --git a/arm/Asm.v b/arm/Asm.v index a0d85c5a..21b8c4cf 100644 --- a/arm/Asm.v +++ b/arm/Asm.v @@ -355,15 +355,15 @@ Definition exec_store (chunk: memory_chunk) (addr: val) (r: preg) (** Operations over condition bits. *) -Definition compare_int (rs: regset) (v1 v2: val) := - rs#CReq <- (Val.cmp Ceq v1 v2) - #CRne <- (Val.cmp Cne v1 v2) - #CRhs <- (Val.cmpu Cge v1 v2) - #CRlo <- (Val.cmpu Clt v1 v2) +Definition compare_int (rs: regset) (v1 v2: val) (m: mem) := + rs#CReq <- (Val.cmpu (Mem.valid_pointer m) Ceq v1 v2) + #CRne <- (Val.cmpu (Mem.valid_pointer m) Cne v1 v2) + #CRhs <- (Val.cmpu (Mem.valid_pointer m) Cge v1 v2) + #CRlo <- (Val.cmpu (Mem.valid_pointer m) Clt v1 v2) #CRmi <- Vundef #CRpl <- Vundef - #CRhi <- (Val.cmpu Cgt v1 v2) - #CRls <- (Val.cmpu Cle v1 v2) + #CRhi <- (Val.cmpu (Mem.valid_pointer m) Cgt v1 v2) + #CRls <- (Val.cmpu (Mem.valid_pointer m) Cle v1 v2) #CRge <- (Val.cmp Cge v1 v2) #CRlt <- (Val.cmp Clt v1 v2) #CRgt <- (Val.cmp Cgt v1 v2) @@ -434,7 +434,7 @@ Definition exec_instr (c: code) (i: instruction) (rs: regset) (m: mem) : outcome | Pbic r1 r2 so => OK (nextinstr (rs#r1 <- (Val.and rs#r2 (Val.notint (eval_shift_op so rs))))) m | Pcmp r1 so => - OK (nextinstr (compare_int rs rs#r1 (eval_shift_op so rs))) m + OK (nextinstr (compare_int rs rs#r1 (eval_shift_op so rs) m)) m | Peor r1 r2 so => OK (nextinstr (rs#r1 <- (Val.xor rs#r2 (eval_shift_op so rs)))) m | Pldr r1 r2 sa => @@ -454,7 +454,7 @@ Definition exec_instr (c: code) (i: instruction) (rs: regset) (m: mem) : outcome | Vint n => if Int.eq n Int.zero then OK (nextinstr rs) m else OK (nextinstr (rs#r1 <- (eval_shift_op so rs))) m - | _ => Error + | _ => OK (nextinstr (rs#r1 <- Vundef)) m end | Pmul r1 r2 r3 => OK (nextinstr (rs#r1 <- (Val.mul rs#r2 rs#r3))) m @@ -471,11 +471,17 @@ Definition exec_instr (c: code) (i: instruction) (rs: regset) (m: mem) : outcome | Pstrh r1 r2 sa => exec_store Mint16unsigned (Val.add rs#r2 (eval_shift_addr sa rs)) r1 rs m | Psdiv rd r1 r2 => - OK (nextinstr (rs#rd <- (Val.divs rs#r1 rs#r2))) m + match Val.divs rs#r1 rs#r2 with + | Some v => OK (nextinstr (rs#rd <- v)) m + | None => Error + end | Psub r1 r2 so => OK (nextinstr (rs#r1 <- (Val.sub rs#r2 (eval_shift_op so rs)))) m | Pudiv rd r1 r2 => - OK (nextinstr (rs#rd <- (Val.divu rs#r1 rs#r2))) m + match Val.divu rs#r1 rs#r2 with + | Some v => OK (nextinstr (rs#rd <- v)) m + | None => Error + end (* Floating-point coprocessor instructions *) | Pfcpyd r1 r2 => OK (nextinstr (rs#r1 <- (rs#r2))) m @@ -496,13 +502,13 @@ Definition exec_instr (c: code) (i: instruction) (rs: regset) (m: mem) : outcome | Pfcmpd r1 r2 => OK (nextinstr (compare_float rs rs#r1 rs#r2)) m | Pfsitod r1 r2 => - OK (nextinstr (rs#r1 <- (Val.floatofint rs#r2))) m + OK (nextinstr (rs#r1 <- (Val.maketotal (Val.floatofint rs#r2)))) m | Pfuitod r1 r2 => - OK (nextinstr (rs#r1 <- (Val.floatofintu rs#r2))) m + OK (nextinstr (rs#r1 <- (Val.maketotal (Val.floatofintu rs#r2)))) m | Pftosizd r1 r2 => - OK (nextinstr (rs#r1 <- (Val.intoffloat rs#r2))) m + OK (nextinstr (rs#r1 <- (Val.maketotal (Val.intoffloat rs#r2)))) m | Pftouizd r1 r2 => - OK (nextinstr (rs#r1 <- (Val.intuoffloat rs#r2))) m + OK (nextinstr (rs#r1 <- (Val.maketotal (Val.intuoffloat rs#r2)))) m | Pfcvtsd r1 r2 => OK (nextinstr (rs#r1 <- (Val.singleoffloat rs#r2))) m | Pfldd r1 r2 n => diff --git a/arm/Asmgen.v b/arm/Asmgen.v index 4d36f91d..c727db9b 100644 --- a/arm/Asmgen.v +++ b/arm/Asmgen.v @@ -230,17 +230,6 @@ Definition transl_op Ploadsymbol (ireg_of r) s ofs :: k | Oaddrstack n, nil => addimm (ireg_of r) IR13 n k - | Ocast8signed, a1 :: nil => - Pmov (ireg_of r) (SOlslimm (ireg_of a1) (Int.repr 24)) :: - Pmov (ireg_of r) (SOasrimm (ireg_of r) (Int.repr 24)) :: k - | Ocast8unsigned, a1 :: nil => - Pand (ireg_of r) (ireg_of a1) (SOimm (Int.repr 255)) :: k - | Ocast16signed, a1 :: nil => - Pmov (ireg_of r) (SOlslimm (ireg_of a1) (Int.repr 16)) :: - Pmov (ireg_of r) (SOasrimm (ireg_of r) (Int.repr 16)) :: k - | Ocast16unsigned, a1 :: nil => - Pmov (ireg_of r) (SOlslimm (ireg_of a1) (Int.repr 16)) :: - Pmov (ireg_of r) (SOlsrimm (ireg_of r) (Int.repr 16)) :: k | Oadd, a1 :: a2 :: nil => Padd (ireg_of r) (ireg_of a1) (SOreg (ireg_of a2)) :: k | Oaddshift s, a1 :: a2 :: nil => diff --git a/arm/Asmgenproof.v b/arm/Asmgenproof.v index 48f265b8..a888aae6 100644 --- a/arm/Asmgenproof.v +++ b/arm/Asmgenproof.v @@ -791,10 +791,9 @@ Proof. exists m'; split; auto. exists rs'; split. simpl. eexact P. assert (agree (Regmap.set res v ms) sp rs'). - apply agree_set_mreg with rs; auto. congruence. - auto with ppcgen. + apply agree_set_mreg with rs; auto. eapply Val.lessdef_trans; eauto. assert (agree (Regmap.set res v (undef_temps ms)) sp rs'). - apply agree_set_undef_mreg with rs; auto. congruence. + apply agree_set_undef_mreg with rs; auto. eapply Val.lessdef_trans; eauto. auto with ppcgen. destruct op; assumption. Qed. @@ -1086,7 +1085,8 @@ Proof. exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros A. exploit transl_cond_correct. eauto. eauto. - intros [rs2 [EX [RES OTH]]]. + instantiate (1 := rs). instantiate (1 := m'). unfold PregEq.t. rewrite A. + intros [rs2 [EX [RES OTH]]]. inv AT. simpl in H5. generalize (functions_transl _ _ H4); intro FN. generalize (functions_transl_no_overflow _ _ H4); intro NOOV. @@ -1120,7 +1120,8 @@ Proof. intro WTI. inv WTI. exploit eval_condition_lessdef. eapply preg_vals; eauto. eauto. eauto. intros A. - exploit transl_cond_correct. eauto. eauto. + exploit transl_cond_correct. eauto. + instantiate (1 := rs). instantiate (1 := m'). unfold PregEq.t. rewrite A. intros [rs2 [EX [RES OTH]]]. left; eapply exec_straight_steps; eauto with coqlib. exists m'; split; auto. diff --git a/arm/Asmgenproof1.v b/arm/Asmgenproof1.v index 8f6b3376..629a6151 100644 --- a/arm/Asmgenproof1.v +++ b/arm/Asmgenproof1.v @@ -12,6 +12,7 @@ (** Correctness proof for ARM code generation: auxiliary results. *) +Require Import Axioms. Require Import Coqlib. Require Import Maps. Require Import AST. @@ -907,33 +908,29 @@ Qed. Lemma transl_shift_correct: forall s (r: ireg) (rs: regset), - eval_shift_op (transl_shift s r) rs = eval_shift_total s (rs#r). + eval_shift_op (transl_shift s r) rs = eval_shift s (rs#r). Proof. - intros. destruct s; simpl; - unfold eval_shift_total, eval_shift, Val.shl, Val.shr, Val.shru, Val.ror; - rewrite (s_amount_ltu s); auto. + intros. destruct s; simpl; auto. Qed. Lemma transl_shift_addr_correct: forall s (r: ireg) (rs: regset), - eval_shift_addr (transl_shift_addr s r) rs = eval_shift_total s (rs#r). + eval_shift_addr (transl_shift_addr s r) rs = eval_shift s (rs#r). Proof. - intros. destruct s; simpl; - unfold eval_shift_total, eval_shift, Val.shl, Val.shr, Val.shru, Val.ror; - rewrite (s_amount_ltu s); auto. + intros. destruct s; simpl; auto. Qed. (** Translation of conditions *) Lemma compare_int_spec: - forall rs v1 v2, - let rs1 := nextinstr (compare_int rs v1 v2) in - rs1#CReq = (Val.cmp Ceq v1 v2) - /\ rs1#CRne = (Val.cmp Cne v1 v2) - /\ rs1#CRhs = (Val.cmpu Cge v1 v2) - /\ rs1#CRlo = (Val.cmpu Clt v1 v2) - /\ rs1#CRhi = (Val.cmpu Cgt v1 v2) - /\ rs1#CRls = (Val.cmpu Cle v1 v2) + forall rs v1 v2 m, + let rs1 := nextinstr (compare_int rs v1 v2 m) in + rs1#CReq = (Val.cmpu (Mem.valid_pointer m) Ceq v1 v2) + /\ rs1#CRne = (Val.cmpu (Mem.valid_pointer m) Cne v1 v2) + /\ rs1#CRhs = (Val.cmpu (Mem.valid_pointer m) Cge v1 v2) + /\ rs1#CRlo = (Val.cmpu (Mem.valid_pointer m) Clt v1 v2) + /\ rs1#CRhi = (Val.cmpu (Mem.valid_pointer m) Cgt v1 v2) + /\ rs1#CRls = (Val.cmpu (Mem.valid_pointer m) Cle v1 v2) /\ rs1#CRge = (Val.cmp Cge v1 v2) /\ rs1#CRlt = (Val.cmp Clt v1 v2) /\ rs1#CRgt = (Val.cmp Cgt v1 v2) @@ -984,92 +981,106 @@ Ltac TypeInv2 := Ltac TypeInv := TypeInv1; simpl in *; unfold preg_of in *; TypeInv2. Lemma transl_cond_correct: - forall cond args k rs m b, + forall cond args k rs m, map mreg_type args = type_of_condition cond -> - eval_condition cond (map rs (map preg_of args)) m = Some b -> exists rs', exec_straight (transl_cond cond args k) rs m k rs' m - /\ rs'#(CR (crbit_for_cond cond)) = Val.of_bool b + /\ match eval_condition cond (map rs (map preg_of args)) m with + | Some b => rs'#(CR (crbit_for_cond cond)) = Val.of_bool b + | None => True + end /\ forall r, important_preg r = true -> rs'#r = rs r. Proof. - intros until b; intros TY EV. - rewrite <- (eval_condition_weaken _ _ _ EV). clear EV. - destruct cond; simpl in TY; TypeInv. + intros until m; intros TY. + assert (MATCH: forall v ob, + v = Val.of_optbool ob -> + match ob with Some b => v = Val.of_bool b | None => True end). + intros. subst v. destruct ob; auto. + assert (MATCH2: forall cmp v1 v2 v, + v = Val.cmpu (Mem.valid_pointer m) cmp v1 v2 -> + cmp = Ceq \/ cmp = Cne -> + match Val.cmp_bool cmp v1 v2 with + | Some b => v = Val.of_bool b + | None => True + end). + intros. destruct v1; simpl; auto; destruct v2; simpl; auto. + unfold Val.cmpu, Val.cmpu_bool in H. subst v. destruct H0; subst cmp; auto. + + destruct cond; simpl in TY; TypeInv; simpl. (* Ccomp *) - generalize (compare_int_spec rs (rs (ireg_of m0)) (rs (ireg_of m1))). + generalize (compare_int_spec rs (rs (ireg_of m0)) (rs (ireg_of m1)) m). intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]]. econstructor. split. apply exec_straight_one. simpl. eauto. auto. - split. case c; assumption. + split. destruct c; (apply MATCH; assumption) || (apply MATCH2; auto). auto. (* Ccompu *) - generalize (compare_int_spec rs (rs (ireg_of m0)) (rs (ireg_of m1))). + generalize (compare_int_spec rs (rs (ireg_of m0)) (rs (ireg_of m1)) m). intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]]. econstructor. split. apply exec_straight_one. simpl. eauto. auto. - split. case c; assumption. + split. destruct c; apply MATCH; assumption. auto. (* Ccompshift *) - generalize (compare_int_spec rs (rs (ireg_of m0)) (eval_shift_total s (rs (ireg_of m1)))). + generalize (compare_int_spec rs (rs (ireg_of m0)) (eval_shift s (rs (ireg_of m1))) m). intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]]. econstructor. split. apply exec_straight_one. simpl. eauto. auto. - split. rewrite transl_shift_correct. case c; assumption. + split. rewrite transl_shift_correct. destruct c; (apply MATCH; assumption) || (apply MATCH2; auto). rewrite transl_shift_correct. auto. (* Ccompushift *) - generalize (compare_int_spec rs (rs (ireg_of m0)) (eval_shift_total s (rs (ireg_of m1)))). + generalize (compare_int_spec rs (rs (ireg_of m0)) (eval_shift s (rs (ireg_of m1))) m). intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]]. econstructor. split. apply exec_straight_one. simpl. eauto. auto. - split. rewrite transl_shift_correct. case c; assumption. + split. rewrite transl_shift_correct. destruct c; apply MATCH; assumption. rewrite transl_shift_correct. auto. (* Ccompimm *) destruct (is_immed_arith i). - generalize (compare_int_spec rs (rs (ireg_of m0)) (Vint i)). + generalize (compare_int_spec rs (rs (ireg_of m0)) (Vint i) m). intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]]. econstructor. split. apply exec_straight_one. simpl. eauto. auto. - split. case c; assumption. + split. destruct c; (apply MATCH; assumption) || (apply MATCH2; auto). auto. exploit (loadimm_correct IR14). intros [rs' [P [Q R]]]. - generalize (compare_int_spec rs' (rs (ireg_of m0)) (Vint i)). + generalize (compare_int_spec rs' (rs (ireg_of m0)) (Vint i) m). intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]]. econstructor. split. eapply exec_straight_trans. eexact P. apply exec_straight_one. simpl. rewrite Q. rewrite R; eauto with ppcgen. auto. - split. case c; assumption. + split. destruct c; (apply MATCH; assumption) || (apply MATCH2; auto). intros. rewrite K; auto with ppcgen. (* Ccompuimm *) destruct (is_immed_arith i). - generalize (compare_int_spec rs (rs (ireg_of m0)) (Vint i)). + generalize (compare_int_spec rs (rs (ireg_of m0)) (Vint i) m). intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]]. econstructor. split. apply exec_straight_one. simpl. eauto. auto. - split. case c; assumption. + split. destruct c; apply MATCH; assumption. auto. exploit (loadimm_correct IR14). intros [rs' [P [Q R]]]. - generalize (compare_int_spec rs' (rs (ireg_of m0)) (Vint i)). + generalize (compare_int_spec rs' (rs (ireg_of m0)) (Vint i) m). intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]]. econstructor. split. eapply exec_straight_trans. eexact P. apply exec_straight_one. simpl. rewrite Q. rewrite R; eauto with ppcgen. auto. - split. case c; assumption. + split. destruct c; apply MATCH; assumption. intros. rewrite K; auto with ppcgen. (* Ccompf *) generalize (compare_float_spec rs (rs (freg_of m0)) (rs (freg_of m1))). intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]]. econstructor. split. apply exec_straight_one. simpl. eauto. auto. - split. case c; assumption. + split. case c; apply MATCH; assumption. auto. (* Cnotcompf *) generalize (compare_float_spec rs (rs (freg_of m0)) (rs (freg_of m1))). intros [A [B [C [D [E [F [G [H [I [J K]]]]]]]]]]. econstructor. split. apply exec_straight_one. simpl. eauto. auto. - split. case c; try assumption. - rewrite Val.negate_cmpf_ne. auto. - rewrite Val.negate_cmpf_eq. auto. + split. rewrite <- Val.negate_cmpf_ne in B. rewrite <- Val.negate_cmpf_eq in A. + destruct c; apply MATCH; simpl; rewrite Val.notbool_negb_3; auto. auto. Qed. @@ -1089,27 +1100,26 @@ Ltac TranslOpSimpl := [ apply exec_straight_one; [simpl; eauto | reflexivity ] | split; [try rewrite transl_shift_correct; repeat Simpl | intros; repeat Simpl] ]. -Lemma transl_op_correct: +Lemma transl_op_correct_same: forall op args res k (rs: regset) m v, wt_instr (Mop op args res) -> eval_operation ge rs#IR13 op (map rs (map preg_of args)) m = Some v -> + match op with Ocmp _ => False | _ => True end -> exists rs', exec_straight (transl_op op args res k) rs m k rs' m /\ rs'#(preg_of res) = v /\ forall r, important_preg r = true -> r <> preg_of res -> rs'#r = rs#r. Proof. - intros. rewrite <- (eval_operation_weaken _ _ _ _ _ H0). inv H. + intros. inv H. (* Omove *) - simpl. + simpl in *. inv H0. exists (nextinstr (rs#(preg_of res) <- (rs#(preg_of r1)))). - split. unfold preg_of; rewrite <- H2. + split. unfold preg_of; rewrite <- H3. destruct (mreg_type r1); apply exec_straight_one; auto. split. Simpl. Simpl. intros. Simpl. Simpl. (* Other instructions *) - destruct op; simpl in H5; inv H5; TypeInv; try (TranslOpSimpl; fail). - (* Omove again *) - congruence. + destruct op; simpl in H6; inv H6; TypeInv; simpl in H0; inv H0; try (TranslOpSimpl; fail). (* Ointconst *) generalize (loadimm_correct (ireg_of res) i k rs m). intros [rs' [A [B C]]]. exists rs'. split. auto. split. rewrite B; auto. intros. auto with ppcgen. @@ -1117,35 +1127,6 @@ Proof. generalize (addimm_correct (ireg_of res) IR13 i k rs m). intros [rs' [EX [RES OTH]]]. exists rs'. split. auto. split. auto. auto with ppcgen. - (* Ocast8signed *) - econstructor; split. - eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. - split. Simpl. Simpl. Simpl. Simpl. - destruct (rs (ireg_of m0)); simpl; auto. rewrite Int.sign_ext_shr_shl. - reflexivity. - compute; auto. - intros. repeat Simpl. - (* Ocast8unsigned *) - econstructor; split. - eapply exec_straight_one. simpl; eauto. auto. - split. Simpl. Simpl. - destruct (rs (ireg_of m0)); simpl; auto. rewrite Int.zero_ext_and. auto. - compute; auto. - intros. repeat Simpl. - (* Ocast16signed *) - econstructor; split. - eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. - split. Simpl. Simpl. Simpl. Simpl. - destruct (rs (ireg_of m0)); simpl; auto. rewrite Int.sign_ext_shr_shl. auto. - compute; auto. - intros. repeat Simpl. - (* Ocast16unsigned *) - econstructor; split. - eapply exec_straight_two. simpl; eauto. simpl; eauto. auto. auto. - split. Simpl. Simpl. Simpl. Simpl. - destruct (rs (ireg_of m0)); simpl; auto. rewrite Int.zero_ext_shru_shl; auto. - compute; auto. - intros. repeat Simpl. (* Oaddimm *) generalize (addimm_correct (ireg_of res) (ireg_of m0) i k rs m). intros [rs' [A [B C]]]. @@ -1154,8 +1135,7 @@ Proof. generalize (rsubimm_correct (ireg_of res) (ireg_of m0) i k rs m). intros [rs' [A [B C]]]. exists rs'. - split. eauto. split. rewrite B. - destruct (rs (ireg_of m0)); auto. + split. eauto. split. rewrite B. auto. auto with ppcgen. (* Omul *) destruct (ireg_eq (ireg_of res) (ireg_of m0) || ireg_eq (ireg_of res) (ireg_of m1)). @@ -1164,6 +1144,12 @@ Proof. split. repeat Simpl. intros. repeat Simpl. TranslOpSimpl. + (* divs *) + econstructor. split. apply exec_straight_one. simpl. rewrite H2. reflexivity. auto. + split. repeat Simpl. intros. repeat Simpl. + (* divu *) + econstructor. split. apply exec_straight_one. simpl. rewrite H2. reflexivity. auto. + split. repeat Simpl. intros. repeat Simpl. (* Oandimm *) generalize (andimm_correct (ireg_of res) (ireg_of m0) i k rs m (ireg_of_not_IR14 m0)). @@ -1178,19 +1164,12 @@ Proof. intros [rs' [A [B C]]]. exists rs'; auto with ppcgen. (* Oshrximm *) - assert (exists n, rs (ireg_of m0) = Vint n /\ Int.ltu i (Int.repr 31) = true). - destruct (rs (ireg_of m0)); try discriminate. - exists i0; split; auto. destruct (Int.ltu i (Int.repr 31)); discriminate || auto. - destruct H as [n [ARG1 LTU]]. clear H0. - assert (LTU': Int.ltu i Int.iwordsize = true). - exploit Int.ltu_inv. eexact LTU. intro. - unfold Int.ltu. apply zlt_true. - assert (Int.unsigned (Int.repr 31) < Int.unsigned Int.iwordsize). compute; auto. - omega. - set (islt := Int.lt n Int.zero). - set (rs1 := nextinstr (compare_int rs (Vint n) (Vint Int.zero))). + exploit Val.shrx_shr; eauto. intros [n [i' [ARG1 [ARG2 RES]]]]. + injection ARG2; intro ARG2'; subst i'; clear ARG2. + set (islt := Int.lt n Int.zero) in *. + set (rs1 := nextinstr (compare_int rs (Vint n) (Vint Int.zero) m)). assert (OTH1: forall r', important_preg r' = true -> rs1#r' = rs#r'). - generalize (compare_int_spec rs (Vint n) (Vint Int.zero)). + generalize (compare_int_spec rs (Vint n) (Vint Int.zero) m). fold rs1. intros [A B]. intuition. exploit (addimm_correct IR14 (ireg_of m0) (Int.sub (Int.shl Int.one i) Int.one)). intros [rs2 [EXEC2 [RES2 OTH2]]]. @@ -1202,46 +1181,78 @@ Proof. eapply exec_straight_trans. eexact EXEC2. apply exec_straight_two with rs3 m. simpl. rewrite OTH2. change (rs1 CRge) with (Val.cmp Cge (Vint n) (Vint Int.zero)). - unfold Val.cmp. change (Int.cmp Cge n Int.zero) with (negb islt). + unfold Val.cmp, Val.cmp_bool. change (Int.cmp Cge n Int.zero) with (negb islt). rewrite OTH2. rewrite OTH1. rewrite ARG1. unfold rs3. case islt; reflexivity. destruct m0; reflexivity. auto with ppcgen. auto with ppcgen. discriminate. discriminate. simpl. auto. auto. unfold rs3. case islt; auto. auto. - split. unfold rs4. repeat Simpl. rewrite ARG1. simpl. rewrite LTU'. rewrite Int.shrx_shr. - fold islt. unfold rs3. rewrite nextinstr_inv; auto with ppcgen. - destruct islt. - rewrite RES2. - change (rs1 (IR (ireg_of m0))) with (rs (IR (ireg_of m0))). - rewrite ARG1. - simpl. rewrite LTU'. auto. - rewrite Pregmap.gss. simpl. rewrite LTU'. auto. - assumption. + split. unfold rs4. repeat Simpl. unfold rs3. Simpl. destruct islt. + rewrite RES2. change (rs1 (IR (ireg_of m0))) with (rs (IR (ireg_of m0))). auto. + Simpl. rewrite <- ARG1; auto. intros. unfold rs4; repeat Simpl. unfold rs3; repeat Simpl. transitivity (rs2 r). destruct islt; auto. Simpl. rewrite OTH2; auto with ppcgen. + (* intoffloat *) + econstructor; split. apply exec_straight_one; simpl. rewrite H2; simpl. eauto. auto. + split; intros; repeat Simpl. + (* intuoffloat *) + econstructor; split. apply exec_straight_one; simpl. rewrite H2; simpl. eauto. auto. + split; intros; repeat Simpl. + (* floatofint *) + econstructor; split. apply exec_straight_one; simpl. rewrite H2; simpl. eauto. auto. + split; intros; repeat Simpl. + (* floatofintu *) + econstructor; split. apply exec_straight_one; simpl. rewrite H2; simpl. eauto. auto. + split; intros; repeat Simpl. + (* Ocmp *) + contradiction. +Qed. + +Lemma transl_op_correct: + forall op args res k (rs: regset) m v, + wt_instr (Mop op args res) -> + eval_operation ge rs#IR13 op (map rs (map preg_of args)) m = Some v -> + exists rs', + exec_straight (transl_op op args res k) rs m k rs' m + /\ Val.lessdef v rs'#(preg_of res) + /\ forall r, important_preg r = true -> r <> preg_of res -> rs'#r = rs#r. +Proof. + intros. + assert (EITHER: match op with Ocmp _ => False | _ => True end \/ exists cmp, op = Ocmp cmp). + destruct op; auto. right; exists c; auto. + destruct EITHER as [A | [c A]]. + exploit transl_op_correct_same; eauto. intros [rs' [P [Q R]]]. + subst v. exists rs'; eauto. (* Ocmp *) - fold preg_of in *. - assert (exists b, eval_condition c rs ## (preg_of ## args) m = Some b /\ v = Val.of_bool b). - fold preg_of in H0. destruct (eval_condition c rs ## (preg_of ## args) m). - exists b; split; auto. destruct b; inv H0; auto. congruence. - clear H0. destruct H as [b [EVC VBO]]. rewrite (eval_condition_weaken _ _ _ EVC). + subst op. inv H. simpl in H5. inv H5. simpl in H0. inv H0. destruct (transl_cond_correct c args (Pmov (ireg_of res) (SOimm Int.zero) :: Pmovc (crbit_for_cond c) (ireg_of res) (SOimm Int.one) :: k) - rs m b H1 EVC) + rs m H1) as [rs1 [A [B C]]]. set (rs2 := nextinstr (rs1#(ireg_of res) <- (Vint Int.zero))). - set (rs3 := nextinstr (if b then (rs2#(ireg_of res) <- Vtrue) else rs2)). - exists rs3. - split. eapply exec_straight_trans. eauto. + set (v := match rs2#(crbit_for_cond c) with + | Vint n => if Int.eq n Int.zero then Vint Int.zero else Vint Int.one + | _ => Vundef + end). + set (rs3 := nextinstr (rs2#(ireg_of res) <- v)). + exists rs3; split. + eapply exec_straight_trans. eauto. apply exec_straight_two with rs2 m; auto. - simpl. replace (rs2 (crbit_for_cond c)) with (Val.of_bool b). - unfold rs3. destruct b; auto. - unfold rs3. destruct b; auto. - split. unfold rs3. Simpl. destruct b. Simpl. unfold rs2. repeat Simpl. - intros. unfold rs3. Simpl. transitivity (rs2 r). - destruct b; auto; Simpl. unfold rs2. repeat Simpl. + simpl. unfold rs3, v. + destruct (rs2 (crbit_for_cond c)) as []_eqn; auto. + destruct (Int.eq i Int.zero); auto. + decEq. decEq. apply extensionality; intros. unfold Pregmap.set. + destruct (PregEq.eq x (ireg_of res)); auto. subst. + unfold rs2. Simpl. Simpl. + replace (preg_of res) with (IR (ireg_of res)). + split. unfold rs3. Simpl. Simpl. + destruct (eval_condition c rs ## (preg_of ## args) m); simpl; auto. + unfold v. unfold rs2. Simpl. Simpl. rewrite B. + destruct b; simpl; auto. + intros. unfold rs3. repeat Simpl. unfold rs2. repeat Simpl. + unfold preg_of; rewrite H2; auto. Qed. Remark val_add_add_zero: @@ -1256,7 +1267,7 @@ Lemma transl_load_store_correct: (is_immed: int -> bool) addr args k ms sp rs m ms' m', (forall (r1: ireg) (rs1: regset) n k, - eval_addressing_total sp addr (map rs (map preg_of args)) = Val.add rs1#r1 (Vint n) -> + eval_addressing ge sp addr (map rs (map preg_of args)) = Some(Val.add rs1#r1 (Vint n)) -> (forall (r: preg), r <> PC -> r <> IR14 -> rs1 r = rs r) -> exists rs', exec_straight (mk_instr_imm r1 n :: k) rs1 m k rs' m' /\ @@ -1265,7 +1276,7 @@ Lemma transl_load_store_correct: | None => True | Some mk => (forall (r1: ireg) (sa: shift_addr) (rs1: regset) k, - eval_addressing_total sp addr (map rs (map preg_of args)) = Val.add rs1#r1 (eval_shift_addr sa rs1) -> + eval_addressing ge sp addr (map rs (map preg_of args)) = Some(Val.add rs1#r1 (eval_shift_addr sa rs1)) -> (forall (r: preg), r <> PC -> r <> IR14 -> rs1 r = rs r) -> exists rs', exec_straight (mk r1 sa :: k) rs1 m k rs' m' /\ @@ -1299,7 +1310,7 @@ Proof. set (rs' := nextinstr (rs#IR14 <- (Val.add (rs (ireg_of m0)) (rs (ireg_of m1))))). exploit (H IR14 rs' Int.zero); eauto. unfold rs'. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss. - apply val_add_add_zero. + decEq. apply val_add_add_zero. unfold rs'. intros. repeat Simpl. intros [rs'' [A B]]. exists rs''; split. @@ -1310,10 +1321,10 @@ Proof. (* binary form available *) apply H0; auto. rewrite transl_shift_addr_correct. auto. (* binary form not available *) - set (rs' := nextinstr (rs#IR14 <- (Val.add (rs (ireg_of m0)) (eval_shift_total s (rs (ireg_of m1)))))). + set (rs' := nextinstr (rs#IR14 <- (Val.add (rs (ireg_of m0)) (eval_shift s (rs (ireg_of m1)))))). exploit (H IR14 rs' Int.zero); eauto. unfold rs'. rewrite nextinstr_inv; auto with ppcgen. rewrite Pregmap.gss. - apply val_add_add_zero. + decEq. apply val_add_add_zero. unfold rs'; intros; repeat Simpl. intros [rs'' [A B]]. exists rs''; split. @@ -1356,7 +1367,6 @@ Proof. exploit eval_addressing_lessdef. eapply preg_vals; eauto. eauto. intros [a' [A B]]. exploit Mem.loadv_extends; eauto. intros [v' [C D]]. - exploit eval_addressing_weaken. eexact A. intros E. apply transl_load_store_correct with ms; auto. intros. assert (Val.add (rs1 r1) (Vint n) = a') by congruence. @@ -1398,7 +1408,6 @@ Proof. exploit eval_addressing_lessdef. eapply preg_vals; eauto. eauto. intros [a' [A B]]. exploit Mem.loadv_extends; eauto. intros [v' [C D]]. - exploit eval_addressing_weaken. eexact A. intros E. apply transl_load_store_correct with ms; auto. intros. assert (Val.add (rs1 r1) (Vint n) = a') by congruence. @@ -1435,7 +1444,6 @@ Proof. intros [a' [A B]]. exploit preg_val; eauto. instantiate (1 := rd). intros C. exploit Mem.storev_extends; eauto. unfold preg_of; rewrite H2. intros [m2' [D E]]. - exploit eval_addressing_weaken. eexact A. intros F. exists m2'; split; auto. apply transl_load_store_correct with ms; auto. intros. @@ -1479,7 +1487,6 @@ Proof. intros [a' [A B]]. exploit preg_val; eauto. instantiate (1 := rd). intros C. exploit Mem.storev_extends; eauto. unfold preg_of; rewrite H2. intros [m2' [D E]]. - exploit eval_addressing_weaken. eexact A. intros F. exists m2'; split; auto. apply transl_load_store_correct with ms; auto. intros. diff --git a/arm/ConstpropOp.v b/arm/ConstpropOp.v index 86b6d660..9e51e251 100644 --- a/arm/ConstpropOp.v +++ b/arm/ConstpropOp.v @@ -32,9 +32,11 @@ Inductive approx : Type := no compile-time information is available. *) | I: int -> approx (** A known integer value. *) | F: float -> approx (** A known floating-point value. *) - | S: ident -> int -> approx. + | G: ident -> int -> approx (** The value is the address of the given global symbol plus the given integer offset. *) + | S: int -> approx. (** The value is the stack pointer plus the offset. *) + (** We now define the abstract interpretations of conditions and operators over this set of approximations. For instance, the abstract interpretation @@ -44,140 +46,140 @@ Inductive approx : Type := The static approximations are defined by large pattern-matchings over the approximations of the results. We write these matchings in the - indirect style described in file [Selection] to avoid excessive + indirect style described in file [SelectOp] to avoid excessive duplication of cases in proofs. *) -(* -Definition eval_static_condition (cond: condition) (vl: list approx) := +Definition eval_static_shift (s: shift) (n: int) : int := + match s with + | Slsl x => Int.shl n x + | Slsr x => Int.shru n x + | Sasr x => Int.shr n x + | Sror x => Int.ror n x + end. + +(** Original definition: +<< +Nondetfunction eval_static_condition (cond: condition) (vl: list approx) := match cond, vl with | Ccomp c, I n1 :: I n2 :: nil => Some(Int.cmp c n1 n2) | Ccompu c, I n1 :: I n2 :: nil => Some(Int.cmpu c n1 n2) - | Ccompshift c s, I n1 :: I n2 :: nil => Some(Int.cmp c n1 (eval_shift s n2)) - | Ccompushift c s, I n1 :: I n2 :: nil => Some(Int.cmpu c n1 (eval_shift s n2)) + | Ccompshift c s, I n1 :: I n2 :: nil => Some(Int.cmp c n1 (eval_static_shift s n2)) + | Ccompushift c s, I n1 :: I n2 :: nil => Some(Int.cmpu c n1 (eval_static_shift s n2)) | Ccompimm c n, I n1 :: nil => Some(Int.cmp c n1 n) | Ccompuimm c n, I n1 :: nil => Some(Int.cmpu c n1 n) | Ccompf c, F n1 :: F n2 :: nil => Some(Float.cmp c n1 n2) | Cnotcompf c, F n1 :: F n2 :: nil => Some(negb(Float.cmp c n1 n2)) | _, _ => None end. +>> *) Inductive eval_static_condition_cases: forall (cond: condition) (vl: list approx), Type := - | eval_static_condition_case1: - forall c n1 n2, - eval_static_condition_cases (Ccomp c) (I n1 :: I n2 :: nil) - | eval_static_condition_case2: - forall c n1 n2, - eval_static_condition_cases (Ccompu c) (I n1 :: I n2 :: nil) - | eval_static_condition_case3: - forall c s n1 n2, - eval_static_condition_cases (Ccompshift c s) (I n1 :: I n2 :: nil) - | eval_static_condition_case4: - forall c s n1 n2, - eval_static_condition_cases (Ccompushift c s) (I n1 :: I n2 :: nil) - | eval_static_condition_case5: - forall c n n1, - eval_static_condition_cases (Ccompimm c n) (I n1 :: nil) - | eval_static_condition_case6: - forall c n n1, - eval_static_condition_cases (Ccompuimm c n) (I n1 :: nil) - | eval_static_condition_case7: - forall c n1 n2, - eval_static_condition_cases (Ccompf c) (F n1 :: F n2 :: nil) - | eval_static_condition_case8: - forall c n1 n2, - eval_static_condition_cases (Cnotcompf c) (F n1 :: F n2 :: nil) - | eval_static_condition_default: - forall (cond: condition) (vl: list approx), - eval_static_condition_cases cond vl. + | eval_static_condition_case1: forall c n1 n2, eval_static_condition_cases (Ccomp c) (I n1 :: I n2 :: nil) + | eval_static_condition_case2: forall c n1 n2, eval_static_condition_cases (Ccompu c) (I n1 :: I n2 :: nil) + | eval_static_condition_case3: forall c s n1 n2, eval_static_condition_cases (Ccompshift c s) (I n1 :: I n2 :: nil) + | eval_static_condition_case4: forall c s n1 n2, eval_static_condition_cases (Ccompushift c s) (I n1 :: I n2 :: nil) + | eval_static_condition_case5: forall c n n1, eval_static_condition_cases (Ccompimm c n) (I n1 :: nil) + | eval_static_condition_case6: forall c n n1, eval_static_condition_cases (Ccompuimm c n) (I n1 :: nil) + | eval_static_condition_case7: forall c n1 n2, eval_static_condition_cases (Ccompf c) (F n1 :: F n2 :: nil) + | eval_static_condition_case8: forall c n1 n2, eval_static_condition_cases (Cnotcompf c) (F n1 :: F n2 :: nil) + | eval_static_condition_default: forall (cond: condition) (vl: list approx), eval_static_condition_cases cond vl. Definition eval_static_condition_match (cond: condition) (vl: list approx) := - match cond as z1, vl as z2 return eval_static_condition_cases z1 z2 with - | Ccomp c, I n1 :: I n2 :: nil => - eval_static_condition_case1 c n1 n2 - | Ccompu c, I n1 :: I n2 :: nil => - eval_static_condition_case2 c n1 n2 - | Ccompshift c s, I n1 :: I n2 :: nil => - eval_static_condition_case3 c s n1 n2 - | Ccompushift c s, I n1 :: I n2 :: nil => - eval_static_condition_case4 c s n1 n2 - | Ccompimm c n, I n1 :: nil => - eval_static_condition_case5 c n n1 - | Ccompuimm c n, I n1 :: nil => - eval_static_condition_case6 c n n1 - | Ccompf c, F n1 :: F n2 :: nil => - eval_static_condition_case7 c n1 n2 - | Cnotcompf c, F n1 :: F n2 :: nil => - eval_static_condition_case8 c n1 n2 - | cond, vl => - eval_static_condition_default cond vl + match cond as zz1, vl as zz2 return eval_static_condition_cases zz1 zz2 with + | Ccomp c, I n1 :: I n2 :: nil => eval_static_condition_case1 c n1 n2 + | Ccompu c, I n1 :: I n2 :: nil => eval_static_condition_case2 c n1 n2 + | Ccompshift c s, I n1 :: I n2 :: nil => eval_static_condition_case3 c s n1 n2 + | Ccompushift c s, I n1 :: I n2 :: nil => eval_static_condition_case4 c s n1 n2 + | Ccompimm c n, I n1 :: nil => eval_static_condition_case5 c n n1 + | Ccompuimm c n, I n1 :: nil => eval_static_condition_case6 c n n1 + | Ccompf c, F n1 :: F n2 :: nil => eval_static_condition_case7 c n1 n2 + | Cnotcompf c, F n1 :: F n2 :: nil => eval_static_condition_case8 c n1 n2 + | cond, vl => eval_static_condition_default cond vl end. Definition eval_static_condition (cond: condition) (vl: list approx) := match eval_static_condition_match cond vl with - | eval_static_condition_case1 c n1 n2 => + | eval_static_condition_case1 c n1 n2 => (* Ccomp c, I n1 :: I n2 :: nil *) Some(Int.cmp c n1 n2) - | eval_static_condition_case2 c n1 n2 => + | eval_static_condition_case2 c n1 n2 => (* Ccompu c, I n1 :: I n2 :: nil *) Some(Int.cmpu c n1 n2) - | eval_static_condition_case3 c s n1 n2 => - Some(Int.cmp c n1 (eval_shift s n2)) - | eval_static_condition_case4 c s n1 n2 => - Some(Int.cmpu c n1 (eval_shift s n2)) - | eval_static_condition_case5 c n n1 => + | eval_static_condition_case3 c s n1 n2 => (* Ccompshift c s, I n1 :: I n2 :: nil *) + Some(Int.cmp c n1 (eval_static_shift s n2)) + | eval_static_condition_case4 c s n1 n2 => (* Ccompushift c s, I n1 :: I n2 :: nil *) + Some(Int.cmpu c n1 (eval_static_shift s n2)) + | eval_static_condition_case5 c n n1 => (* Ccompimm c n, I n1 :: nil *) Some(Int.cmp c n1 n) - | eval_static_condition_case6 c n n1 => + | eval_static_condition_case6 c n n1 => (* Ccompuimm c n, I n1 :: nil *) Some(Int.cmpu c n1 n) - | eval_static_condition_case7 c n1 n2 => + | eval_static_condition_case7 c n1 n2 => (* Ccompf c, F n1 :: F n2 :: nil *) Some(Float.cmp c n1 n2) - | eval_static_condition_case8 c n1 n2 => + | eval_static_condition_case8 c n1 n2 => (* Cnotcompf c, F n1 :: F n2 :: nil *) Some(negb(Float.cmp c n1 n2)) | eval_static_condition_default cond vl => None end. -(* -Definition eval_static_operation (op: operation) (vl: list approx) := + +Definition eval_static_condition_val (cond: condition) (vl: list approx) := + match eval_static_condition cond vl with + | None => Unknown + | Some b => I(if b then Int.one else Int.zero) + end. + +Definition eval_static_intoffloat (f: float) := + match Float.intoffloat f with Some x => I x | None => Unknown end. + +Definition eval_static_intuoffloat (f: float) := + match Float.intuoffloat f with Some x => I x | None => Unknown end. + +(** Original definition: +<< +Nondetfunction eval_static_operation (op: operation) (vl: list approx) := match op, vl with | Omove, v1::nil => v1 | Ointconst n, nil => I n | Ofloatconst n, nil => F n - | Oaddrsymbol s n, nil => S s n - | Ocast8signed, I n1 :: nil => I(Int.sign_ext 8 n) - | Ocast8unsigned, I n1 :: nil => I(Int.zero_ext 8 n) - | Ocast16signed, I n1 :: nil => I(Int.sign_ext 16 n) - | Ocast16unsigned, I n1 :: nil => I(Int.zero_ext 16 n) + | Oaddrsymbol s n, nil => G s n + | Oaddrstack n, nil => S n | Oadd, I n1 :: I n2 :: nil => I(Int.add n1 n2) - | Oaddshift s, I n1 :: I n2 :: nil => I(Int.add n1 (eval_shift s n2)) - | Oadd, S s1 n1 :: I n2 :: nil => S s1 (Int.add n1 n2) - | Oaddshift s, S s1 n1 :: I n2 :: nil => S s1 (Int.add n1 (eval_shift s n2)) + | Oaddshift s, I n1 :: I n2 :: nil => I(Int.add n1 (eval_static_shift s n2)) + | Oadd, G s1 n1 :: I n2 :: nil => G s1 (Int.add n1 n2) + | Oaddshift s, G s1 n1 :: I n2 :: nil => G s1 (Int.add n1 (eval_static_shift s n2)) + | Oadd, S n1 :: I n2 :: nil => S (Int.add n1 n2) + | Oaddshift s, S n1 :: I n2 :: nil => S (Int.add n1 (eval_static_shift s n2)) + | Oadd, I n1 :: G s2 n2 :: nil => G s2 (Int.add n1 n2) + | Oadd, I n1 :: S n2 :: nil => S (Int.add n1 n2) | Oaddimm n, I n1 :: nil => I (Int.add n1 n) - | Oaddimm n, S s1 n1 :: nil => S s1 (Int.add n1 n) + | Oaddimm n, G s1 n1 :: nil => G s1 (Int.add n1 n) + | Oaddimm n, S n1 :: nil => S (Int.add n1 n) | Osub, I n1 :: I n2 :: nil => I(Int.sub n1 n2) - | Osubshift s, I n1 :: I n2 :: nil => I(Int.sub n1 (eval_shift s n2)) - | Osub, S s1 n1 :: I n2 :: nil => S s1 (Int.sub n1 n2) - | Osubshift s, S s1 n1 :: I n2 :: nil => S s1 (Int.sub n1 (eval_shift s n2)) - | Orsubshift s, I n1 :: I n2 :: nil => I(Int.sub (eval_shift s n2) n1) + | Osubshift s, I n1 :: I n2 :: nil => I(Int.sub n1 (eval_static_shift s n2)) + | Osub, G s1 n1 :: I n2 :: nil => G s1 (Int.sub n1 n2) + | Osub, S n1 :: I n2 :: nil => S (Int.sub n1 n2) + | Osubshift s, G s1 n1 :: I n2 :: nil => G s1 (Int.sub n1 (eval_static_shift s n2)) + | Orsubshift s, I n1 :: I n2 :: nil => I(Int.sub (eval_static_shift s n2) n1) | Orsubimm n, I n1 :: nil => I (Int.sub n n1) | Omul, I n1 :: I n2 :: nil => I(Int.mul n1 n2) | Odiv, I n1 :: I n2 :: nil => if Int.eq n2 Int.zero then Unknown else I(Int.divs n1 n2) | Odivu, I n1 :: I n2 :: nil => if Int.eq n2 Int.zero then Unknown else I(Int.divu n1 n2) | Oand, I n1 :: I n2 :: nil => I(Int.and n1 n2) - | Oandshift s, I n1 :: I n2 :: nil => I(Int.and n1 (eval_shift s n2)) + | Oandshift s, I n1 :: I n2 :: nil => I(Int.and n1 (eval_static_shift s n2)) | Oandimm n, I n1 :: nil => I(Int.and n1 n) | Oor, I n1 :: I n2 :: nil => I(Int.or n1 n2) - | Oorshift s, I n1 :: I n2 :: nil => I(Int.or n1 (eval_shift s n2)) + | Oorshift s, I n1 :: I n2 :: nil => I(Int.or n1 (eval_static_shift s n2)) | Oorimm n, I n1 :: nil => I(Int.or n1 n) | Oxor, I n1 :: I n2 :: nil => I(Int.xor n1 n2) - | Oxorshift s, I n1 :: I n2 :: nil => I(Int.xor n1 (eval_shift s n2)) + | Oxorshift s, I n1 :: I n2 :: nil => I(Int.xor n1 (eval_static_shift s n2)) | Oxorimm n, I n1 :: nil => I(Int.xor n1 n) | Obic, I n1 :: I n2 :: nil => I(Int.and n1 (Int.not n2)) - | Obicshift s, I n1 :: I n2 :: nil => I(Int.and n1 (Int.not (eval_shift s n2))) + | Obicshift s, I n1 :: I n2 :: nil => I(Int.and n1 (Int.not (eval_static_shift s n2))) | Onot, I n1 :: nil => I(Int.not n1) - | Onotshift s, I n1 :: nil => I(Int.not (eval_shift s n1)) + | Onotshift s, I n1 :: nil => I(Int.not (eval_static_shift s n1)) | Oshl, I n1 :: I n2 :: nil => if Int.ltu n2 Int.iwordsize then I(Int.shl n1 n2) else Unknown | Oshr, I n1 :: I n2 :: nil => if Int.ltu n2 Int.iwordsize then I(Int.shr n1 n2) else Unknown | Oshru, I n1 :: I n2 :: nil => if Int.ltu n2 Int.iwordsize then I(Int.shru n1 n2) else Unknown - | Oshift s, I n1 :: nil => I(eval_shift s n1) + | Oshift s, I n1 :: nil => I(eval_static_shift s n1) | Onegf, F n1 :: nil => F(Float.neg n1) | Oabsf, F n1 :: nil => F(Float.abs n1) | Oaddf, F n1 :: F n2 :: nil => F(Float.add n1 n2) @@ -185,409 +187,251 @@ Definition eval_static_operation (op: operation) (vl: list approx) := | Omulf, F n1 :: F n2 :: nil => F(Float.mul n1 n2) | Odivf, F n1 :: F n2 :: nil => F(Float.div n1 n2) | Osingleoffloat, F n1 :: nil => F(Float.singleoffloat n1) - | Ointoffloat, F n1 :: nil => match Float.intoffloat n1 with Some x => I x | None => Unknown end + | Ointoffloat, F n1 :: nil => eval_static_intoffloat n1 + | Ointuoffloat, F n1 :: nil => eval_static_intuoffloat n1 | Ofloatofint, I n1 :: nil => F(Float.floatofint n1) | Ofloatofintu, I n1 :: nil => F(Float.floatofintu n1) - | Ocmp c, vl => - match eval_static_condition c vl with - | None => Unknown - | Some b => I(if b then Int.one else Int.zero) - end + | Ocmp c, vl => eval_static_condition_val c vl | _, _ => Unknown end. +>> *) Inductive eval_static_operation_cases: forall (op: operation) (vl: list approx), Type := - | eval_static_operation_case1: - forall v1, - eval_static_operation_cases (Omove) (v1::nil) - | eval_static_operation_case2: - forall n, - eval_static_operation_cases (Ointconst n) (nil) - | eval_static_operation_case3: - forall n, - eval_static_operation_cases (Ofloatconst n) (nil) - | eval_static_operation_case4: - forall s n, - eval_static_operation_cases (Oaddrsymbol s n) (nil) - | eval_static_operation_case5: - forall n1, - eval_static_operation_cases (Ocast8signed) (I n1 :: nil) - | eval_static_operation_case6: - forall n1, - eval_static_operation_cases (Ocast8unsigned) (I n1 :: nil) - | eval_static_operation_case7: - forall n1, - eval_static_operation_cases (Ocast16signed) (I n1 :: nil) - | eval_static_operation_case8: - forall n1, - eval_static_operation_cases (Ocast16unsigned) (I n1 :: nil) - | eval_static_operation_case9: - forall n1 n2, - eval_static_operation_cases (Oadd) (I n1 :: I n2 :: nil) - | eval_static_operation_case10: - forall s n1 n2, - eval_static_operation_cases (Oaddshift s) (I n1 :: I n2 :: nil) - | eval_static_operation_case11: - forall s1 n1 n2, - eval_static_operation_cases (Oadd) (S s1 n1 :: I n2 :: nil) - | eval_static_operation_case12: - forall s s1 n1 n2, - eval_static_operation_cases (Oaddshift s) (S s1 n1 :: I n2 :: nil) - | eval_static_operation_case13: - forall n n1, - eval_static_operation_cases (Oaddimm n) (I n1 :: nil) - | eval_static_operation_case14: - forall n s1 n1, - eval_static_operation_cases (Oaddimm n) (S s1 n1 :: nil) - | eval_static_operation_case15: - forall n1 n2, - eval_static_operation_cases (Osub) (I n1 :: I n2 :: nil) - | eval_static_operation_case16: - forall s n1 n2, - eval_static_operation_cases (Osubshift s) (I n1 :: I n2 :: nil) - | eval_static_operation_case17: - forall s1 n1 n2, - eval_static_operation_cases (Osub) (S s1 n1 :: I n2 :: nil) - | eval_static_operation_case18: - forall s s1 n1 n2, - eval_static_operation_cases (Osubshift s) (S s1 n1 :: I n2 :: nil) - | eval_static_operation_case19: - forall s n1 n2, - eval_static_operation_cases (Orsubshift s) (I n1 :: I n2 :: nil) - | eval_static_operation_case20: - forall n n1, - eval_static_operation_cases (Orsubimm n) (I n1 :: nil) - | eval_static_operation_case21: - forall n1 n2, - eval_static_operation_cases (Omul) (I n1 :: I n2 :: nil) - | eval_static_operation_case22: - forall n1 n2, - eval_static_operation_cases (Odiv) (I n1 :: I n2 :: nil) - | eval_static_operation_case23: - forall n1 n2, - eval_static_operation_cases (Odivu) (I n1 :: I n2 :: nil) - | eval_static_operation_case24: - forall n1 n2, - eval_static_operation_cases (Oand) (I n1 :: I n2 :: nil) - | eval_static_operation_case25: - forall s n1 n2, - eval_static_operation_cases (Oandshift s) (I n1 :: I n2 :: nil) - | eval_static_operation_case26: - forall n n1, - eval_static_operation_cases (Oandimm n) (I n1 :: nil) - | eval_static_operation_case27: - forall n1 n2, - eval_static_operation_cases (Oor) (I n1 :: I n2 :: nil) - | eval_static_operation_case28: - forall s n1 n2, - eval_static_operation_cases (Oorshift s) (I n1 :: I n2 :: nil) - | eval_static_operation_case29: - forall n n1, - eval_static_operation_cases (Oorimm n) (I n1 :: nil) - | eval_static_operation_case30: - forall n1 n2, - eval_static_operation_cases (Oxor) (I n1 :: I n2 :: nil) - | eval_static_operation_case31: - forall s n1 n2, - eval_static_operation_cases (Oxorshift s) (I n1 :: I n2 :: nil) - | eval_static_operation_case32: - forall n n1, - eval_static_operation_cases (Oxorimm n) (I n1 :: nil) - | eval_static_operation_case33: - forall n1 n2, - eval_static_operation_cases (Obic) (I n1 :: I n2 :: nil) - | eval_static_operation_case34: - forall s n1 n2, - eval_static_operation_cases (Obicshift s) (I n1 :: I n2 :: nil) - | eval_static_operation_case35: - forall n1, - eval_static_operation_cases (Onot) (I n1 :: nil) - | eval_static_operation_case36: - forall s n1, - eval_static_operation_cases (Onotshift s) (I n1 :: nil) - | eval_static_operation_case37: - forall n1 n2, - eval_static_operation_cases (Oshl) (I n1 :: I n2 :: nil) - | eval_static_operation_case38: - forall n1 n2, - eval_static_operation_cases (Oshr) (I n1 :: I n2 :: nil) - | eval_static_operation_case39: - forall n1 n2, - eval_static_operation_cases (Oshru) (I n1 :: I n2 :: nil) - | eval_static_operation_case40: - forall s n1, - eval_static_operation_cases (Oshift s) (I n1 :: nil) - | eval_static_operation_case41: - forall n1, - eval_static_operation_cases (Onegf) (F n1 :: nil) - | eval_static_operation_case42: - forall n1, - eval_static_operation_cases (Oabsf) (F n1 :: nil) - | eval_static_operation_case43: - forall n1 n2, - eval_static_operation_cases (Oaddf) (F n1 :: F n2 :: nil) - | eval_static_operation_case44: - forall n1 n2, - eval_static_operation_cases (Osubf) (F n1 :: F n2 :: nil) - | eval_static_operation_case45: - forall n1 n2, - eval_static_operation_cases (Omulf) (F n1 :: F n2 :: nil) - | eval_static_operation_case46: - forall n1 n2, - eval_static_operation_cases (Odivf) (F n1 :: F n2 :: nil) - | eval_static_operation_case47: - forall n1, - eval_static_operation_cases (Osingleoffloat) (F n1 :: nil) - | eval_static_operation_case48: - forall n1, - eval_static_operation_cases (Ointoffloat) (F n1 :: nil) - | eval_static_operation_case49: - forall n1, - eval_static_operation_cases (Ofloatofint) (I n1 :: nil) - | eval_static_operation_case50: - forall n1, - eval_static_operation_cases (Ointuoffloat) (F n1 :: nil) - | eval_static_operation_case53: - forall n1, - eval_static_operation_cases (Ofloatofintu) (I n1 :: nil) - | eval_static_operation_case51: - forall c vl, - eval_static_operation_cases (Ocmp c) (vl) - | eval_static_operation_case52: - forall n n1, - eval_static_operation_cases (Oshrximm n) (I n1 :: nil) - | eval_static_operation_default: - forall (op: operation) (vl: list approx), - eval_static_operation_cases op vl. + | eval_static_operation_case1: forall v1, eval_static_operation_cases (Omove) (v1::nil) + | eval_static_operation_case2: forall n, eval_static_operation_cases (Ointconst n) (nil) + | eval_static_operation_case3: forall n, eval_static_operation_cases (Ofloatconst n) (nil) + | eval_static_operation_case4: forall s n, eval_static_operation_cases (Oaddrsymbol s n) (nil) + | eval_static_operation_case5: forall n, eval_static_operation_cases (Oaddrstack n) (nil) + | eval_static_operation_case6: forall n1 n2, eval_static_operation_cases (Oadd) (I n1 :: I n2 :: nil) + | eval_static_operation_case7: forall s n1 n2, eval_static_operation_cases (Oaddshift s) (I n1 :: I n2 :: nil) + | eval_static_operation_case8: forall s1 n1 n2, eval_static_operation_cases (Oadd) (G s1 n1 :: I n2 :: nil) + | eval_static_operation_case9: forall s s1 n1 n2, eval_static_operation_cases (Oaddshift s) (G s1 n1 :: I n2 :: nil) + | eval_static_operation_case10: forall n1 n2, eval_static_operation_cases (Oadd) (S n1 :: I n2 :: nil) + | eval_static_operation_case11: forall s n1 n2, eval_static_operation_cases (Oaddshift s) (S n1 :: I n2 :: nil) + | eval_static_operation_case12: forall n1 s2 n2, eval_static_operation_cases (Oadd) (I n1 :: G s2 n2 :: nil) + | eval_static_operation_case13: forall n1 n2, eval_static_operation_cases (Oadd) (I n1 :: S n2 :: nil) + | eval_static_operation_case14: forall n n1, eval_static_operation_cases (Oaddimm n) (I n1 :: nil) + | eval_static_operation_case15: forall n s1 n1, eval_static_operation_cases (Oaddimm n) (G s1 n1 :: nil) + | eval_static_operation_case16: forall n n1, eval_static_operation_cases (Oaddimm n) (S n1 :: nil) + | eval_static_operation_case17: forall n1 n2, eval_static_operation_cases (Osub) (I n1 :: I n2 :: nil) + | eval_static_operation_case18: forall s n1 n2, eval_static_operation_cases (Osubshift s) (I n1 :: I n2 :: nil) + | eval_static_operation_case19: forall s1 n1 n2, eval_static_operation_cases (Osub) (G s1 n1 :: I n2 :: nil) + | eval_static_operation_case20: forall n1 n2, eval_static_operation_cases (Osub) (S n1 :: I n2 :: nil) + | eval_static_operation_case21: forall s s1 n1 n2, eval_static_operation_cases (Osubshift s) (G s1 n1 :: I n2 :: nil) + | eval_static_operation_case22: forall s n1 n2, eval_static_operation_cases (Orsubshift s) (I n1 :: I n2 :: nil) + | eval_static_operation_case23: forall n n1, eval_static_operation_cases (Orsubimm n) (I n1 :: nil) + | eval_static_operation_case24: forall n1 n2, eval_static_operation_cases (Omul) (I n1 :: I n2 :: nil) + | eval_static_operation_case25: forall n1 n2, eval_static_operation_cases (Odiv) (I n1 :: I n2 :: nil) + | eval_static_operation_case26: forall n1 n2, eval_static_operation_cases (Odivu) (I n1 :: I n2 :: nil) + | eval_static_operation_case27: forall n1 n2, eval_static_operation_cases (Oand) (I n1 :: I n2 :: nil) + | eval_static_operation_case28: forall s n1 n2, eval_static_operation_cases (Oandshift s) (I n1 :: I n2 :: nil) + | eval_static_operation_case29: forall n n1, eval_static_operation_cases (Oandimm n) (I n1 :: nil) + | eval_static_operation_case30: forall n1 n2, eval_static_operation_cases (Oor) (I n1 :: I n2 :: nil) + | eval_static_operation_case31: forall s n1 n2, eval_static_operation_cases (Oorshift s) (I n1 :: I n2 :: nil) + | eval_static_operation_case32: forall n n1, eval_static_operation_cases (Oorimm n) (I n1 :: nil) + | eval_static_operation_case33: forall n1 n2, eval_static_operation_cases (Oxor) (I n1 :: I n2 :: nil) + | eval_static_operation_case34: forall s n1 n2, eval_static_operation_cases (Oxorshift s) (I n1 :: I n2 :: nil) + | eval_static_operation_case35: forall n n1, eval_static_operation_cases (Oxorimm n) (I n1 :: nil) + | eval_static_operation_case36: forall n1 n2, eval_static_operation_cases (Obic) (I n1 :: I n2 :: nil) + | eval_static_operation_case37: forall s n1 n2, eval_static_operation_cases (Obicshift s) (I n1 :: I n2 :: nil) + | eval_static_operation_case38: forall n1, eval_static_operation_cases (Onot) (I n1 :: nil) + | eval_static_operation_case39: forall s n1, eval_static_operation_cases (Onotshift s) (I n1 :: nil) + | eval_static_operation_case40: forall n1 n2, eval_static_operation_cases (Oshl) (I n1 :: I n2 :: nil) + | eval_static_operation_case41: forall n1 n2, eval_static_operation_cases (Oshr) (I n1 :: I n2 :: nil) + | eval_static_operation_case42: forall n1 n2, eval_static_operation_cases (Oshru) (I n1 :: I n2 :: nil) + | eval_static_operation_case43: forall s n1, eval_static_operation_cases (Oshift s) (I n1 :: nil) + | eval_static_operation_case44: forall n1, eval_static_operation_cases (Onegf) (F n1 :: nil) + | eval_static_operation_case45: forall n1, eval_static_operation_cases (Oabsf) (F n1 :: nil) + | eval_static_operation_case46: forall n1 n2, eval_static_operation_cases (Oaddf) (F n1 :: F n2 :: nil) + | eval_static_operation_case47: forall n1 n2, eval_static_operation_cases (Osubf) (F n1 :: F n2 :: nil) + | eval_static_operation_case48: forall n1 n2, eval_static_operation_cases (Omulf) (F n1 :: F n2 :: nil) + | eval_static_operation_case49: forall n1 n2, eval_static_operation_cases (Odivf) (F n1 :: F n2 :: nil) + | eval_static_operation_case50: forall n1, eval_static_operation_cases (Osingleoffloat) (F n1 :: nil) + | eval_static_operation_case51: forall n1, eval_static_operation_cases (Ointoffloat) (F n1 :: nil) + | eval_static_operation_case52: forall n1, eval_static_operation_cases (Ointuoffloat) (F n1 :: nil) + | eval_static_operation_case53: forall n1, eval_static_operation_cases (Ofloatofint) (I n1 :: nil) + | eval_static_operation_case54: forall n1, eval_static_operation_cases (Ofloatofintu) (I n1 :: nil) + | eval_static_operation_case55: forall c vl, eval_static_operation_cases (Ocmp c) (vl) + | eval_static_operation_default: forall (op: operation) (vl: list approx), eval_static_operation_cases op vl. Definition eval_static_operation_match (op: operation) (vl: list approx) := - match op as z1, vl as z2 return eval_static_operation_cases z1 z2 with - | Omove, v1::nil => - eval_static_operation_case1 v1 - | Ointconst n, nil => - eval_static_operation_case2 n - | Ofloatconst n, nil => - eval_static_operation_case3 n - | Oaddrsymbol s n, nil => - eval_static_operation_case4 s n - | Ocast8signed, I n1 :: nil => - eval_static_operation_case5 n1 - | Ocast8unsigned, I n1 :: nil => - eval_static_operation_case6 n1 - | Ocast16signed, I n1 :: nil => - eval_static_operation_case7 n1 - | Ocast16unsigned, I n1 :: nil => - eval_static_operation_case8 n1 - | Oadd, I n1 :: I n2 :: nil => - eval_static_operation_case9 n1 n2 - | Oaddshift s, I n1 :: I n2 :: nil => - eval_static_operation_case10 s n1 n2 - | Oadd, S s1 n1 :: I n2 :: nil => - eval_static_operation_case11 s1 n1 n2 - | Oaddshift s, S s1 n1 :: I n2 :: nil => - eval_static_operation_case12 s s1 n1 n2 - | Oaddimm n, I n1 :: nil => - eval_static_operation_case13 n n1 - | Oaddimm n, S s1 n1 :: nil => - eval_static_operation_case14 n s1 n1 - | Osub, I n1 :: I n2 :: nil => - eval_static_operation_case15 n1 n2 - | Osubshift s, I n1 :: I n2 :: nil => - eval_static_operation_case16 s n1 n2 - | Osub, S s1 n1 :: I n2 :: nil => - eval_static_operation_case17 s1 n1 n2 - | Osubshift s, S s1 n1 :: I n2 :: nil => - eval_static_operation_case18 s s1 n1 n2 - | Orsubshift s, I n1 :: I n2 :: nil => - eval_static_operation_case19 s n1 n2 - | Orsubimm n, I n1 :: nil => - eval_static_operation_case20 n n1 - | Omul, I n1 :: I n2 :: nil => - eval_static_operation_case21 n1 n2 - | Odiv, I n1 :: I n2 :: nil => - eval_static_operation_case22 n1 n2 - | Odivu, I n1 :: I n2 :: nil => - eval_static_operation_case23 n1 n2 - | Oand, I n1 :: I n2 :: nil => - eval_static_operation_case24 n1 n2 - | Oandshift s, I n1 :: I n2 :: nil => - eval_static_operation_case25 s n1 n2 - | Oandimm n, I n1 :: nil => - eval_static_operation_case26 n n1 - | Oor, I n1 :: I n2 :: nil => - eval_static_operation_case27 n1 n2 - | Oorshift s, I n1 :: I n2 :: nil => - eval_static_operation_case28 s n1 n2 - | Oorimm n, I n1 :: nil => - eval_static_operation_case29 n n1 - | Oxor, I n1 :: I n2 :: nil => - eval_static_operation_case30 n1 n2 - | Oxorshift s, I n1 :: I n2 :: nil => - eval_static_operation_case31 s n1 n2 - | Oxorimm n, I n1 :: nil => - eval_static_operation_case32 n n1 - | Obic, I n1 :: I n2 :: nil => - eval_static_operation_case33 n1 n2 - | Obicshift s, I n1 :: I n2 :: nil => - eval_static_operation_case34 s n1 n2 - | Onot, I n1 :: nil => - eval_static_operation_case35 n1 - | Onotshift s, I n1 :: nil => - eval_static_operation_case36 s n1 - | Oshl, I n1 :: I n2 :: nil => - eval_static_operation_case37 n1 n2 - | Oshr, I n1 :: I n2 :: nil => - eval_static_operation_case38 n1 n2 - | Oshru, I n1 :: I n2 :: nil => - eval_static_operation_case39 n1 n2 - | Oshift s, I n1 :: nil => - eval_static_operation_case40 s n1 - | Onegf, F n1 :: nil => - eval_static_operation_case41 n1 - | Oabsf, F n1 :: nil => - eval_static_operation_case42 n1 - | Oaddf, F n1 :: F n2 :: nil => - eval_static_operation_case43 n1 n2 - | Osubf, F n1 :: F n2 :: nil => - eval_static_operation_case44 n1 n2 - | Omulf, F n1 :: F n2 :: nil => - eval_static_operation_case45 n1 n2 - | Odivf, F n1 :: F n2 :: nil => - eval_static_operation_case46 n1 n2 - | Osingleoffloat, F n1 :: nil => - eval_static_operation_case47 n1 - | Ointoffloat, F n1 :: nil => - eval_static_operation_case48 n1 - | Ofloatofint, I n1 :: nil => - eval_static_operation_case49 n1 - | Ointuoffloat, F n1 :: nil => - eval_static_operation_case50 n1 - | Ofloatofintu, I n1 :: nil => - eval_static_operation_case53 n1 - | Ocmp c, vl => - eval_static_operation_case51 c vl - | Oshrximm n, I n1 :: nil => - eval_static_operation_case52 n n1 - | op, vl => - eval_static_operation_default op vl + match op as zz1, vl as zz2 return eval_static_operation_cases zz1 zz2 with + | Omove, v1::nil => eval_static_operation_case1 v1 + | Ointconst n, nil => eval_static_operation_case2 n + | Ofloatconst n, nil => eval_static_operation_case3 n + | Oaddrsymbol s n, nil => eval_static_operation_case4 s n + | Oaddrstack n, nil => eval_static_operation_case5 n + | Oadd, I n1 :: I n2 :: nil => eval_static_operation_case6 n1 n2 + | Oaddshift s, I n1 :: I n2 :: nil => eval_static_operation_case7 s n1 n2 + | Oadd, G s1 n1 :: I n2 :: nil => eval_static_operation_case8 s1 n1 n2 + | Oaddshift s, G s1 n1 :: I n2 :: nil => eval_static_operation_case9 s s1 n1 n2 + | Oadd, S n1 :: I n2 :: nil => eval_static_operation_case10 n1 n2 + | Oaddshift s, S n1 :: I n2 :: nil => eval_static_operation_case11 s n1 n2 + | Oadd, I n1 :: G s2 n2 :: nil => eval_static_operation_case12 n1 s2 n2 + | Oadd, I n1 :: S n2 :: nil => eval_static_operation_case13 n1 n2 + | Oaddimm n, I n1 :: nil => eval_static_operation_case14 n n1 + | Oaddimm n, G s1 n1 :: nil => eval_static_operation_case15 n s1 n1 + | Oaddimm n, S n1 :: nil => eval_static_operation_case16 n n1 + | Osub, I n1 :: I n2 :: nil => eval_static_operation_case17 n1 n2 + | Osubshift s, I n1 :: I n2 :: nil => eval_static_operation_case18 s n1 n2 + | Osub, G s1 n1 :: I n2 :: nil => eval_static_operation_case19 s1 n1 n2 + | Osub, S n1 :: I n2 :: nil => eval_static_operation_case20 n1 n2 + | Osubshift s, G s1 n1 :: I n2 :: nil => eval_static_operation_case21 s s1 n1 n2 + | Orsubshift s, I n1 :: I n2 :: nil => eval_static_operation_case22 s n1 n2 + | Orsubimm n, I n1 :: nil => eval_static_operation_case23 n n1 + | Omul, I n1 :: I n2 :: nil => eval_static_operation_case24 n1 n2 + | Odiv, I n1 :: I n2 :: nil => eval_static_operation_case25 n1 n2 + | Odivu, I n1 :: I n2 :: nil => eval_static_operation_case26 n1 n2 + | Oand, I n1 :: I n2 :: nil => eval_static_operation_case27 n1 n2 + | Oandshift s, I n1 :: I n2 :: nil => eval_static_operation_case28 s n1 n2 + | Oandimm n, I n1 :: nil => eval_static_operation_case29 n n1 + | Oor, I n1 :: I n2 :: nil => eval_static_operation_case30 n1 n2 + | Oorshift s, I n1 :: I n2 :: nil => eval_static_operation_case31 s n1 n2 + | Oorimm n, I n1 :: nil => eval_static_operation_case32 n n1 + | Oxor, I n1 :: I n2 :: nil => eval_static_operation_case33 n1 n2 + | Oxorshift s, I n1 :: I n2 :: nil => eval_static_operation_case34 s n1 n2 + | Oxorimm n, I n1 :: nil => eval_static_operation_case35 n n1 + | Obic, I n1 :: I n2 :: nil => eval_static_operation_case36 n1 n2 + | Obicshift s, I n1 :: I n2 :: nil => eval_static_operation_case37 s n1 n2 + | Onot, I n1 :: nil => eval_static_operation_case38 n1 + | Onotshift s, I n1 :: nil => eval_static_operation_case39 s n1 + | Oshl, I n1 :: I n2 :: nil => eval_static_operation_case40 n1 n2 + | Oshr, I n1 :: I n2 :: nil => eval_static_operation_case41 n1 n2 + | Oshru, I n1 :: I n2 :: nil => eval_static_operation_case42 n1 n2 + | Oshift s, I n1 :: nil => eval_static_operation_case43 s n1 + | Onegf, F n1 :: nil => eval_static_operation_case44 n1 + | Oabsf, F n1 :: nil => eval_static_operation_case45 n1 + | Oaddf, F n1 :: F n2 :: nil => eval_static_operation_case46 n1 n2 + | Osubf, F n1 :: F n2 :: nil => eval_static_operation_case47 n1 n2 + | Omulf, F n1 :: F n2 :: nil => eval_static_operation_case48 n1 n2 + | Odivf, F n1 :: F n2 :: nil => eval_static_operation_case49 n1 n2 + | Osingleoffloat, F n1 :: nil => eval_static_operation_case50 n1 + | Ointoffloat, F n1 :: nil => eval_static_operation_case51 n1 + | Ointuoffloat, F n1 :: nil => eval_static_operation_case52 n1 + | Ofloatofint, I n1 :: nil => eval_static_operation_case53 n1 + | Ofloatofintu, I n1 :: nil => eval_static_operation_case54 n1 + | Ocmp c, vl => eval_static_operation_case55 c vl + | op, vl => eval_static_operation_default op vl end. Definition eval_static_operation (op: operation) (vl: list approx) := match eval_static_operation_match op vl with - | eval_static_operation_case1 v1 => + | eval_static_operation_case1 v1 => (* Omove, v1::nil *) v1 - | eval_static_operation_case2 n => + | eval_static_operation_case2 n => (* Ointconst n, nil *) I n - | eval_static_operation_case3 n => + | eval_static_operation_case3 n => (* Ofloatconst n, nil *) F n - | eval_static_operation_case4 s n => - S s n - | eval_static_operation_case5 n => - I(Int.sign_ext 8 n) - | eval_static_operation_case6 n => - I(Int.zero_ext 8 n) - | eval_static_operation_case7 n => - I(Int.sign_ext 16 n) - | eval_static_operation_case8 n => - I(Int.zero_ext 16 n) - | eval_static_operation_case9 n1 n2 => + | eval_static_operation_case4 s n => (* Oaddrsymbol s n, nil *) + G s n + | eval_static_operation_case5 n => (* Oaddrstack n, nil *) + S n + | eval_static_operation_case6 n1 n2 => (* Oadd, I n1 :: I n2 :: nil *) I(Int.add n1 n2) - | eval_static_operation_case10 s n1 n2 => - I(Int.add n1 (eval_shift s n2)) - | eval_static_operation_case11 s1 n1 n2 => - S s1 (Int.add n1 n2) - | eval_static_operation_case12 s s1 n1 n2 => - S s1 (Int.add n1 (eval_shift s n2)) - | eval_static_operation_case13 n n1 => + | eval_static_operation_case7 s n1 n2 => (* Oaddshift s, I n1 :: I n2 :: nil *) + I(Int.add n1 (eval_static_shift s n2)) + | eval_static_operation_case8 s1 n1 n2 => (* Oadd, G s1 n1 :: I n2 :: nil *) + G s1 (Int.add n1 n2) + | eval_static_operation_case9 s s1 n1 n2 => (* Oaddshift s, G s1 n1 :: I n2 :: nil *) + G s1 (Int.add n1 (eval_static_shift s n2)) + | eval_static_operation_case10 n1 n2 => (* Oadd, S n1 :: I n2 :: nil *) + S (Int.add n1 n2) + | eval_static_operation_case11 s n1 n2 => (* Oaddshift s, S n1 :: I n2 :: nil *) + S (Int.add n1 (eval_static_shift s n2)) + | eval_static_operation_case12 n1 s2 n2 => (* Oadd, I n1 :: G s2 n2 :: nil *) + G s2 (Int.add n1 n2) + | eval_static_operation_case13 n1 n2 => (* Oadd, I n1 :: S n2 :: nil *) + S (Int.add n1 n2) + | eval_static_operation_case14 n n1 => (* Oaddimm n, I n1 :: nil *) I (Int.add n1 n) - | eval_static_operation_case14 n s1 n1 => - S s1 (Int.add n1 n) - | eval_static_operation_case15 n1 n2 => + | eval_static_operation_case15 n s1 n1 => (* Oaddimm n, G s1 n1 :: nil *) + G s1 (Int.add n1 n) + | eval_static_operation_case16 n n1 => (* Oaddimm n, S n1 :: nil *) + S (Int.add n1 n) + | eval_static_operation_case17 n1 n2 => (* Osub, I n1 :: I n2 :: nil *) I(Int.sub n1 n2) - | eval_static_operation_case16 s n1 n2 => - I(Int.sub n1 (eval_shift s n2)) - | eval_static_operation_case17 s1 n1 n2 => - S s1 (Int.sub n1 n2) - | eval_static_operation_case18 s s1 n1 n2 => - S s1 (Int.sub n1 (eval_shift s n2)) - | eval_static_operation_case19 s n1 n2 => - I(Int.sub (eval_shift s n2) n1) - | eval_static_operation_case20 n n1 => + | eval_static_operation_case18 s n1 n2 => (* Osubshift s, I n1 :: I n2 :: nil *) + I(Int.sub n1 (eval_static_shift s n2)) + | eval_static_operation_case19 s1 n1 n2 => (* Osub, G s1 n1 :: I n2 :: nil *) + G s1 (Int.sub n1 n2) + | eval_static_operation_case20 n1 n2 => (* Osub, S n1 :: I n2 :: nil *) + S (Int.sub n1 n2) + | eval_static_operation_case21 s s1 n1 n2 => (* Osubshift s, G s1 n1 :: I n2 :: nil *) + G s1 (Int.sub n1 (eval_static_shift s n2)) + | eval_static_operation_case22 s n1 n2 => (* Orsubshift s, I n1 :: I n2 :: nil *) + I(Int.sub (eval_static_shift s n2) n1) + | eval_static_operation_case23 n n1 => (* Orsubimm n, I n1 :: nil *) I (Int.sub n n1) - | eval_static_operation_case21 n1 n2 => + | eval_static_operation_case24 n1 n2 => (* Omul, I n1 :: I n2 :: nil *) I(Int.mul n1 n2) - | eval_static_operation_case22 n1 n2 => + | eval_static_operation_case25 n1 n2 => (* Odiv, I n1 :: I n2 :: nil *) if Int.eq n2 Int.zero then Unknown else I(Int.divs n1 n2) - | eval_static_operation_case23 n1 n2 => + | eval_static_operation_case26 n1 n2 => (* Odivu, I n1 :: I n2 :: nil *) if Int.eq n2 Int.zero then Unknown else I(Int.divu n1 n2) - | eval_static_operation_case24 n1 n2 => + | eval_static_operation_case27 n1 n2 => (* Oand, I n1 :: I n2 :: nil *) I(Int.and n1 n2) - | eval_static_operation_case25 s n1 n2 => - I(Int.and n1 (eval_shift s n2)) - | eval_static_operation_case26 n n1 => + | eval_static_operation_case28 s n1 n2 => (* Oandshift s, I n1 :: I n2 :: nil *) + I(Int.and n1 (eval_static_shift s n2)) + | eval_static_operation_case29 n n1 => (* Oandimm n, I n1 :: nil *) I(Int.and n1 n) - | eval_static_operation_case27 n1 n2 => + | eval_static_operation_case30 n1 n2 => (* Oor, I n1 :: I n2 :: nil *) I(Int.or n1 n2) - | eval_static_operation_case28 s n1 n2 => - I(Int.or n1 (eval_shift s n2)) - | eval_static_operation_case29 n n1 => + | eval_static_operation_case31 s n1 n2 => (* Oorshift s, I n1 :: I n2 :: nil *) + I(Int.or n1 (eval_static_shift s n2)) + | eval_static_operation_case32 n n1 => (* Oorimm n, I n1 :: nil *) I(Int.or n1 n) - | eval_static_operation_case30 n1 n2 => + | eval_static_operation_case33 n1 n2 => (* Oxor, I n1 :: I n2 :: nil *) I(Int.xor n1 n2) - | eval_static_operation_case31 s n1 n2 => - I(Int.xor n1 (eval_shift s n2)) - | eval_static_operation_case32 n n1 => + | eval_static_operation_case34 s n1 n2 => (* Oxorshift s, I n1 :: I n2 :: nil *) + I(Int.xor n1 (eval_static_shift s n2)) + | eval_static_operation_case35 n n1 => (* Oxorimm n, I n1 :: nil *) I(Int.xor n1 n) - | eval_static_operation_case33 n1 n2 => + | eval_static_operation_case36 n1 n2 => (* Obic, I n1 :: I n2 :: nil *) I(Int.and n1 (Int.not n2)) - | eval_static_operation_case34 s n1 n2 => - I(Int.and n1 (Int.not (eval_shift s n2))) - | eval_static_operation_case35 n1 => + | eval_static_operation_case37 s n1 n2 => (* Obicshift s, I n1 :: I n2 :: nil *) + I(Int.and n1 (Int.not (eval_static_shift s n2))) + | eval_static_operation_case38 n1 => (* Onot, I n1 :: nil *) I(Int.not n1) - | eval_static_operation_case36 s n1 => - I(Int.not (eval_shift s n1)) - | eval_static_operation_case37 n1 n2 => + | eval_static_operation_case39 s n1 => (* Onotshift s, I n1 :: nil *) + I(Int.not (eval_static_shift s n1)) + | eval_static_operation_case40 n1 n2 => (* Oshl, I n1 :: I n2 :: nil *) if Int.ltu n2 Int.iwordsize then I(Int.shl n1 n2) else Unknown - | eval_static_operation_case38 n1 n2 => + | eval_static_operation_case41 n1 n2 => (* Oshr, I n1 :: I n2 :: nil *) if Int.ltu n2 Int.iwordsize then I(Int.shr n1 n2) else Unknown - | eval_static_operation_case39 n1 n2 => + | eval_static_operation_case42 n1 n2 => (* Oshru, I n1 :: I n2 :: nil *) if Int.ltu n2 Int.iwordsize then I(Int.shru n1 n2) else Unknown - | eval_static_operation_case40 s n1 => - I(eval_shift s n1) - | eval_static_operation_case41 n1 => + | eval_static_operation_case43 s n1 => (* Oshift s, I n1 :: nil *) + I(eval_static_shift s n1) + | eval_static_operation_case44 n1 => (* Onegf, F n1 :: nil *) F(Float.neg n1) - | eval_static_operation_case42 n1 => + | eval_static_operation_case45 n1 => (* Oabsf, F n1 :: nil *) F(Float.abs n1) - | eval_static_operation_case43 n1 n2 => + | eval_static_operation_case46 n1 n2 => (* Oaddf, F n1 :: F n2 :: nil *) F(Float.add n1 n2) - | eval_static_operation_case44 n1 n2 => + | eval_static_operation_case47 n1 n2 => (* Osubf, F n1 :: F n2 :: nil *) F(Float.sub n1 n2) - | eval_static_operation_case45 n1 n2 => + | eval_static_operation_case48 n1 n2 => (* Omulf, F n1 :: F n2 :: nil *) F(Float.mul n1 n2) - | eval_static_operation_case46 n1 n2 => + | eval_static_operation_case49 n1 n2 => (* Odivf, F n1 :: F n2 :: nil *) F(Float.div n1 n2) - | eval_static_operation_case47 n1 => + | eval_static_operation_case50 n1 => (* Osingleoffloat, F n1 :: nil *) F(Float.singleoffloat n1) - | eval_static_operation_case48 n1 => - match Float.intoffloat n1 with Some x => I x | None => Unknown end - | eval_static_operation_case49 n1 => + | eval_static_operation_case51 n1 => (* Ointoffloat, F n1 :: nil *) + eval_static_intoffloat n1 + | eval_static_operation_case52 n1 => (* Ointuoffloat, F n1 :: nil *) + eval_static_intuoffloat n1 + | eval_static_operation_case53 n1 => (* Ofloatofint, I n1 :: nil *) F(Float.floatofint n1) - | eval_static_operation_case50 n1 => - match Float.intuoffloat n1 with Some x => I x | None => Unknown end - | eval_static_operation_case53 n1 => + | eval_static_operation_case54 n1 => (* Ofloatofintu, I n1 :: nil *) F(Float.floatofintu n1) - | eval_static_operation_case51 c vl => - match eval_static_condition c vl with - | None => Unknown - | Some b => I(if b then Int.one else Int.zero) - end - | eval_static_operation_case52 n n1 => - if Int.ltu n (Int.repr 31) then I(Int.shrx n1 n) else Unknown + | eval_static_operation_case55 c vl => (* Ocmp c, vl *) + eval_static_condition_val c vl | eval_static_operation_default op vl => Unknown end. + (** * Operator strength reduction *) (** We now define auxiliary functions for strength reduction of @@ -597,134 +441,124 @@ Definition eval_static_operation (op: operation) (vl: list approx) := Section STRENGTH_REDUCTION. -Variable app: reg -> approx. - -Definition intval (r: reg) : option int := - match app r with I n => Some n | _ => None end. - -(* -Definition cond_strength_reduction (cond: condition) (args: list reg) := - match cond, args with - | Ccomp c, r1 :: r2 :: nil => - | Ccompu c, r1 :: r2 :: nil => - | Ccompshift c s, r1 :: r2 :: nil => - | Ccompushift c s, r1 :: r2 :: nil => - | _ => +(** Original definition: +<< +Nondetfunction cond_strength_reduction + (cond: condition) (args: list reg) (vl: list approx) := + match cond, args, vl with + | Ccomp c, r1 :: r2 :: nil, I n1 :: v2 :: nil => + (Ccompimm (swap_comparison c) n1, r2 :: nil) + | Ccomp c, r1 :: r2 :: nil, v1 :: I n2 :: nil => + (Ccompimm c n2, r1 :: nil) + | Ccompu c, r1 :: r2 :: nil, I n1 :: v2 :: nil => + (Ccompuimm (swap_comparison c) n1, r2 :: nil) + | Ccompu c, r1 :: r2 :: nil, v1 :: I n2 :: nil => + (Ccompuimm c n2, r1 :: nil) + | Ccompshift c s, r1 :: r2 :: nil, v1 :: I n2 :: nil => + (Ccompimm c (eval_static_shift s n2), r1 :: nil) + | Ccompushift c s, r1 :: r2 :: nil, v1 :: I n2 :: nil => + (Ccompuimm c (eval_static_shift s n2), r1 :: nil) + | _, _, _ => + (cond, args) end. +>> *) -Inductive cond_strength_reduction_cases: forall (cond: condition) (args: list reg), Type := - | cond_strength_reduction_case1: - forall c r1 r2, - cond_strength_reduction_cases (Ccomp c) (r1 :: r2 :: nil) - | cond_strength_reduction_case2: - forall c r1 r2, - cond_strength_reduction_cases (Ccompu c) (r1 :: r2 :: nil) - | cond_strength_reduction_case3: - forall c s r1 r2, - cond_strength_reduction_cases (Ccompshift c s) (r1 :: r2 :: nil) - | cond_strength_reduction_case4: - forall c s r1 r2, - cond_strength_reduction_cases (Ccompushift c s) (r1 :: r2 :: nil) - | cond_strength_reduction_default: - forall (cond: condition) (args: list reg), - cond_strength_reduction_cases cond args. - -Definition cond_strength_reduction_match (cond: condition) (args: list reg) := - match cond as z1, args as z2 return cond_strength_reduction_cases z1 z2 with - | Ccomp c, r1 :: r2 :: nil => - cond_strength_reduction_case1 c r1 r2 - | Ccompu c, r1 :: r2 :: nil => - cond_strength_reduction_case2 c r1 r2 - | Ccompshift c s, r1 :: r2 :: nil => - cond_strength_reduction_case3 c s r1 r2 - | Ccompushift c s, r1 :: r2 :: nil => - cond_strength_reduction_case4 c s r1 r2 - | cond, args => - cond_strength_reduction_default cond args +Inductive cond_strength_reduction_cases: forall (cond: condition) (args: list reg) (vl: list approx), Type := + | cond_strength_reduction_case1: forall c r1 r2 n1 v2, cond_strength_reduction_cases (Ccomp c) (r1 :: r2 :: nil) (I n1 :: v2 :: nil) + | cond_strength_reduction_case2: forall c r1 r2 v1 n2, cond_strength_reduction_cases (Ccomp c) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | cond_strength_reduction_case3: forall c r1 r2 n1 v2, cond_strength_reduction_cases (Ccompu c) (r1 :: r2 :: nil) (I n1 :: v2 :: nil) + | cond_strength_reduction_case4: forall c r1 r2 v1 n2, cond_strength_reduction_cases (Ccompu c) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | cond_strength_reduction_case5: forall c s r1 r2 v1 n2, cond_strength_reduction_cases (Ccompshift c s) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | cond_strength_reduction_case6: forall c s r1 r2 v1 n2, cond_strength_reduction_cases (Ccompushift c s) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | cond_strength_reduction_default: forall (cond: condition) (args: list reg) (vl: list approx), cond_strength_reduction_cases cond args vl. + +Definition cond_strength_reduction_match (cond: condition) (args: list reg) (vl: list approx) := + match cond as zz1, args as zz2, vl as zz3 return cond_strength_reduction_cases zz1 zz2 zz3 with + | Ccomp c, r1 :: r2 :: nil, I n1 :: v2 :: nil => cond_strength_reduction_case1 c r1 r2 n1 v2 + | Ccomp c, r1 :: r2 :: nil, v1 :: I n2 :: nil => cond_strength_reduction_case2 c r1 r2 v1 n2 + | Ccompu c, r1 :: r2 :: nil, I n1 :: v2 :: nil => cond_strength_reduction_case3 c r1 r2 n1 v2 + | Ccompu c, r1 :: r2 :: nil, v1 :: I n2 :: nil => cond_strength_reduction_case4 c r1 r2 v1 n2 + | Ccompshift c s, r1 :: r2 :: nil, v1 :: I n2 :: nil => cond_strength_reduction_case5 c s r1 r2 v1 n2 + | Ccompushift c s, r1 :: r2 :: nil, v1 :: I n2 :: nil => cond_strength_reduction_case6 c s r1 r2 v1 n2 + | cond, args, vl => cond_strength_reduction_default cond args vl end. -Definition cond_strength_reduction (cond: condition) (args: list reg) := - match cond_strength_reduction_match cond args with - | cond_strength_reduction_case1 c r1 r2 => - match intval r1, intval r2 with - | Some n, _ => - (Ccompimm (swap_comparison c) n, r2 :: nil) - | _, Some n => - (Ccompimm c n, r1 :: nil) - | _, _ => - (cond, args) - end - | cond_strength_reduction_case2 c r1 r2 => - match intval r1, intval r2 with - | Some n, _ => - (Ccompuimm (swap_comparison c) n, r2 :: nil) - | _, Some n => - (Ccompuimm c n, r1 :: nil) - | _, _ => - (cond, args) - end - | cond_strength_reduction_case3 c s r1 r2 => - match intval r2 with - | Some n => - (Ccompimm c (eval_shift s n), r1 :: nil) - | None => - (cond, args) - end - | cond_strength_reduction_case4 c s r1 r2 => - match intval r2 with - | Some n => - (Ccompuimm c (eval_shift s n), r1 :: nil) - | None => - (cond, args) - end - | cond_strength_reduction_default cond args => +Definition cond_strength_reduction (cond: condition) (args: list reg) (vl: list approx) := + match cond_strength_reduction_match cond args vl with + | cond_strength_reduction_case1 c r1 r2 n1 v2 => (* Ccomp c, r1 :: r2 :: nil, I n1 :: v2 :: nil *) + (Ccompimm (swap_comparison c) n1, r2 :: nil) + | cond_strength_reduction_case2 c r1 r2 v1 n2 => (* Ccomp c, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + (Ccompimm c n2, r1 :: nil) + | cond_strength_reduction_case3 c r1 r2 n1 v2 => (* Ccompu c, r1 :: r2 :: nil, I n1 :: v2 :: nil *) + (Ccompuimm (swap_comparison c) n1, r2 :: nil) + | cond_strength_reduction_case4 c r1 r2 v1 n2 => (* Ccompu c, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + (Ccompuimm c n2, r1 :: nil) + | cond_strength_reduction_case5 c s r1 r2 v1 n2 => (* Ccompshift c s, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + (Ccompimm c (eval_static_shift s n2), r1 :: nil) + | cond_strength_reduction_case6 c s r1 r2 v1 n2 => (* Ccompushift c s, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + (Ccompuimm c (eval_static_shift s n2), r1 :: nil) + | cond_strength_reduction_default cond args vl => (cond, args) end. + Definition make_addimm (n: int) (r: reg) := if Int.eq n Int.zero then (Omove, r :: nil) else (Oaddimm n, r :: nil). -Definition make_shlimm (n: int) (r: reg) := +Definition make_shlimm (n: int) (r1 r2: reg) := if Int.eq n Int.zero then - (Omove, r :: nil) - else match is_shift_amount n with - | Some n' => (Oshift (Slsl n'), r :: nil) - | None => (Ointconst Int.zero, nil) (* never happens *) - end. + (Omove, r1 :: nil) + else if Int.ltu n Int.iwordsize then + (Oshift (Slsl (mk_shift_amount n)), r1 :: nil) + else + (Oshl, r1 :: r2 :: nil). -Definition make_shrimm (n: int) (r: reg) := +Definition make_shrimm (n: int) (r1 r2: reg) := if Int.eq n Int.zero then - (Omove, r :: nil) - else match is_shift_amount n with - | Some n' => (Oshift (Sasr n'), r :: nil) - | None => (Ointconst Int.zero, nil) (* never happens *) - end. + (Omove, r1 :: nil) + else if Int.ltu n Int.iwordsize then + (Oshift (Sasr (mk_shift_amount n)), r1 :: nil) + else + (Oshr, r1 :: r2 :: nil). -Definition make_shruimm (n: int) (r: reg) := +Definition make_shruimm (n: int) (r1 r2: reg) := if Int.eq n Int.zero then - (Omove, r :: nil) - else match is_shift_amount n with - | Some n' => (Oshift (Slsr n'), r :: nil) - | None => (Ointconst Int.zero, nil) (* never happens *) - end. + (Omove, r1 :: nil) + else if Int.ltu n Int.iwordsize then + (Oshift (Slsr (mk_shift_amount n)), r1 :: nil) + else + (Oshru, r1 :: r2 :: nil). -Definition make_mulimm (n: int) (r: reg) (r': reg) := +Definition make_mulimm (n: int) (r1 r2: reg) := if Int.eq n Int.zero then (Ointconst Int.zero, nil) else if Int.eq n Int.one then - (Omove, r :: nil) + (Omove, r1 :: nil) else match Int.is_power2 n with - | Some l => make_shlimm l r - | None => (Omul, r :: r' :: nil) + | Some l => (Oshift (Slsl (mk_shift_amount l)), r1 :: nil) + | None => (Omul, r1 :: r2 :: nil) end. +Definition make_divimm (n: int) (r1 r2: reg) := + match Int.is_power2 n with + | Some l => if Int.ltu l (Int.repr 31) + then (Oshrximm l, r1 :: nil) + else (Odiv, r1 :: r2 :: nil) + | None => (Odiv, r1 :: r2 :: nil) + end. + +Definition make_divuimm (n: int) (r1 r2: reg) := + match Int.is_power2 n with + | Some l => (Oshift (Slsr (mk_shift_amount l)), r1 :: nil) + | None => (Odivu, r1 :: r2 :: nil) + end. + Definition make_andimm (n: int) (r: reg) := - if Int.eq n Int.zero - then (Ointconst Int.zero, nil) + if Int.eq n Int.zero then (Ointconst Int.zero, nil) else if Int.eq n Int.mone then (Omove, r :: nil) else (Oandimm n, r :: nil). @@ -738,302 +572,229 @@ Definition make_xorimm (n: int) (r: reg) := else if Int.eq n Int.mone then (Onot, r :: nil) else (Oxorimm n, r :: nil). -(* -Definition op_strength_reduction (op: operation) (args: list reg) := - match op, args with - | Oadd, r1 :: r2 :: nil => - | Oaddshift s, r1 :: r2 :: nil => - | Osub, r1 :: r2 :: nil => - | Osubshift s, r1 :: r2 :: nil => - | Orsubshift s, r1 :: r2 :: nil => - | Omul, r1 :: r2 :: nil => - | Odivu, r1 :: r2 :: nil => - | Oand, r1 :: r2 :: nil => - | Oandshift s, r1 :: r2 :: nil => - | Oor, r1 :: r2 :: nil => - | Oorshift s, r1 :: r2 :: nil => - | Oxor, r1 :: r2 :: nil => - | Oxorshift s, r1 :: r2 :: nil => - | Obic, r1 :: r2 :: nil => - | Obicshift s, r1 :: r2 :: nil => - | Oshl, r1 :: r2 :: nil => - | Oshr, r1 :: r2 :: nil => - | Oshru, r1 :: r2 :: nil => - | Ocmp c, rl => - | _, _ => +(** Original definition: +<< +Nondetfunction op_strength_reduction + (op: operation) (args: list reg) (vl: list approx) := + match op, args, vl with + | Oadd, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_addimm n1 r2 + | Oadd, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm n2 r1 + | Oaddshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm (eval_static_shift s n2) r1 + | Osub, r1 :: r2 :: nil, I n1 :: v2 :: nil => (Orsubimm n1, r2 :: nil) + | Osub, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm (Int.neg n2) r1 + | Osubshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_addimm (Int.neg (eval_static_shift s n2)) r1 + | Orsubshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => (Orsubimm (eval_static_shift s n2), r1 :: nil) + | Omul, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_mulimm n1 r2 r1 + | Omul, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_mulimm n2 r1 r2 + | Odiv, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_divimm n2 r1 r2 + | Odivu, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_divuimm n2 r1 r2 + | Oand, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_andimm n1 r2 + | Oand, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm n2 r1 + | Oandshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm (eval_static_shift s n2) r1 + | Oor, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_orimm n1 r2 + | Oor, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_orimm n2 r1 + | Oorshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_orimm (eval_static_shift s n2) r1 + | Oxor, r1 :: r2 :: nil, I n1 :: v2 :: nil => make_xorimm n1 r2 + | Oxor, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_xorimm n2 r1 + | Oxorshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_xorimm (eval_static_shift s n2) r1 + | Obic, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm (Int.not n2) r1 + | Obicshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_andimm (Int.not (eval_static_shift s n2)) r1 + | Oshl, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shlimm n2 r1 r2 + | Oshr, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shrimm n2 r1 r2 + | Oshru, r1 :: r2 :: nil, v1 :: I n2 :: nil => make_shruimm n2 r1 r2 + | Ocmp c, args, vl => + let (c', args') := cond_strength_reduction c args vl in (Ocmp c', args') + | _, _, _ => (op, args) end. +>> *) -Inductive op_strength_reduction_cases: forall (op: operation) (args: list reg), Type := - | op_strength_reduction_case1: - forall r1 r2, - op_strength_reduction_cases (Oadd) (r1 :: r2 :: nil) - | op_strength_reduction_case2: - forall s r1 r2, - op_strength_reduction_cases (Oaddshift s) (r1 :: r2 :: nil) - | op_strength_reduction_case3: - forall r1 r2, - op_strength_reduction_cases (Osub) (r1 :: r2 :: nil) - | op_strength_reduction_case4: - forall s r1 r2, - op_strength_reduction_cases (Osubshift s) (r1 :: r2 :: nil) - | op_strength_reduction_case5: - forall s r1 r2, - op_strength_reduction_cases (Orsubshift s) (r1 :: r2 :: nil) - | op_strength_reduction_case6: - forall r1 r2, - op_strength_reduction_cases (Omul) (r1 :: r2 :: nil) - | op_strength_reduction_case7: - forall r1 r2, - op_strength_reduction_cases (Odivu) (r1 :: r2 :: nil) - | op_strength_reduction_case8: - forall r1 r2, - op_strength_reduction_cases (Oand) (r1 :: r2 :: nil) - | op_strength_reduction_case9: - forall s r1 r2, - op_strength_reduction_cases (Oandshift s) (r1 :: r2 :: nil) - | op_strength_reduction_case10: - forall r1 r2, - op_strength_reduction_cases (Oor) (r1 :: r2 :: nil) - | op_strength_reduction_case11: - forall s r1 r2, - op_strength_reduction_cases (Oorshift s) (r1 :: r2 :: nil) - | op_strength_reduction_case12: - forall r1 r2, - op_strength_reduction_cases (Oxor) (r1 :: r2 :: nil) - | op_strength_reduction_case13: - forall s r1 r2, - op_strength_reduction_cases (Oxorshift s) (r1 :: r2 :: nil) - | op_strength_reduction_case14: - forall r1 r2, - op_strength_reduction_cases (Obic) (r1 :: r2 :: nil) - | op_strength_reduction_case15: - forall s r1 r2, - op_strength_reduction_cases (Obicshift s) (r1 :: r2 :: nil) - | op_strength_reduction_case16: - forall r1 r2, - op_strength_reduction_cases (Oshl) (r1 :: r2 :: nil) - | op_strength_reduction_case17: - forall r1 r2, - op_strength_reduction_cases (Oshr) (r1 :: r2 :: nil) - | op_strength_reduction_case18: - forall r1 r2, - op_strength_reduction_cases (Oshru) (r1 :: r2 :: nil) - | op_strength_reduction_case19: - forall c rl, - op_strength_reduction_cases (Ocmp c) rl - | op_strength_reduction_default: - forall (op: operation) (args: list reg), - op_strength_reduction_cases op args. - -Definition op_strength_reduction_match (op: operation) (args: list reg) := - match op as z1, args as z2 return op_strength_reduction_cases z1 z2 with - | Oadd, r1 :: r2 :: nil => - op_strength_reduction_case1 r1 r2 - | Oaddshift s, r1 :: r2 :: nil => - op_strength_reduction_case2 s r1 r2 - | Osub, r1 :: r2 :: nil => - op_strength_reduction_case3 r1 r2 - | Osubshift s, r1 :: r2 :: nil => - op_strength_reduction_case4 s r1 r2 - | Orsubshift s, r1 :: r2 :: nil => - op_strength_reduction_case5 s r1 r2 - | Omul, r1 :: r2 :: nil => - op_strength_reduction_case6 r1 r2 - | Odivu, r1 :: r2 :: nil => - op_strength_reduction_case7 r1 r2 - | Oand, r1 :: r2 :: nil => - op_strength_reduction_case8 r1 r2 - | Oandshift s, r1 :: r2 :: nil => - op_strength_reduction_case9 s r1 r2 - | Oor, r1 :: r2 :: nil => - op_strength_reduction_case10 r1 r2 - | Oorshift s, r1 :: r2 :: nil => - op_strength_reduction_case11 s r1 r2 - | Oxor, r1 :: r2 :: nil => - op_strength_reduction_case12 r1 r2 - | Oxorshift s, r1 :: r2 :: nil => - op_strength_reduction_case13 s r1 r2 - | Obic, r1 :: r2 :: nil => - op_strength_reduction_case14 r1 r2 - | Obicshift s, r1 :: r2 :: nil => - op_strength_reduction_case15 s r1 r2 - | Oshl, r1 :: r2 :: nil => - op_strength_reduction_case16 r1 r2 - | Oshr, r1 :: r2 :: nil => - op_strength_reduction_case17 r1 r2 - | Oshru, r1 :: r2 :: nil => - op_strength_reduction_case18 r1 r2 - | Ocmp c, rl => - op_strength_reduction_case19 c rl - | op, args => - op_strength_reduction_default op args +Inductive op_strength_reduction_cases: forall (op: operation) (args: list reg) (vl: list approx), Type := + | op_strength_reduction_case1: forall r1 r2 n1 v2, op_strength_reduction_cases (Oadd) (r1 :: r2 :: nil) (I n1 :: v2 :: nil) + | op_strength_reduction_case2: forall r1 r2 v1 n2, op_strength_reduction_cases (Oadd) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case3: forall s r1 r2 v1 n2, op_strength_reduction_cases (Oaddshift s) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case4: forall r1 r2 n1 v2, op_strength_reduction_cases (Osub) (r1 :: r2 :: nil) (I n1 :: v2 :: nil) + | op_strength_reduction_case5: forall r1 r2 v1 n2, op_strength_reduction_cases (Osub) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case6: forall s r1 r2 v1 n2, op_strength_reduction_cases (Osubshift s) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case7: forall s r1 r2 v1 n2, op_strength_reduction_cases (Orsubshift s) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case8: forall r1 r2 n1 v2, op_strength_reduction_cases (Omul) (r1 :: r2 :: nil) (I n1 :: v2 :: nil) + | op_strength_reduction_case9: forall r1 r2 v1 n2, op_strength_reduction_cases (Omul) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case10: forall r1 r2 v1 n2, op_strength_reduction_cases (Odiv) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case11: forall r1 r2 v1 n2, op_strength_reduction_cases (Odivu) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case12: forall r1 r2 n1 v2, op_strength_reduction_cases (Oand) (r1 :: r2 :: nil) (I n1 :: v2 :: nil) + | op_strength_reduction_case13: forall r1 r2 v1 n2, op_strength_reduction_cases (Oand) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case14: forall s r1 r2 v1 n2, op_strength_reduction_cases (Oandshift s) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case15: forall r1 r2 n1 v2, op_strength_reduction_cases (Oor) (r1 :: r2 :: nil) (I n1 :: v2 :: nil) + | op_strength_reduction_case16: forall r1 r2 v1 n2, op_strength_reduction_cases (Oor) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case17: forall s r1 r2 v1 n2, op_strength_reduction_cases (Oorshift s) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case18: forall r1 r2 n1 v2, op_strength_reduction_cases (Oxor) (r1 :: r2 :: nil) (I n1 :: v2 :: nil) + | op_strength_reduction_case19: forall r1 r2 v1 n2, op_strength_reduction_cases (Oxor) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case20: forall s r1 r2 v1 n2, op_strength_reduction_cases (Oxorshift s) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case21: forall r1 r2 v1 n2, op_strength_reduction_cases (Obic) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case22: forall s r1 r2 v1 n2, op_strength_reduction_cases (Obicshift s) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case23: forall r1 r2 v1 n2, op_strength_reduction_cases (Oshl) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case24: forall r1 r2 v1 n2, op_strength_reduction_cases (Oshr) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case25: forall r1 r2 v1 n2, op_strength_reduction_cases (Oshru) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | op_strength_reduction_case26: forall c args vl, op_strength_reduction_cases (Ocmp c) (args) (vl) + | op_strength_reduction_default: forall (op: operation) (args: list reg) (vl: list approx), op_strength_reduction_cases op args vl. + +Definition op_strength_reduction_match (op: operation) (args: list reg) (vl: list approx) := + match op as zz1, args as zz2, vl as zz3 return op_strength_reduction_cases zz1 zz2 zz3 with + | Oadd, r1 :: r2 :: nil, I n1 :: v2 :: nil => op_strength_reduction_case1 r1 r2 n1 v2 + | Oadd, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case2 r1 r2 v1 n2 + | Oaddshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case3 s r1 r2 v1 n2 + | Osub, r1 :: r2 :: nil, I n1 :: v2 :: nil => op_strength_reduction_case4 r1 r2 n1 v2 + | Osub, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case5 r1 r2 v1 n2 + | Osubshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case6 s r1 r2 v1 n2 + | Orsubshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case7 s r1 r2 v1 n2 + | Omul, r1 :: r2 :: nil, I n1 :: v2 :: nil => op_strength_reduction_case8 r1 r2 n1 v2 + | Omul, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case9 r1 r2 v1 n2 + | Odiv, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case10 r1 r2 v1 n2 + | Odivu, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case11 r1 r2 v1 n2 + | Oand, r1 :: r2 :: nil, I n1 :: v2 :: nil => op_strength_reduction_case12 r1 r2 n1 v2 + | Oand, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case13 r1 r2 v1 n2 + | Oandshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case14 s r1 r2 v1 n2 + | Oor, r1 :: r2 :: nil, I n1 :: v2 :: nil => op_strength_reduction_case15 r1 r2 n1 v2 + | Oor, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case16 r1 r2 v1 n2 + | Oorshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case17 s r1 r2 v1 n2 + | Oxor, r1 :: r2 :: nil, I n1 :: v2 :: nil => op_strength_reduction_case18 r1 r2 n1 v2 + | Oxor, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case19 r1 r2 v1 n2 + | Oxorshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case20 s r1 r2 v1 n2 + | Obic, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case21 r1 r2 v1 n2 + | Obicshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case22 s r1 r2 v1 n2 + | Oshl, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case23 r1 r2 v1 n2 + | Oshr, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case24 r1 r2 v1 n2 + | Oshru, r1 :: r2 :: nil, v1 :: I n2 :: nil => op_strength_reduction_case25 r1 r2 v1 n2 + | Ocmp c, args, vl => op_strength_reduction_case26 c args vl + | op, args, vl => op_strength_reduction_default op args vl end. -Definition op_strength_reduction (op: operation) (args: list reg) := - match op_strength_reduction_match op args with - | op_strength_reduction_case1 r1 r2 => (* Oadd *) - match intval r1, intval r2 with - | Some n, _ => make_addimm n r2 - | _, Some n => make_addimm n r1 - | _, _ => (op, args) - end - | op_strength_reduction_case2 s r1 r2 => (* Oaddshift *) - match intval r2 with - | Some n => make_addimm (eval_shift s n) r1 - | _ => (op, args) - end - | op_strength_reduction_case3 r1 r2 => (* Osub *) - match intval r1, intval r2 with - | Some n, _ => (Orsubimm n, r2 :: nil) - | _, Some n => make_addimm (Int.neg n) r1 - | _, _ => (op, args) - end - | op_strength_reduction_case4 s r1 r2 => (* Osubshift *) - match intval r2 with - | Some n => make_addimm (Int.neg (eval_shift s n)) r1 - | _ => (op, args) - end - | op_strength_reduction_case5 s r1 r2 => (* Orsubshift *) - match intval r2 with - | Some n => (Orsubimm (eval_shift s n), r1 :: nil) - | _ => (op, args) - end - | op_strength_reduction_case6 r1 r2 => (* Omul *) - match intval r1, intval r2 with - | Some n, _ => make_mulimm n r2 r1 - | _, Some n => make_mulimm n r1 r2 - | _, _ => (op, args) - end - | op_strength_reduction_case7 r1 r2 => (* Odivu *) - match intval r2 with - | Some n => - match Int.is_power2 n with - | Some l => make_shruimm l r1 - | None => (op, args) - end - | None => - (op, args) - end - | op_strength_reduction_case8 r1 r2 => (* Oand *) - match intval r1, intval r2 with - | Some n, _ => make_andimm n r2 - | _, Some n => make_andimm n r1 - | _, _ => (op, args) - end - | op_strength_reduction_case9 s r1 r2 => (* Oandshift *) - match intval r2 with - | Some n => make_andimm (eval_shift s n) r1 - | _ => (op, args) - end - | op_strength_reduction_case10 r1 r2 => (* Oor *) - match intval r1, intval r2 with - | Some n, _ => make_orimm n r2 - | _, Some n => make_orimm n r1 - | _, _ => (op, args) - end - | op_strength_reduction_case11 s r1 r2 => (* Oorshift *) - match intval r2 with - | Some n => make_orimm (eval_shift s n) r1 - | _ => (op, args) - end - | op_strength_reduction_case12 r1 r2 => (* Oxor *) - match intval r1, intval r2 with - | Some n, _ => make_xorimm n r2 - | _, Some n => make_xorimm n r1 - | _, _ => (op, args) - end - | op_strength_reduction_case13 s r1 r2 => (* Oxorshift *) - match intval r2 with - | Some n => make_xorimm (eval_shift s n) r1 - | _ => (op, args) - end - | op_strength_reduction_case14 r1 r2 => (* Obic *) - match intval r2 with - | Some n => make_andimm (Int.not n) r1 - | _ => (op, args) - end - | op_strength_reduction_case15 s r1 r2 => (* Obicshift *) - match intval r2 with - | Some n => make_andimm (Int.not (eval_shift s n)) r1 - | _ => (op, args) - end - | op_strength_reduction_case16 r1 r2 => (* Oshl *) - match intval r2 with - | Some n => - if Int.ltu n Int.iwordsize - then make_shlimm n r1 - else (op, args) - | _ => (op, args) - end - | op_strength_reduction_case17 r1 r2 => (* Oshr *) - match intval r2 with - | Some n => - if Int.ltu n Int.iwordsize - then make_shrimm n r1 - else (op, args) - | _ => (op, args) - end - | op_strength_reduction_case18 r1 r2 => (* Oshru *) - match intval r2 with - | Some n => - if Int.ltu n Int.iwordsize - then make_shruimm n r1 - else (op, args) - | _ => (op, args) - end - | op_strength_reduction_case19 c rl => (* Ocmp *) - let (c', args') := cond_strength_reduction c args in - (Ocmp c', args') - | op_strength_reduction_default op args => (* default *) +Definition op_strength_reduction (op: operation) (args: list reg) (vl: list approx) := + match op_strength_reduction_match op args vl with + | op_strength_reduction_case1 r1 r2 n1 v2 => (* Oadd, r1 :: r2 :: nil, I n1 :: v2 :: nil *) + make_addimm n1 r2 + | op_strength_reduction_case2 r1 r2 v1 n2 => (* Oadd, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_addimm n2 r1 + | op_strength_reduction_case3 s r1 r2 v1 n2 => (* Oaddshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_addimm (eval_static_shift s n2) r1 + | op_strength_reduction_case4 r1 r2 n1 v2 => (* Osub, r1 :: r2 :: nil, I n1 :: v2 :: nil *) + (Orsubimm n1, r2 :: nil) + | op_strength_reduction_case5 r1 r2 v1 n2 => (* Osub, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_addimm (Int.neg n2) r1 + | op_strength_reduction_case6 s r1 r2 v1 n2 => (* Osubshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_addimm (Int.neg (eval_static_shift s n2)) r1 + | op_strength_reduction_case7 s r1 r2 v1 n2 => (* Orsubshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + (Orsubimm (eval_static_shift s n2), r1 :: nil) + | op_strength_reduction_case8 r1 r2 n1 v2 => (* Omul, r1 :: r2 :: nil, I n1 :: v2 :: nil *) + make_mulimm n1 r2 r1 + | op_strength_reduction_case9 r1 r2 v1 n2 => (* Omul, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_mulimm n2 r1 r2 + | op_strength_reduction_case10 r1 r2 v1 n2 => (* Odiv, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_divimm n2 r1 r2 + | op_strength_reduction_case11 r1 r2 v1 n2 => (* Odivu, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_divuimm n2 r1 r2 + | op_strength_reduction_case12 r1 r2 n1 v2 => (* Oand, r1 :: r2 :: nil, I n1 :: v2 :: nil *) + make_andimm n1 r2 + | op_strength_reduction_case13 r1 r2 v1 n2 => (* Oand, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_andimm n2 r1 + | op_strength_reduction_case14 s r1 r2 v1 n2 => (* Oandshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_andimm (eval_static_shift s n2) r1 + | op_strength_reduction_case15 r1 r2 n1 v2 => (* Oor, r1 :: r2 :: nil, I n1 :: v2 :: nil *) + make_orimm n1 r2 + | op_strength_reduction_case16 r1 r2 v1 n2 => (* Oor, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_orimm n2 r1 + | op_strength_reduction_case17 s r1 r2 v1 n2 => (* Oorshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_orimm (eval_static_shift s n2) r1 + | op_strength_reduction_case18 r1 r2 n1 v2 => (* Oxor, r1 :: r2 :: nil, I n1 :: v2 :: nil *) + make_xorimm n1 r2 + | op_strength_reduction_case19 r1 r2 v1 n2 => (* Oxor, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_xorimm n2 r1 + | op_strength_reduction_case20 s r1 r2 v1 n2 => (* Oxorshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_xorimm (eval_static_shift s n2) r1 + | op_strength_reduction_case21 r1 r2 v1 n2 => (* Obic, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_andimm (Int.not n2) r1 + | op_strength_reduction_case22 s r1 r2 v1 n2 => (* Obicshift s, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_andimm (Int.not (eval_static_shift s n2)) r1 + | op_strength_reduction_case23 r1 r2 v1 n2 => (* Oshl, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_shlimm n2 r1 r2 + | op_strength_reduction_case24 r1 r2 v1 n2 => (* Oshr, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_shrimm n2 r1 r2 + | op_strength_reduction_case25 r1 r2 v1 n2 => (* Oshru, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + make_shruimm n2 r1 r2 + | op_strength_reduction_case26 c args vl => (* Ocmp c, args, vl *) + let (c', args') := cond_strength_reduction c args vl in (Ocmp c', args') + | op_strength_reduction_default op args vl => (op, args) end. -(* -Definition addr_strength_reduction (addr: addressing) (args: list reg) := - match addr, args with - | Aindexed2, r1 :: r2 :: nil => - | Aindexed2shift s, r1 :: r2 :: nil => - | _, _ => + + +(** Original definition: +<< +Nondetfunction addr_strength_reduction + (addr: addressing) (args: list reg) (vl: list approx) := + match addr, args, vl with + | Aindexed2, r1 :: r2 :: nil, S n1 :: I n2 :: nil => + (Ainstack (Int.add n1 n2), nil) + | Aindexed2, r1 :: r2 :: nil, I n1 :: S n2 :: nil => + (Ainstack (Int.add n1 n2), nil) + | Aindexed2, r1 :: r2 :: nil, I n1 :: v2 :: nil => + (Aindexed n1, r2 :: nil) + | Aindexed2, r1 :: r2 :: nil, v1 :: I n2 :: nil => + (Aindexed n2, r1 :: nil) + | Aindexed2shift s, r1 :: r2 :: nil, S n1 :: I n2 :: nil => + (Ainstack (Int.add n1 (eval_static_shift s n2)), nil) + | Aindexed2shift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => + (Aindexed (eval_static_shift s n2), r1 :: nil) + | Aindexed n, r1 :: nil, S n1 :: nil => + (Ainstack (Int.add n1 n), nil) + | _, _, _ => + (addr, args) end. +>> *) -Inductive addr_strength_reduction_cases: forall (addr: addressing) (args: list reg), Type := - | addr_strength_reduction_case1: - forall r1 r2, - addr_strength_reduction_cases (Aindexed2) (r1 :: r2 :: nil) - | addr_strength_reduction_case2: - forall s r1 r2, - addr_strength_reduction_cases (Aindexed2shift s) (r1 :: r2 :: nil) - | addr_strength_reduction_default: - forall (addr: addressing) (args: list reg), - addr_strength_reduction_cases addr args. - -Definition addr_strength_reduction_match (addr: addressing) (args: list reg) := - match addr as z1, args as z2 return addr_strength_reduction_cases z1 z2 with - | Aindexed2, r1 :: r2 :: nil => - addr_strength_reduction_case1 r1 r2 - | Aindexed2shift s, r1 :: r2 :: nil => - addr_strength_reduction_case2 s r1 r2 - | addr, args => - addr_strength_reduction_default addr args +Inductive addr_strength_reduction_cases: forall (addr: addressing) (args: list reg) (vl: list approx), Type := + | addr_strength_reduction_case1: forall r1 r2 n1 n2, addr_strength_reduction_cases (Aindexed2) (r1 :: r2 :: nil) (S n1 :: I n2 :: nil) + | addr_strength_reduction_case2: forall r1 r2 n1 n2, addr_strength_reduction_cases (Aindexed2) (r1 :: r2 :: nil) (I n1 :: S n2 :: nil) + | addr_strength_reduction_case3: forall r1 r2 n1 v2, addr_strength_reduction_cases (Aindexed2) (r1 :: r2 :: nil) (I n1 :: v2 :: nil) + | addr_strength_reduction_case4: forall r1 r2 v1 n2, addr_strength_reduction_cases (Aindexed2) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | addr_strength_reduction_case5: forall s r1 r2 n1 n2, addr_strength_reduction_cases (Aindexed2shift s) (r1 :: r2 :: nil) (S n1 :: I n2 :: nil) + | addr_strength_reduction_case6: forall s r1 r2 v1 n2, addr_strength_reduction_cases (Aindexed2shift s) (r1 :: r2 :: nil) (v1 :: I n2 :: nil) + | addr_strength_reduction_case7: forall n r1 n1, addr_strength_reduction_cases (Aindexed n) (r1 :: nil) (S n1 :: nil) + | addr_strength_reduction_default: forall (addr: addressing) (args: list reg) (vl: list approx), addr_strength_reduction_cases addr args vl. + +Definition addr_strength_reduction_match (addr: addressing) (args: list reg) (vl: list approx) := + match addr as zz1, args as zz2, vl as zz3 return addr_strength_reduction_cases zz1 zz2 zz3 with + | Aindexed2, r1 :: r2 :: nil, S n1 :: I n2 :: nil => addr_strength_reduction_case1 r1 r2 n1 n2 + | Aindexed2, r1 :: r2 :: nil, I n1 :: S n2 :: nil => addr_strength_reduction_case2 r1 r2 n1 n2 + | Aindexed2, r1 :: r2 :: nil, I n1 :: v2 :: nil => addr_strength_reduction_case3 r1 r2 n1 v2 + | Aindexed2, r1 :: r2 :: nil, v1 :: I n2 :: nil => addr_strength_reduction_case4 r1 r2 v1 n2 + | Aindexed2shift s, r1 :: r2 :: nil, S n1 :: I n2 :: nil => addr_strength_reduction_case5 s r1 r2 n1 n2 + | Aindexed2shift s, r1 :: r2 :: nil, v1 :: I n2 :: nil => addr_strength_reduction_case6 s r1 r2 v1 n2 + | Aindexed n, r1 :: nil, S n1 :: nil => addr_strength_reduction_case7 n r1 n1 + | addr, args, vl => addr_strength_reduction_default addr args vl end. -Definition addr_strength_reduction (addr: addressing) (args: list reg) := - match addr_strength_reduction_match addr args with - | addr_strength_reduction_case1 r1 r2 => (* Aindexed2 *) - match intval r1, intval r2 with - | Some n1, _ => (Aindexed n1, r2 :: nil) - | _, Some n2 => (Aindexed n2, r1 :: nil) - | _, _ => (addr, args) - end - | addr_strength_reduction_case2 s r1 r2 => (* Aindexed2shift *) - match intval r2 with - | Some n2 => (Aindexed (eval_shift s n2), r1 :: nil) - | _ => (addr, args) - end - | addr_strength_reduction_default addr args => - (addr, args) +Definition addr_strength_reduction (addr: addressing) (args: list reg) (vl: list approx) := + match addr_strength_reduction_match addr args vl with + | addr_strength_reduction_case1 r1 r2 n1 n2 => (* Aindexed2, r1 :: r2 :: nil, S n1 :: I n2 :: nil *) + (Ainstack (Int.add n1 n2), nil) + | addr_strength_reduction_case2 r1 r2 n1 n2 => (* Aindexed2, r1 :: r2 :: nil, I n1 :: S n2 :: nil *) + (Ainstack (Int.add n1 n2), nil) + | addr_strength_reduction_case3 r1 r2 n1 v2 => (* Aindexed2, r1 :: r2 :: nil, I n1 :: v2 :: nil *) + (Aindexed n1, r2 :: nil) + | addr_strength_reduction_case4 r1 r2 v1 n2 => (* Aindexed2, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + (Aindexed n2, r1 :: nil) + | addr_strength_reduction_case5 s r1 r2 n1 n2 => (* Aindexed2shift s, r1 :: r2 :: nil, S n1 :: I n2 :: nil *) + (Ainstack (Int.add n1 (eval_static_shift s n2)), nil) + | addr_strength_reduction_case6 s r1 r2 v1 n2 => (* Aindexed2shift s, r1 :: r2 :: nil, v1 :: I n2 :: nil *) + (Aindexed (eval_static_shift s n2), r1 :: nil) + | addr_strength_reduction_case7 n r1 n1 => (* Aindexed n, r1 :: nil, S n1 :: nil *) + (Ainstack (Int.add n1 n), nil) + | addr_strength_reduction_default addr args vl => + (addr, args) end. + End STRENGTH_REDUCTION. diff --git a/arm/ConstpropOpproof.v b/arm/ConstpropOpproof.v index 4d430822..0e60796a 100644 --- a/arm/ConstpropOpproof.v +++ b/arm/ConstpropOpproof.v @@ -30,6 +30,7 @@ Require Import Constprop. Section ANALYSIS. Variable ge: genv. +Variable sp: val. (** We first show that the dataflow analysis is correct with respect to the dynamic semantics: the approximations (sets of values) @@ -43,7 +44,8 @@ Definition val_match_approx (a: approx) (v: val) : Prop := | Unknown => True | I p => v = Vint p | F p => v = Vfloat p - | S symb ofs => exists b, Genv.find_symbol ge symb = Some b /\ v = Vptr b ofs + | G symb ofs => v = symbol_address ge symb ofs + | S ofs => v = Val.add sp (Vint ofs) | _ => False end. @@ -62,12 +64,10 @@ Ltac SimplVMA := simpl in H; (try subst v); SimplVMA | H: (val_match_approx (F _) ?v) |- _ => simpl in H; (try subst v); SimplVMA - | H: (val_match_approx (S _ _) ?v) |- _ => - simpl in H; - (try (elim H; - let b := fresh "b" in let A := fresh in let B := fresh in - (intros b [A B]; subst v; clear H))); - SimplVMA + | H: (val_match_approx (G _ _) ?v) |- _ => + simpl in H; (try subst v); SimplVMA + | H: (val_match_approx (S _) ?v) |- _ => + simpl in H; (try subst v); SimplVMA | _ => idtac end. @@ -75,9 +75,9 @@ Ltac SimplVMA := Ltac InvVLMA := match goal with | H: (val_list_match_approx nil ?vl) |- _ => - inversion H + inv H | H: (val_list_match_approx (?a :: ?al) ?vl) |- _ => - inversion H; SimplVMA; InvVLMA + inv H; SimplVMA; InvVLMA | _ => idtac end. @@ -87,6 +87,12 @@ Ltac InvVLMA := the given approximations, the concrete results match the approximations returned by [eval_static_operation]. *) +Lemma eval_static_shift_correct: + forall s n, eval_shift s (Vint n) = Vint (eval_static_shift s n). +Proof. + intros. destruct s; simpl; rewrite s_range; auto. +Qed. + Lemma eval_static_condition_correct: forall cond al vl m b, val_list_match_approx al vl -> @@ -96,11 +102,19 @@ Proof. intros until b. unfold eval_static_condition. case (eval_static_condition_match cond al); intros; - InvVLMA; simpl; congruence. + InvVLMA; simpl; try (rewrite eval_static_shift_correct); congruence. Qed. +Remark shift_symbol_address: + forall symb ofs n, + symbol_address ge symb (Int.add ofs n) = Val.add (symbol_address ge symb ofs) (Vint n). +Proof. + unfold symbol_address; intros. destruct (Genv.find_symbol ge symb); auto. +Qed. + + Lemma eval_static_operation_correct: - forall op sp al vl m v, + forall op al vl m v, val_list_match_approx al vl -> eval_operation ge sp op vl m = Some v -> val_match_approx (eval_static_operation op al) v. @@ -108,53 +122,34 @@ Proof. intros until v. unfold eval_static_operation. case (eval_static_operation_match op al); intros; - InvVLMA; simpl in *; FuncInv; try congruence. - - destruct (Genv.find_symbol ge s). exists b. intuition congruence. - congruence. - - rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence. - rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence. - rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence. - rewrite <- H3. replace v0 with (Vint n1). reflexivity. congruence. - - exists b. split. auto. congruence. - exists b. split. auto. congruence. - exists b. split. auto. congruence. - exists b. split. auto. congruence. - exists b. split. auto. congruence. - - replace n2 with i0. destruct (Int.eq i0 Int.zero). - discriminate. injection H0; intro; subst v. simpl. congruence. congruence. - - replace n2 with i0. destruct (Int.eq i0 Int.zero). - discriminate. injection H0; intro; subst v. simpl. congruence. congruence. - - replace n2 with i0. destruct (Int.ltu i0 Int.iwordsize). - injection H0; intro; subst v. simpl. congruence. discriminate. congruence. - - replace n2 with i0. destruct (Int.ltu i0 Int.iwordsize). - injection H0; intro; subst v. simpl. congruence. discriminate. congruence. - - replace n2 with i0. destruct (Int.ltu i0 Int.iwordsize). - injection H0; intro; subst v. simpl. congruence. discriminate. congruence. - - rewrite <- H3. replace v0 with (Vfloat n1). reflexivity. congruence. - - inv H4. destruct (Float.intoffloat f); simpl in H0; inv H0. red; auto. - - inv H4. destruct (Float.intuoffloat f); simpl in H0; inv H0. red; auto. - - caseEq (eval_static_condition c vl0). - intros. generalize (eval_static_condition_correct _ _ _ m _ H H1). - intro. rewrite H2 in H0. - destruct b; injection H0; intro; subst v; simpl; auto. - intros; simpl; auto. - - replace n1 with i. destruct (Int.ltu n (Int.repr 31)). - injection H0; intro; subst v. simpl. auto. congruence. congruence. - - auto. + InvVLMA; simpl in *; FuncInv; try (subst v); try (rewrite eval_static_shift_correct); auto. + + rewrite shift_symbol_address; auto. + rewrite shift_symbol_address; auto. + rewrite Val.add_assoc; auto. + rewrite Val.add_assoc; auto. + fold (Val.add (Vint n1) (symbol_address ge s2 n2)). + rewrite Int.add_commut. rewrite Val.add_commut. rewrite shift_symbol_address; auto. + fold (Val.add (Vint n1) (Val.add sp (Vint n2))). + rewrite Val.add_permut. auto. + rewrite shift_symbol_address. auto. + rewrite Val.add_assoc. auto. + rewrite Int.sub_add_opp. rewrite shift_symbol_address. rewrite Val.sub_add_opp. auto. + rewrite Val.sub_add_opp. rewrite Val.add_assoc. rewrite Int.sub_add_opp. auto. + rewrite Int.sub_add_opp. rewrite shift_symbol_address. rewrite Val.sub_add_opp. auto. + destruct (Int.eq n2 Int.zero); inv H0. simpl; auto. + destruct (Int.eq n2 Int.zero); inv H0. simpl; auto. + destruct (Int.ltu n2 Int.iwordsize); simpl; auto. + destruct (Int.ltu n2 Int.iwordsize); simpl; auto. + destruct (Int.ltu n2 Int.iwordsize); simpl; auto. + unfold eval_static_intoffloat. destruct (Float.intoffloat n1); simpl in H0; inv H0; simpl; auto. + unfold eval_static_intuoffloat. destruct (Float.intuoffloat n1); simpl in H0; inv H0; simpl; auto. + + unfold eval_static_condition_val, Val.of_optbool. + destruct (eval_static_condition c vl0) as []_eqn. + rewrite (eval_static_condition_correct _ _ _ m _ H Heqo). + destruct b; simpl; auto. + simpl; auto. Qed. (** * Correctness of strength reduction *) @@ -167,367 +162,259 @@ Qed. Section STRENGTH_REDUCTION. -Variable app: reg -> approx. -Variable sp: val. +Variable app: D.t. Variable rs: regset. Variable m: mem. -Hypothesis MATCH: forall r, val_match_approx (app r) rs#r. +Hypothesis MATCH: forall r, val_match_approx (approx_reg app r) rs#r. -Lemma intval_correct: - forall r n, - intval app r = Some n -> rs#r = Vint n. -Proof. - intros until n. - unfold intval. caseEq (app r); intros; try discriminate. - generalize (MATCH r). unfold val_match_approx. rewrite H. - congruence. -Qed. +Ltac InvApproxRegs := + match goal with + | [ H: _ :: _ = _ :: _ |- _ ] => + injection H; clear H; intros; InvApproxRegs + | [ H: ?v = approx_reg app ?r |- _ ] => + generalize (MATCH r); rewrite <- H; clear H; intro; InvApproxRegs + | _ => idtac + end. Lemma cond_strength_reduction_correct: - forall cond args, - let (cond', args') := cond_strength_reduction app cond args in + forall cond args vl, + vl = approx_regs app args -> + let (cond', args') := cond_strength_reduction cond args vl in eval_condition cond' rs##args' m = eval_condition cond rs##args m. Proof. - intros. unfold cond_strength_reduction. - case (cond_strength_reduction_match cond args); intros. - - caseEq (intval app r1); intros. - simpl. rewrite (intval_correct _ _ H). - destruct (rs#r2); auto. rewrite Int.swap_cmp. auto. - caseEq (intval app r2); intros. - simpl. rewrite (intval_correct _ _ H0). auto. - auto. - - caseEq (intval app r1); intros. - simpl. rewrite (intval_correct _ _ H). - destruct (rs#r2); auto. rewrite Int.swap_cmpu. auto. - destruct c; reflexivity. - caseEq (intval app r2); intros. - simpl. rewrite (intval_correct _ _ H0). auto. - auto. - - caseEq (intval app r2); intros. - simpl. rewrite (intval_correct _ _ H). auto. - auto. - - caseEq (intval app r2); intros. - simpl. rewrite (intval_correct _ _ H). auto. - auto. - + intros until vl. unfold cond_strength_reduction. + case (cond_strength_reduction_match cond args vl); simpl; intros; InvApproxRegs; SimplVMA. + rewrite H0. apply Val.swap_cmp_bool. + rewrite H. auto. + rewrite H0. apply Val.swap_cmpu_bool. + rewrite H. auto. + rewrite H. rewrite eval_static_shift_correct. auto. + rewrite H. rewrite eval_static_shift_correct. auto. auto. Qed. Lemma make_addimm_correct: - forall n r v, + forall n r, let (op, args) := make_addimm n r in - eval_operation ge sp Oadd (rs#r :: Vint n :: nil) m = Some v -> - eval_operation ge sp op rs##args m = Some v. + exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.add rs#r (Vint n)) v. Proof. - intros; unfold make_addimm. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros. - subst n. simpl in *. FuncInv. rewrite Int.add_zero in H. congruence. - rewrite Int.add_zero in H. congruence. - exact H0. + intros. unfold make_addimm. + predSpec Int.eq Int.eq_spec n Int.zero; intros. + subst. exists (rs#r); split; auto. destruct (rs#r); simpl; auto; rewrite Int.add_zero; auto. + exists (Val.add rs#r (Vint n)); auto. Qed. - + Lemma make_shlimm_correct: - forall n r v, - let (op, args) := make_shlimm n r in - eval_operation ge sp Oshl (rs#r :: Vint n :: nil) m = Some v -> - eval_operation ge sp op rs##args m = Some v. + forall n r1 r2, + rs#r2 = Vint n -> + let (op, args) := make_shlimm n r1 r2 in + exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.shl rs#r1 (Vint n)) v. Proof. + Opaque mk_shift_amount. intros; unfold make_shlimm. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros. - subst n. simpl in *. FuncInv. rewrite Int.shl_zero in H. congruence. - unfold is_shift_amount. destruct (is_shift_amount_aux n); intros. - simpl in *. FuncInv. rewrite e in H0. auto. - simpl in *. FuncInv. rewrite e in H0. discriminate. + predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. + exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.shl_zero. auto. + destruct (Int.ltu n Int.iwordsize) as []_eqn; intros. + econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. + econstructor; split; eauto. simpl. congruence. Qed. Lemma make_shrimm_correct: - forall n r v, - let (op, args) := make_shrimm n r in - eval_operation ge sp Oshr (rs#r :: Vint n :: nil) m = Some v -> - eval_operation ge sp op rs##args m = Some v. + forall n r1 r2, + rs#r2 = Vint n -> + let (op, args) := make_shrimm n r1 r2 in + exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.shr rs#r1 (Vint n)) v. Proof. intros; unfold make_shrimm. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros. - subst n. simpl in *. FuncInv. rewrite Int.shr_zero in H. congruence. - unfold is_shift_amount. destruct (is_shift_amount_aux n); intros. - simpl in *. FuncInv. rewrite e in H0. auto. - simpl in *. FuncInv. rewrite e in H0. discriminate. + predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. + exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.shr_zero. auto. + destruct (Int.ltu n Int.iwordsize) as []_eqn; intros. + econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. + econstructor; split; eauto. simpl. congruence. Qed. Lemma make_shruimm_correct: - forall n r v, - let (op, args) := make_shruimm n r in - eval_operation ge sp Oshru (rs#r :: Vint n :: nil) m = Some v -> - eval_operation ge sp op rs##args m = Some v. + forall n r1 r2, + rs#r2 = Vint n -> + let (op, args) := make_shruimm n r1 r2 in + exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.shru rs#r1 (Vint n)) v. Proof. intros; unfold make_shruimm. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros. - subst n. simpl in *. FuncInv. rewrite Int.shru_zero in H. congruence. - unfold is_shift_amount. destruct (is_shift_amount_aux n); intros. - simpl in *. FuncInv. rewrite e in H0. auto. - simpl in *. FuncInv. rewrite e in H0. discriminate. + predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. + exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.shru_zero. auto. + destruct (Int.ltu n Int.iwordsize) as []_eqn; intros. + econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. + econstructor; split; eauto. simpl. congruence. Qed. Lemma make_mulimm_correct: - forall n r r' v, - rs#r' = Vint n -> - let (op, args) := make_mulimm n r r' in - eval_operation ge sp Omul (rs#r :: Vint n :: nil) m = Some v -> - eval_operation ge sp op rs##args m = Some v. + forall n r1 r2, + rs#r2 = Vint n -> + let (op, args) := make_mulimm n r1 r2 in + exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.mul rs#r1 (Vint n)) v. Proof. intros; unfold make_mulimm. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros. - subst n. simpl in H1. FuncInv. rewrite Int.mul_zero in H0. simpl. congruence. - generalize (Int.eq_spec n Int.one); case (Int.eq n Int.one); intros. - subst n. simpl in H2. simpl. FuncInv. rewrite Int.mul_one in H1. congruence. - caseEq (Int.is_power2 n); intros. - replace (eval_operation ge sp Omul (rs # r :: Vint n :: nil) m) - with (eval_operation ge sp Oshl (rs # r :: Vint i :: nil) m). - apply make_shlimm_correct. - simpl. generalize (Int.is_power2_range _ _ H2). - change (Z_of_nat Int.wordsize) with 32. intro. rewrite H3. - destruct rs#r; auto. rewrite (Int.mul_pow2 i0 _ _ H2). auto. - simpl List.map. rewrite H. auto. + predSpec Int.eq Int.eq_spec n Int.zero; intros. subst. + exists (Vint Int.zero); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.mul_zero; auto. + predSpec Int.eq Int.eq_spec n Int.one; intros. subst. + exists (rs#r1); split; auto. destruct (rs#r1); simpl; auto. rewrite Int.mul_one; auto. + destruct (Int.is_power2 n) as []_eqn; intros. + exploit Int.is_power2_range; eauto. intros R. + econstructor; split. simpl; eauto. rewrite mk_shift_amount_eq; auto. + rewrite (Val.mul_pow2 rs#r1 _ _ Heqo). auto. + econstructor; split; eauto. simpl. congruence. +Qed. + +Lemma make_divimm_correct: + forall n r1 r2 v, + Val.divs rs#r1 rs#r2 = Some v -> + rs#r2 = Vint n -> + let (op, args) := make_divimm n r1 r2 in + exists w, eval_operation ge sp op rs##args m = Some w /\ Val.lessdef v w. +Proof. + intros; unfold make_divimm. + destruct (Int.is_power2 n) as []_eqn. + destruct (Int.ltu i (Int.repr 31)) as []_eqn. + exists v; split; auto. simpl. eapply Val.divs_pow2; eauto. congruence. + exists v; auto. + exists v; auto. +Qed. + +Lemma make_divuimm_correct: + forall n r1 r2 v, + Val.divu rs#r1 rs#r2 = Some v -> + rs#r2 = Vint n -> + let (op, args) := make_divuimm n r1 r2 in + exists w, eval_operation ge sp op rs##args m = Some w /\ Val.lessdef v w. +Proof. + intros; unfold make_divuimm. + destruct (Int.is_power2 n) as []_eqn. + replace v with (Val.shru rs#r1 (Vint i)). + econstructor; split. simpl. rewrite mk_shift_amount_eq. eauto. + eapply Int.is_power2_range; eauto. auto. + eapply Val.divu_pow2; eauto. congruence. + exists v; auto. Qed. Lemma make_andimm_correct: - forall n r v, + forall n r, let (op, args) := make_andimm n r in - eval_operation ge sp Oand (rs#r :: Vint n :: nil) m = Some v -> - eval_operation ge sp op rs##args m = Some v. + exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.and rs#r (Vint n)) v. Proof. intros; unfold make_andimm. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros. - subst n. simpl in *. FuncInv. rewrite Int.and_zero in H. congruence. - generalize (Int.eq_spec n Int.mone); case (Int.eq n Int.mone); intros. - subst n. simpl in *. FuncInv. rewrite Int.and_mone in H0. congruence. - exact H1. + predSpec Int.eq Int.eq_spec n Int.zero; intros. + subst n. exists (Vint Int.zero); split; auto. destruct (rs#r); simpl; auto. rewrite Int.and_zero; auto. + predSpec Int.eq Int.eq_spec n Int.mone; intros. + subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.and_mone; auto. + econstructor; split; eauto. auto. Qed. Lemma make_orimm_correct: - forall n r v, + forall n r, let (op, args) := make_orimm n r in - eval_operation ge sp Oor (rs#r :: Vint n :: nil) m = Some v -> - eval_operation ge sp op rs##args m = Some v. + exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.or rs#r (Vint n)) v. Proof. intros; unfold make_orimm. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros. - subst n. simpl in *. FuncInv. rewrite Int.or_zero in H. congruence. - generalize (Int.eq_spec n Int.mone); case (Int.eq n Int.mone); intros. - subst n. simpl in *. FuncInv. rewrite Int.or_mone in H0. congruence. - exact H1. + predSpec Int.eq Int.eq_spec n Int.zero; intros. + subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.or_zero; auto. + predSpec Int.eq Int.eq_spec n Int.mone; intros. + subst n. exists (Vint Int.mone); split; auto. destruct (rs#r); simpl; auto. rewrite Int.or_mone; auto. + econstructor; split; eauto. auto. Qed. Lemma make_xorimm_correct: - forall n r v, + forall n r, let (op, args) := make_xorimm n r in - eval_operation ge sp Oxor (rs#r :: Vint n :: nil) m = Some v -> - eval_operation ge sp op rs##args m = Some v. + exists v, eval_operation ge sp op rs##args m = Some v /\ Val.lessdef (Val.xor rs#r (Vint n)) v. Proof. intros; unfold make_xorimm. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intros. - subst n. simpl in *. FuncInv. rewrite Int.xor_zero in H. congruence. - generalize (Int.eq_spec n Int.mone); case (Int.eq n Int.mone); intros. - subst n. simpl in *. FuncInv. decEq. auto. - exact H1. + predSpec Int.eq Int.eq_spec n Int.zero; intros. + subst n. exists (rs#r); split; auto. destruct (rs#r); simpl; auto. rewrite Int.xor_zero; auto. + predSpec Int.eq Int.eq_spec n Int.mone; intros. + subst n. exists (Val.notint (rs#r)); split. auto. + destruct (rs#r); simpl; auto. + econstructor; split; eauto. auto. Qed. Lemma op_strength_reduction_correct: - forall op args v, - let (op', args') := op_strength_reduction app op args in + forall op args vl v, + vl = approx_regs app args -> eval_operation ge sp op rs##args m = Some v -> - eval_operation ge sp op' rs##args' m = Some v. + let (op', args') := op_strength_reduction op args vl in + exists w, eval_operation ge sp op' rs##args' m = Some w /\ Val.lessdef v w. Proof. - intros; unfold op_strength_reduction; - case (op_strength_reduction_match op args); intros; simpl List.map. - (* Oadd *) - caseEq (intval app r1); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp Oadd (Vint i :: rs # r2 :: nil) m) - with (eval_operation ge sp Oadd (rs # r2 :: Vint i :: nil) m). - apply make_addimm_correct. - simpl. destruct rs#r2; auto. rewrite Int.add_commut; auto. - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H0). apply make_addimm_correct. - assumption. - (* Oaddshift *) - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp (Oaddshift s) (rs # r1 :: Vint i :: nil) m) - with (eval_operation ge sp Oadd (rs # r1 :: Vint (eval_shift s i) :: nil) m). - apply make_addimm_correct. - simpl. destruct rs#r1; auto. - assumption. - (* Osub *) - caseEq (intval app r1); intros. - rewrite (intval_correct _ _ H) in H0. - simpl in *. destruct rs#r2; auto. - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H0). - replace (eval_operation ge sp Osub (rs # r1 :: Vint i :: nil) m) - with (eval_operation ge sp Oadd (rs # r1 :: Vint (Int.neg i) :: nil) m). - apply make_addimm_correct. - simpl. destruct rs#r1; auto; rewrite Int.sub_add_opp; auto. - assumption. - (* Osubshift *) - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp (Osubshift s) (rs # r1 :: Vint i :: nil) m) - with (eval_operation ge sp Oadd (rs # r1 :: Vint (Int.neg (eval_shift s i)) :: nil) m). - apply make_addimm_correct. - simpl. destruct rs#r1; auto; rewrite Int.sub_add_opp; auto. - assumption. - (* Orsubshift *) - caseEq (intval app r2). intros n H. - rewrite (intval_correct _ _ H). - simpl. destruct rs#r1; auto. - auto. - (* Omul *) - caseEq (intval app r1); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp Omul (Vint i :: rs # r2 :: nil) m) - with (eval_operation ge sp Omul (rs # r2 :: Vint i :: nil) m). - apply make_mulimm_correct. apply intval_correct; auto. - simpl. destruct rs#r2; auto. rewrite Int.mul_commut; auto. - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H0). apply make_mulimm_correct. - apply intval_correct; auto. - assumption. - (* Odivu *) - caseEq (intval app r2); intros. - caseEq (Int.is_power2 i); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp Odivu (rs # r1 :: Vint i :: nil) m) - with (eval_operation ge sp Oshru (rs # r1 :: Vint i0 :: nil) m). - apply make_shruimm_correct. - simpl. destruct rs#r1; auto. - change 32 with (Z_of_nat Int.wordsize). - rewrite (Int.is_power2_range _ _ H0). - generalize (Int.eq_spec i Int.zero); case (Int.eq i Int.zero); intros. - subst i. discriminate. - rewrite (Int.divu_pow2 i1 _ _ H0). auto. - assumption. - assumption. - (* Oand *) - caseEq (intval app r1); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp Oand (Vint i :: rs # r2 :: nil) m) - with (eval_operation ge sp Oand (rs # r2 :: Vint i :: nil) m). - apply make_andimm_correct. - simpl. destruct rs#r2; auto. rewrite Int.and_commut; auto. - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H0). apply make_andimm_correct. - assumption. - (* Oandshift *) - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp (Oandshift s) (rs # r1 :: Vint i :: nil) m) - with (eval_operation ge sp Oand (rs # r1 :: Vint (eval_shift s i) :: nil) m). - apply make_andimm_correct. reflexivity. - assumption. - (* Oor *) - caseEq (intval app r1); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp Oor (Vint i :: rs # r2 :: nil) m) - with (eval_operation ge sp Oor (rs # r2 :: Vint i :: nil) m). - apply make_orimm_correct. - simpl. destruct rs#r2; auto. rewrite Int.or_commut; auto. - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H0). apply make_orimm_correct. - assumption. - (* Oorshift *) - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp (Oorshift s) (rs # r1 :: Vint i :: nil) m) - with (eval_operation ge sp Oor (rs # r1 :: Vint (eval_shift s i) :: nil) m). - apply make_orimm_correct. reflexivity. - assumption. - (* Oxor *) - caseEq (intval app r1); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp Oxor (Vint i :: rs # r2 :: nil) m) - with (eval_operation ge sp Oxor (rs # r2 :: Vint i :: nil) m). - apply make_xorimm_correct. - simpl. destruct rs#r2; auto. rewrite Int.xor_commut; auto. - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H0). apply make_xorimm_correct. - assumption. - (* Oxorshift *) - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp (Oxorshift s) (rs # r1 :: Vint i :: nil) m) - with (eval_operation ge sp Oxor (rs # r1 :: Vint (eval_shift s i) :: nil) m). - apply make_xorimm_correct. reflexivity. - assumption. - (* Obic *) - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp Obic (rs # r1 :: Vint i :: nil) m) - with (eval_operation ge sp Oand (rs # r1 :: Vint (Int.not i) :: nil) m). - apply make_andimm_correct. reflexivity. - assumption. - (* Obicshift *) - caseEq (intval app r2); intros. - rewrite (intval_correct _ _ H). - replace (eval_operation ge sp (Obicshift s) (rs # r1 :: Vint i :: nil) m) - with (eval_operation ge sp Oand (rs # r1 :: Vint (Int.not (eval_shift s i)) :: nil) m). - apply make_andimm_correct. reflexivity. - assumption. - (* Oshl *) - caseEq (intval app r2); intros. - caseEq (Int.ltu i Int.iwordsize); intros. - rewrite (intval_correct _ _ H). apply make_shlimm_correct. - assumption. - assumption. - (* Oshr *) - caseEq (intval app r2); intros. - caseEq (Int.ltu i Int.iwordsize); intros. - rewrite (intval_correct _ _ H). apply make_shrimm_correct. - assumption. - assumption. - (* Oshru *) - caseEq (intval app r2); intros. - caseEq (Int.ltu i Int.iwordsize); intros. - rewrite (intval_correct _ _ H). apply make_shruimm_correct. - assumption. - assumption. - (* Ocmp *) - generalize (cond_strength_reduction_correct c rl). - destruct (cond_strength_reduction app c rl). - simpl. intro. rewrite H. auto. - (* default *) - assumption. + intros until v; unfold op_strength_reduction; + case (op_strength_reduction_match op args vl); simpl; intros. +(* add *) + InvApproxRegs. SimplVMA. inv H0. rewrite H1. rewrite Val.add_commut. apply make_addimm_correct. + InvApproxRegs. SimplVMA. inv H0. rewrite H. apply make_addimm_correct. +(* addshift *) + InvApproxRegs. SimplVMA. inv H0. rewrite H. rewrite eval_static_shift_correct. apply make_addimm_correct. +(* sub *) + InvApproxRegs; SimplVMA. inv H0. rewrite H1. econstructor; split; eauto. + InvApproxRegs; SimplVMA. inv H0. rewrite H. rewrite Val.sub_add_opp. apply make_addimm_correct. +(* subshift *) + InvApproxRegs; SimplVMA. inv H0. rewrite H. rewrite eval_static_shift_correct. rewrite Val.sub_add_opp. apply make_addimm_correct. +(* rsubshift *) + InvApproxRegs; SimplVMA. inv H0. rewrite H. rewrite eval_static_shift_correct. econstructor; split; eauto. +(* mul *) + InvApproxRegs; SimplVMA. inv H0. rewrite H1. rewrite Val.mul_commut. apply make_mulimm_correct; auto. + InvApproxRegs; SimplVMA. inv H0. rewrite H. apply make_mulimm_correct; auto. +(* divs *) + assert (rs#r2 = Vint n2). clear H0. InvApproxRegs; SimplVMA; auto. + apply make_divimm_correct; auto. +(* divu *) + assert (rs#r2 = Vint n2). clear H0. InvApproxRegs; SimplVMA; auto. + apply make_divuimm_correct; auto. +(* and *) + InvApproxRegs. SimplVMA. inv H0. rewrite H1. rewrite Val.and_commut. apply make_andimm_correct. + InvApproxRegs. SimplVMA. inv H0. rewrite H. apply make_andimm_correct. +(* andshift *) + InvApproxRegs. SimplVMA. inv H0. rewrite H. rewrite eval_static_shift_correct. apply make_andimm_correct. +(* or *) + InvApproxRegs. SimplVMA. inv H0. rewrite H1. rewrite Val.or_commut. apply make_orimm_correct. + InvApproxRegs. SimplVMA. inv H0. rewrite H. apply make_orimm_correct. +(* orshift *) + InvApproxRegs. SimplVMA. inv H0. rewrite H. rewrite eval_static_shift_correct. apply make_orimm_correct. +(* xor *) + InvApproxRegs. SimplVMA. inv H0. rewrite H1. rewrite Val.xor_commut. apply make_xorimm_correct. + InvApproxRegs. SimplVMA. inv H0. rewrite H. apply make_xorimm_correct. +(* xorshift *) + InvApproxRegs. SimplVMA. inv H0. rewrite H. rewrite eval_static_shift_correct. apply make_xorimm_correct. +(* bic *) + InvApproxRegs. SimplVMA. inv H0. rewrite H. apply make_andimm_correct. +(* bicshift *) + InvApproxRegs. SimplVMA. inv H0. rewrite H. rewrite eval_static_shift_correct. apply make_andimm_correct. +(* shl *) + InvApproxRegs. SimplVMA. inv H0. rewrite H. apply make_shlimm_correct; auto. +(* shr *) + InvApproxRegs. SimplVMA. inv H0. rewrite H. apply make_shrimm_correct; auto. +(* shru *) + InvApproxRegs. SimplVMA. inv H0. rewrite H. apply make_shruimm_correct; auto. +(* cmp *) + generalize (cond_strength_reduction_correct c args0 vl0). + destruct (cond_strength_reduction c args0 vl0) as [c' args']; intros. + rewrite <- H1 in H0; auto. econstructor; split; eauto. +(* default *) + exists v; auto. Qed. Lemma addr_strength_reduction_correct: - forall addr args, - let (addr', args') := addr_strength_reduction app addr args in + forall addr args vl, + vl = approx_regs app args -> + let (addr', args') := addr_strength_reduction addr args vl in eval_addressing ge sp addr' rs##args' = eval_addressing ge sp addr rs##args. Proof. - intros. - - unfold addr_strength_reduction; - case (addr_strength_reduction_match addr args); intros. - - (* Aindexed2 *) - caseEq (intval app r1); intros. - simpl; rewrite (intval_correct _ _ H). - destruct rs#r2; auto. rewrite Int.add_commut; auto. - caseEq (intval app r2); intros. - simpl; rewrite (intval_correct _ _ H0). auto. + intros until vl. unfold addr_strength_reduction. + destruct (addr_strength_reduction_match addr args vl); simpl; intros; InvApproxRegs; SimplVMA. + rewrite H; rewrite H0. rewrite Val.add_assoc; auto. + rewrite H; rewrite H0. rewrite Val.add_permut; auto. + rewrite H0. rewrite Val.add_commut. auto. + rewrite H. auto. + rewrite H; rewrite H0. rewrite Val.add_assoc. rewrite eval_static_shift_correct. auto. + rewrite H. rewrite eval_static_shift_correct. auto. + rewrite H. rewrite Val.add_assoc. auto. auto. - - (* Aindexed2shift *) - caseEq (intval app r2); intros. - simpl; rewrite (intval_correct _ _ H). auto. - auto. - - (* default *) - reflexivity. Qed. End STRENGTH_REDUCTION. diff --git a/arm/Op.v b/arm/Op.v index 17cd0b44..905068f6 100644 --- a/arm/Op.v +++ b/arm/Op.v @@ -36,11 +36,11 @@ Require Import Events. Set Implicit Arguments. -Record shift_amount : Type := - mk_shift_amount { - s_amount: int; - s_amount_ltu: Int.ltu s_amount Int.iwordsize = true - }. +Record shift_amount: Type := + { s_amount: int; + s_range: Int.ltu s_amount Int.iwordsize = true }. + +Coercion s_amount: shift_amount >-> int. Inductive shift : Type := | Slsl: shift_amount -> shift @@ -70,10 +70,6 @@ Inductive operation : Type := | Oaddrsymbol: ident -> int -> operation (**r [rd] is set to the the address of the symbol plus the offset *) | Oaddrstack: int -> operation (**r [rd] is set to the stack pointer plus the given offset *) (*c Integer arithmetic: *) - | Ocast8signed: operation (**r [rd] is 8-bit sign extension of [r1] *) - | Ocast8unsigned: operation (**r [rd] is 8-bit zero extension of [r1] *) - | Ocast16signed: operation (**r [rd] is 16-bit sign extension of [r1] *) - | Ocast16unsigned: operation (**r [rd] is 16-bit zero extension of [r1] *) | Oadd: operation (**r [rd = r1 + r2] *) | Oaddshift: shift -> operation (**r [rd = r1 + shifted r2] *) | Oaddimm: int -> operation (**r [rd = r1 + n] *) @@ -158,68 +154,39 @@ Proof. decide equality. Qed. -(** Evaluation of conditions, operators and addressing modes applied - to lists of values. Return [None] when the computation is undefined: - wrong number of arguments, arguments of the wrong types, undefined - operations such as division by zero. [eval_condition] returns a boolean, - [eval_operation] and [eval_addressing] return a value. *) +(** * Evaluation functions *) -Definition eval_compare_mismatch (c: comparison) : option bool := - match c with Ceq => Some false | Cne => Some true | _ => None end. +Definition symbol_address (F V: Type) (genv: Genv.t F V) (id: ident) (ofs: int) : val := + match Genv.find_symbol genv id with + | Some b => Vptr b ofs + | None => Vundef + end. -Definition eval_compare_null (c: comparison) (n: int) : option bool := - if Int.eq n Int.zero then eval_compare_mismatch c else None. +(** Evaluation of conditions, operators and addressing modes applied + to lists of values. Return [None] when the computation can trigger an + error, e.g. integer division by zero. [eval_condition] returns a boolean, + [eval_operation] and [eval_addressing] return a value. *) -Definition eval_shift (s: shift) (n: int) : int := +Definition eval_shift (s: shift) (v: val) : val := match s with - | Slsl x => Int.shl n (s_amount x) - | Slsr x => Int.shru n (s_amount x) - | Sasr x => Int.shr n (s_amount x) - | Sror x => Int.ror n (s_amount x) + | Slsl x => Val.shl v (Vint x) + | Slsr x => Val.shru v (Vint x) + | Sasr x => Val.shr v (Vint x) + | Sror x => Val.ror v (Vint x) end. Definition eval_condition (cond: condition) (vl: list val) (m: mem): option bool := match cond, vl with - | Ccomp c, Vint n1 :: Vint n2 :: nil => - Some (Int.cmp c n1 n2) - | Ccompu c, Vint n1 :: Vint n2 :: nil => - Some (Int.cmpu c n1 n2) - | Ccompu c, Vptr b1 n1 :: Vptr b2 n2 :: nil => - if Mem.valid_pointer m b1 (Int.unsigned n1) - && Mem.valid_pointer m b2 (Int.unsigned n2) then - if eq_block b1 b2 - then Some (Int.cmpu c n1 n2) - else eval_compare_mismatch c - else None - | Ccompu c, Vptr b1 n1 :: Vint n2 :: nil => - eval_compare_null c n2 - | Ccompu c, Vint n1 :: Vptr b2 n2 :: nil => - eval_compare_null c n1 - | Ccompshift c s, Vint n1 :: Vint n2 :: nil => - Some (Int.cmp c n1 (eval_shift s n2)) - | Ccompushift c s, Vint n1 :: Vint n2 :: nil => - Some (Int.cmpu c n1 (eval_shift s n2)) - | Ccompushift c s, Vptr b1 n1 :: Vint n2 :: nil => - eval_compare_null c (eval_shift s n2) - | Ccompimm c n, Vint n1 :: nil => - Some (Int.cmp c n1 n) - | Ccompuimm c n, Vint n1 :: nil => - Some (Int.cmpu c n1 n) - | Ccompuimm c n, Vptr b1 n1 :: nil => - eval_compare_null c n - | Ccompf c, Vfloat f1 :: Vfloat f2 :: nil => - Some (Float.cmp c f1 f2) - | Cnotcompf c, Vfloat f1 :: Vfloat f2 :: nil => - Some (negb (Float.cmp c f1 f2)) - | _, _ => - None - end. - -Definition offset_sp (sp: val) (delta: int) : option val := - match sp with - | Vptr b n => Some (Vptr b (Int.add n delta)) - | _ => None + | Ccomp c, v1 :: v2 :: nil => Val.cmp_bool c v1 v2 + | Ccompu c, v1 :: v2 :: nil => Val.cmpu_bool (Mem.valid_pointer m) c v1 v2 + | Ccompshift c s, v1 :: v2 :: nil => Val.cmp_bool c v1 (eval_shift s v2) + | Ccompushift c s, v1 :: v2 :: nil => Val.cmpu_bool (Mem.valid_pointer m) c v1 (eval_shift s v2) + | Ccompimm c n, v1 :: nil => Val.cmp_bool c v1 (Vint n) + | Ccompuimm c n, v1 :: nil => Val.cmpu_bool (Mem.valid_pointer m) c v1 (Vint n) + | Ccompf c, v1 :: v2 :: nil => Val.cmpf_bool c v1 v2 + | Cnotcompf c, v1 :: v2 :: nil => option_map negb (Val.cmpf_bool c v1 v2) + | _, _ => None end. Definition eval_operation @@ -229,75 +196,48 @@ Definition eval_operation | Omove, v1::nil => Some v1 | Ointconst n, nil => Some (Vint n) | Ofloatconst n, nil => Some (Vfloat n) - | Oaddrsymbol s ofs, nil => - match Genv.find_symbol genv s with - | None => None - | Some b => Some (Vptr b ofs) - end - | Oaddrstack ofs, nil => offset_sp sp ofs - | Ocast8signed, v1 :: nil => Some (Val.sign_ext 8 v1) - | Ocast8unsigned, v1 :: nil => Some (Val.zero_ext 8 v1) - | Ocast16signed, v1 :: nil => Some (Val.sign_ext 16 v1) - | Ocast16unsigned, v1 :: nil => Some (Val.zero_ext 16 v1) - | Oadd, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.add n1 n2)) - | Oadd, Vint n1 :: Vptr b2 n2 :: nil => Some (Vptr b2 (Int.add n2 n1)) - | Oadd, Vptr b1 n1 :: Vint n2 :: nil => Some (Vptr b1 (Int.add n1 n2)) - | Oaddshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.add n1 (eval_shift s n2))) - | Oaddshift s, Vptr b1 n1 :: Vint n2 :: nil => Some (Vptr b1 (Int.add n1 (eval_shift s n2))) - | Oaddimm n, Vint n1 :: nil => Some (Vint (Int.add n1 n)) - | Oaddimm n, Vptr b1 n1 :: nil => Some (Vptr b1 (Int.add n1 n)) - | Osub, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.sub n1 n2)) - | Osub, Vptr b1 n1 :: Vint n2 :: nil => Some (Vptr b1 (Int.sub n1 n2)) - | Osub, Vptr b1 n1 :: Vptr b2 n2 :: nil => - if eq_block b1 b2 then Some (Vint (Int.sub n1 n2)) else None - | Osubshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.sub n1 (eval_shift s n2))) - | Osubshift s, Vptr b1 n1 :: Vint n2 :: nil => Some (Vptr b1 (Int.sub n1 (eval_shift s n2))) - | Orsubshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.sub (eval_shift s n2) n1)) - | Orsubimm n, Vint n1 :: nil => Some (Vint (Int.sub n n1)) - | Omul, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.mul n1 n2)) - | Odiv, Vint n1 :: Vint n2 :: nil => - if Int.eq n2 Int.zero then None else Some (Vint (Int.divs n1 n2)) - | Odivu, Vint n1 :: Vint n2 :: nil => - if Int.eq n2 Int.zero then None else Some (Vint (Int.divu n1 n2)) - | Oand, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.and n1 n2)) - | Oandshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.and n1 (eval_shift s n2))) - | Oandimm n, Vint n1 :: nil => Some (Vint (Int.and n1 n)) - | Oor, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.or n1 n2)) - | Oorshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.or n1 (eval_shift s n2))) - | Oorimm n, Vint n1 :: nil => Some (Vint (Int.or n1 n)) - | Oxor, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.xor n1 n2)) - | Oxorshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.xor n1 (eval_shift s n2))) - | Oxorimm n, Vint n1 :: nil => Some (Vint (Int.xor n1 n)) - | Obic, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.and n1 (Int.not n2))) - | Obicshift s, Vint n1 :: Vint n2 :: nil => Some (Vint (Int.and n1 (Int.not (eval_shift s n2)))) - | Onot, Vint n1 :: nil => Some (Vint (Int.not n1)) - | Onotshift s, Vint n1 :: nil => Some (Vint (Int.not (eval_shift s n1))) - | Oshl, Vint n1 :: Vint n2 :: nil => - if Int.ltu n2 Int.iwordsize then Some (Vint (Int.shl n1 n2)) else None - | Oshr, Vint n1 :: Vint n2 :: nil => - if Int.ltu n2 Int.iwordsize then Some (Vint (Int.shr n1 n2)) else None - | Oshru, Vint n1 :: Vint n2 :: nil => - if Int.ltu n2 Int.iwordsize then Some (Vint (Int.shru n1 n2)) else None - | Oshift s, Vint n :: nil => Some (Vint (eval_shift s n)) - | Oshrximm n, Vint n1 :: nil => - if Int.ltu n (Int.repr 31) then Some (Vint (Int.shrx n1 n)) else None - | Onegf, Vfloat f1 :: nil => Some (Vfloat (Float.neg f1)) - | Oabsf, Vfloat f1 :: nil => Some (Vfloat (Float.abs f1)) - | Oaddf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.add f1 f2)) - | Osubf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.sub f1 f2)) - | Omulf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.mul f1 f2)) - | Odivf, Vfloat f1 :: Vfloat f2 :: nil => Some (Vfloat (Float.div f1 f2)) - | Osingleoffloat, v1 :: nil => Some (Val.singleoffloat v1) - | Ointoffloat, Vfloat f1 :: nil => option_map Vint (Float.intoffloat f1) - | Ointuoffloat, Vfloat f1 :: nil => option_map Vint (Float.intuoffloat f1) - | Ofloatofint, Vint n1 :: nil => Some (Vfloat (Float.floatofint n1)) - | Ofloatofintu, Vint n1 :: nil => Some (Vfloat (Float.floatofintu n1)) - | Ocmp c, _ => - match eval_condition c vl m with - | None => None - | Some false => Some Vfalse - | Some true => Some Vtrue - end + | Oaddrsymbol s ofs, nil => Some (symbol_address genv s ofs) + | Oaddrstack ofs, nil => Some (Val.add sp (Vint ofs)) + | Oadd, v1 :: v2 :: nil => Some (Val.add v1 v2) + | Oaddshift s, v1 :: v2 :: nil => Some (Val.add v1 (eval_shift s v2)) + | Oaddimm n, v1 :: nil => Some (Val.add v1 (Vint n)) + | Osub, v1 :: v2 :: nil => Some (Val.sub v1 v2) + | Osubshift s, v1 :: v2 :: nil => Some (Val.sub v1 (eval_shift s v2)) + | Orsubshift s, v1 :: v2 :: nil => Some (Val.sub (eval_shift s v2) v1) + | Orsubimm n, v1 :: nil => Some (Val.sub (Vint n) v1) + | Omul, v1 :: v2 :: nil => Some (Val.mul v1 v2) + | Odiv, v1 :: v2 :: nil => Val.divs v1 v2 + | Odivu, v1 :: v2 :: nil => Val.divu v1 v2 + | Oand, v1 :: v2 :: nil => Some (Val.and v1 v2) + | Oandshift s, v1 :: v2 :: nil => Some (Val.and v1 (eval_shift s v2)) + | Oandimm n, v1 :: nil => Some (Val.and v1 (Vint n)) + | Oor, v1 :: v2 :: nil => Some (Val.or v1 v2) + | Oorshift s, v1 :: v2 :: nil => Some (Val.or v1 (eval_shift s v2)) + | Oorimm n, v1 :: nil => Some (Val.or v1 (Vint n)) + | Oxor, v1 :: v2 :: nil => Some (Val.xor v1 v2) + | Oxorshift s, v1 :: v2 :: nil => Some (Val.xor v1 (eval_shift s v2)) + | Oxorimm n, v1 :: nil => Some (Val.xor v1 (Vint n)) + | Obic, v1 :: v2 :: nil => Some (Val.and v1 (Val.notint v2)) + | Obicshift s, v1 :: v2 :: nil => Some (Val.and v1 (Val.notint (eval_shift s v2))) + | Onot, v1 :: nil => Some (Val.notint v1) + | Onotshift s, v1 :: nil => Some (Val.notint (eval_shift s v1)) + | Oshl, v1 :: v2 :: nil => Some (Val.shl v1 v2) + | Oshr, v1 :: v2 :: nil => Some (Val.shr v1 v2) + | Oshru, v1 :: v2 :: nil => Some (Val.shru v1 v2) + | Oshift s, v1 :: nil => Some (eval_shift s v1) + | Oshrximm n, v1 :: nil => Val.shrx v1 (Vint n) + | Onegf, v1::nil => Some(Val.negf v1) + | Oabsf, v1::nil => Some(Val.absf v1) + | Oaddf, v1::v2::nil => Some(Val.addf v1 v2) + | Osubf, v1::v2::nil => Some(Val.subf v1 v2) + | Omulf, v1::v2::nil => Some(Val.mulf v1 v2) + | Odivf, v1::v2::nil => Some(Val.divf v1 v2) + | Osingleoffloat, v1::nil => Some(Val.singleoffloat v1) + | Ointoffloat, v1::nil => Val.intoffloat v1 + | Ointuoffloat, v1::nil => Val.intuoffloat v1 + | Ofloatofint, v1::nil => Val.floatofint v1 + | Ofloatofintu, v1::nil => Val.floatofintu v1 + | Ocmp c, _ => Some(Val.of_optbool (eval_condition c vl m)) | _, _ => None end. @@ -305,31 +245,13 @@ Definition eval_addressing (F V: Type) (genv: Genv.t F V) (sp: val) (addr: addressing) (vl: list val) : option val := match addr, vl with - | Aindexed n, Vptr b1 n1 :: nil => - Some (Vptr b1 (Int.add n1 n)) - | Aindexed2, Vptr b1 n1 :: Vint n2 :: nil => - Some (Vptr b1 (Int.add n1 n2)) - | Aindexed2, Vint n1 :: Vptr b2 n2 :: nil => - Some (Vptr b2 (Int.add n1 n2)) - | Aindexed2shift s, Vptr b1 n1 :: Vint n2 :: nil => - Some (Vptr b1 (Int.add n1 (eval_shift s n2))) - | Ainstack ofs, nil => - offset_sp sp ofs + | Aindexed n, v1 :: nil => Some (Val.add v1 (Vint n)) + | Aindexed2, v1 :: v2 :: nil => Some (Val.add v1 v2) + | Aindexed2shift s, v1 :: v2 :: nil => Some (Val.add v1 (eval_shift s v2)) + | Ainstack ofs, nil => Some (Val.add sp (Vint ofs)) | _, _ => None end. -Definition negate_condition (cond: condition): condition := - match cond with - | Ccomp c => Ccomp(negate_comparison c) - | Ccompu c => Ccompu(negate_comparison c) - | Ccompshift c s => Ccompshift (negate_comparison c) s - | Ccompushift c s => Ccompushift (negate_comparison c) s - | Ccompimm c n => Ccompimm (negate_comparison c) n - | Ccompuimm c n => Ccompuimm (negate_comparison c) n - | Ccompf c => Cnotcompf c - | Cnotcompf c => Ccompf c - end. - Ltac FuncInv := match goal with | H: (match ?x with nil => _ | _ :: _ => _ end = Some _) |- _ => @@ -342,99 +264,7 @@ Ltac FuncInv := idtac end. -Remark eval_negate_compare_null: - forall c n b, - eval_compare_null c n = Some b -> - eval_compare_null (negate_comparison c) n = Some (negb b). -Proof. - intros until b. unfold eval_compare_null. - case (Int.eq n Int.zero). - destruct c; intro EQ; simplify_eq EQ; intros; subst b; reflexivity. - intro; discriminate. -Qed. - -Lemma eval_negate_condition: - forall (cond: condition) (vl: list val) (b: bool) (m: mem), - eval_condition cond vl m = Some b -> - eval_condition (negate_condition cond) vl m = Some (negb b). -Proof. - intros. - destruct cond; simpl in H; FuncInv; try subst b; simpl. - rewrite Int.negate_cmp. auto. - rewrite Int.negate_cmpu. auto. - apply eval_negate_compare_null; auto. - apply eval_negate_compare_null; auto. - destruct (Mem.valid_pointer m b0 (Int.unsigned i) && - Mem.valid_pointer m b1 (Int.unsigned i0)); try discriminate. - destruct (eq_block b0 b1). rewrite Int.negate_cmpu. congruence. - destruct c; simpl in H; inv H; auto. - rewrite Int.negate_cmp. auto. - rewrite Int.negate_cmpu. auto. - apply eval_negate_compare_null; auto. - rewrite Int.negate_cmp. auto. - rewrite Int.negate_cmpu. auto. - apply eval_negate_compare_null; auto. - auto. - rewrite negb_elim. auto. -Qed. - -(** [eval_operation] and [eval_addressing] depend on a global environment - for resolving references to global symbols. We show that they give - the same results if a global environment is replaced by another that - assigns the same addresses to the same symbols. *) - -Section GENV_TRANSF. - -Variable F1 F2 V1 V2: Type. -Variable ge1: Genv.t F1 V1. -Variable ge2: Genv.t F2 V2. -Hypothesis agree_on_symbols: - forall (s: ident), Genv.find_symbol ge2 s = Genv.find_symbol ge1 s. - -Lemma eval_operation_preserved: - forall sp op vl m, - eval_operation ge2 sp op vl m = eval_operation ge1 sp op vl m. -Proof. - intros. - unfold eval_operation; destruct op; try rewrite agree_on_symbols; - reflexivity. -Qed. - -Lemma eval_addressing_preserved: - forall sp addr vl, - eval_addressing ge2 sp addr vl = eval_addressing ge1 sp addr vl. -Proof. - intros. - assert (UNUSED: forall (s: ident), Genv.find_symbol ge2 s = Genv.find_symbol ge1 s). - exact agree_on_symbols. - unfold eval_addressing; destruct addr; try rewrite agree_on_symbols; - reflexivity. -Qed. - -End GENV_TRANSF. - -(** Recognition of move operations. *) - -Definition is_move_operation - (A: Type) (op: operation) (args: list A) : option A := - match op, args with - | Omove, arg :: nil => Some arg - | _, _ => None - end. - -Lemma is_move_operation_correct: - forall (A: Type) (op: operation) (args: list A) (a: A), - is_move_operation op args = Some a -> - op = Omove /\ args = a :: nil. -Proof. - intros until a. unfold is_move_operation; destruct op; - try (intros; discriminate). - destruct args. intros; discriminate. - destruct args. intros. intuition congruence. - intros; discriminate. -Qed. - -(** Static typing of conditions, operators and addressing modes. *) +(** * Static typing of conditions, operators and addressing modes. *) Definition type_of_condition (c: condition) : list typ := match c with @@ -455,10 +285,6 @@ Definition type_of_operation (op: operation) : list typ * typ := | Ofloatconst _ => (nil, Tfloat) | Oaddrsymbol _ _ => (nil, Tint) | Oaddrstack _ => (nil, Tint) - | Ocast8signed => (Tint :: nil, Tint) - | Ocast8unsigned => (Tint :: nil, Tint) - | Ocast16signed => (Tint :: nil, Tint) - | Ocast16unsigned => (Tint :: nil, Tint) | Oadd => (Tint :: Tint :: nil, Tint) | Oaddshift _ => (Tint :: Tint :: nil, Tint) | Oaddimm _ => (Tint :: nil, Tint) @@ -534,37 +360,54 @@ Lemma type_of_operation_sound: op <> Omove -> eval_operation genv sp op vl m = Some v -> Val.has_type v (snd (type_of_operation op)). -Proof. +Proof with (try exact I). + assert (S: forall s v, Val.has_type (eval_shift s v) Tint). + intros. unfold eval_shift. destruct s; destruct v; simpl; auto; rewrite s_range; exact I. intros. - destruct op; simpl in H0; FuncInv; try subst v; try exact I. + destruct op; simpl; simpl in H0; FuncInv; try subst v... congruence. - destruct (Genv.find_symbol genv i); simplify_eq H0; intro; subst v; exact I. - simpl. unfold offset_sp in H0. destruct sp; try discriminate. - inversion H0. exact I. - destruct v0; exact I. - destruct v0; exact I. - destruct v0; exact I. - destruct v0; exact I. - destruct (eq_block b b0). injection H0; intro; subst v; exact I. - discriminate. - destruct (Int.eq i0 Int.zero). discriminate. - injection H0; intro; subst v; exact I. - destruct (Int.eq i0 Int.zero). discriminate. - injection H0; intro; subst v; exact I. - destruct (Int.ltu i0 Int.iwordsize). - injection H0; intro; subst v; exact I. discriminate. - destruct (Int.ltu i0 Int.iwordsize). - injection H0; intro; subst v; exact I. discriminate. - destruct (Int.ltu i0 Int.iwordsize). - injection H0; intro; subst v; exact I. discriminate. - destruct (Int.ltu i (Int.repr 31)). - injection H0; intro; subst v; exact I. discriminate. - destruct v0; exact I. - destruct (Float.intoffloat f); simpl in H0; inv H0. exact I. - destruct (Float.intuoffloat f); simpl in H0; inv H0. exact I. - destruct (eval_condition c vl). - destruct b; injection H0; intro; subst v; exact I. - discriminate. + unfold symbol_address. destruct (Genv.find_symbol genv i)... + destruct sp... + destruct v0; destruct v1... + generalize (S s v1). destruct v0; destruct (eval_shift s v1); simpl; tauto. + destruct v0... + destruct v0; destruct v1... simpl. destruct (zeq b b0)... + generalize (S s v1). destruct v0; destruct (eval_shift s v1); simpl; intuition. destruct (zeq b b0)... + generalize (S s v1). destruct v0; destruct (eval_shift s v1); simpl; intuition. destruct (zeq b0 b)... + destruct v0... + destruct v0; destruct v1... + destruct v0; destruct v1; simpl in H0; inv H0. destruct (Int.eq i0 Int.zero); inv H2... + destruct v0; destruct v1; simpl in H0; inv H0. destruct (Int.eq i0 Int.zero); inv H2... + destruct v0; destruct v1... + generalize (S s v1). destruct v0; destruct (eval_shift s v1); simpl; tauto. + destruct v0... + destruct v0; destruct v1... + generalize (S s v1). destruct v0; destruct (eval_shift s v1); simpl; tauto. + destruct v0... + destruct v0; destruct v1... + generalize (S s v1). destruct v0; destruct (eval_shift s v1); simpl; tauto. + destruct v0... + destruct v0; destruct v1... + generalize (S s v1). destruct v0; destruct (eval_shift s v1); simpl; tauto. + destruct v0... + generalize (S s v0). destruct (eval_shift s v0); simpl; tauto. + destruct v0; destruct v1... simpl. destruct (Int.ltu i0 Int.iwordsize)... + destruct v0; destruct v1... simpl. destruct (Int.ltu i0 Int.iwordsize)... + destruct v0; destruct v1... simpl. destruct (Int.ltu i0 Int.iwordsize)... + apply S. + destruct v0; simpl in H0; inv H0. destruct (Int.ltu i (Int.repr 31)); inv H2... + destruct v0... + destruct v0... + destruct v0; destruct v1... + destruct v0; destruct v1... + destruct v0; destruct v1... + destruct v0; destruct v1... + destruct v0... + destruct v0; simpl in H0; inv H0. destruct (Float.intoffloat f); simpl in H2; inv H2... + destruct v0; simpl in H0; inv H0. destruct (Float.intuoffloat f); simpl in H2; inv H2... + destruct v0; simpl in H0; inv H0... + destruct v0; simpl in H0; inv H0... + destruct (eval_condition c vl m)... destruct b... Qed. Lemma type_of_chunk_correct: @@ -582,332 +425,263 @@ Qed. End SOUNDNESS. -(** Alternate definition of [eval_condition], [eval_op], [eval_addressing] - as total functions that return [Vundef] when not applicable - (instead of [None]). Used in the proof of [PPCgen]. *) +(** * Manipulating and transforming operations *) -Section EVAL_OP_TOTAL. +(** Constructing shift amounts. *) -Variable F V: Type. -Variable genv: Genv.t F V. +Program Definition mk_shift_amount (n: int) : shift_amount := + {| s_amount := Int.modu n Int.iwordsize; s_range := _ |}. +Next Obligation. + assert (0 <= Zmod (Int.unsigned n) 32 < 32). apply Z_mod_lt. omega. + unfold Int.ltu, Int.modu. change (Int.unsigned Int.iwordsize) with 32. + rewrite Int.unsigned_repr. apply zlt_true. omega. + assert (32 < Int.max_unsigned). compute; auto. omega. +Qed. -Definition find_symbol_offset (id: ident) (ofs: int) : val := - match Genv.find_symbol genv id with - | Some b => Vptr b ofs - | None => Vundef - end. +Lemma mk_shift_amount_eq: + forall n, Int.ltu n Int.iwordsize = true -> s_amount (mk_shift_amount n) = n. +Proof. + intros; simpl. unfold Int.modu. transitivity (Int.repr (Int.unsigned n)). + decEq. apply Zmod_small. apply Int.ltu_inv; auto. + apply Int.repr_unsigned. +Qed. -Definition eval_shift_total (s: shift) (v: val) : val := - match v with - | Vint n => Vint(eval_shift s n) - | _ => Vundef +(** Recognition of move operations. *) + +Definition is_move_operation + (A: Type) (op: operation) (args: list A) : option A := + match op, args with + | Omove, arg :: nil => Some arg + | _, _ => None end. -Definition eval_condition_total (cond: condition) (vl: list val) : val := - match cond, vl with - | Ccomp c, v1::v2::nil => Val.cmp c v1 v2 - | Ccompu c, v1::v2::nil => Val.cmpu c v1 v2 - | Ccompshift c s, v1::v2::nil => Val.cmp c v1 (eval_shift_total s v2) - | Ccompushift c s, v1::v2::nil => Val.cmpu c v1 (eval_shift_total s v2) - | Ccompimm c n, v1::nil => Val.cmp c v1 (Vint n) - | Ccompuimm c n, v1::nil => Val.cmpu c v1 (Vint n) - | Ccompf c, v1::v2::nil => Val.cmpf c v1 v2 - | Cnotcompf c, v1::v2::nil => Val.notbool(Val.cmpf c v1 v2) - | _, _ => Vundef +Lemma is_move_operation_correct: + forall (A: Type) (op: operation) (args: list A) (a: A), + is_move_operation op args = Some a -> + op = Omove /\ args = a :: nil. +Proof. + intros until a. unfold is_move_operation; destruct op; + try (intros; discriminate). + destruct args. intros; discriminate. + destruct args. intros. intuition congruence. + intros; discriminate. +Qed. + +(** [negate_condition cond] returns a condition that is logically + equivalent to the negation of [cond]. *) + +Definition negate_condition (cond: condition): condition := + match cond with + | Ccomp c => Ccomp(negate_comparison c) + | Ccompu c => Ccompu(negate_comparison c) + | Ccompshift c s => Ccompshift (negate_comparison c) s + | Ccompushift c s => Ccompushift (negate_comparison c) s + | Ccompimm c n => Ccompimm (negate_comparison c) n + | Ccompuimm c n => Ccompuimm (negate_comparison c) n + | Ccompf c => Cnotcompf c + | Cnotcompf c => Ccompf c end. -Definition eval_operation_total (sp: val) (op: operation) (vl: list val) : val := - match op, vl with - | Omove, v1::nil => v1 - | Ointconst n, nil => Vint n - | Ofloatconst n, nil => Vfloat n - | Oaddrsymbol s ofs, nil => find_symbol_offset s ofs - | Oaddrstack ofs, nil => Val.add sp (Vint ofs) - | Ocast8signed, v1::nil => Val.sign_ext 8 v1 - | Ocast8unsigned, v1::nil => Val.zero_ext 8 v1 - | Ocast16signed, v1::nil => Val.sign_ext 16 v1 - | Ocast16unsigned, v1::nil => Val.zero_ext 16 v1 - | Oadd, v1::v2::nil => Val.add v1 v2 - | Oaddshift s, v1::v2::nil => Val.add v1 (eval_shift_total s v2) - | Oaddimm n, v1::nil => Val.add v1 (Vint n) - | Osub, v1::v2::nil => Val.sub v1 v2 - | Osubshift s, v1::v2::nil => Val.sub v1 (eval_shift_total s v2) - | Orsubshift s, v1::v2::nil => Val.sub (eval_shift_total s v2) v1 - | Orsubimm n, v1::nil => Val.sub (Vint n) v1 - | Omul, v1::v2::nil => Val.mul v1 v2 - | Odiv, v1::v2::nil => Val.divs v1 v2 - | Odivu, v1::v2::nil => Val.divu v1 v2 - | Oand, v1::v2::nil => Val.and v1 v2 - | Oandshift s, v1::v2::nil => Val.and v1 (eval_shift_total s v2) - | Oandimm n, v1::nil => Val.and v1 (Vint n) - | Oor, v1::v2::nil => Val.or v1 v2 - | Oorshift s, v1::v2::nil => Val.or v1 (eval_shift_total s v2) - | Oorimm n, v1::nil => Val.or v1 (Vint n) - | Oxor, v1::v2::nil => Val.xor v1 v2 - | Oxorshift s, v1::v2::nil => Val.xor v1 (eval_shift_total s v2) - | Oxorimm n, v1::nil => Val.xor v1 (Vint n) - | Obic, v1::v2::nil => Val.and v1 (Val.notint v2) - | Obicshift s, v1::v2::nil => Val.and v1 (Val.notint (eval_shift_total s v2)) - | Onot, v1::nil => Val.notint v1 - | Onotshift s, v1::nil => Val.notint (eval_shift_total s v1) - | Oshl, v1::v2::nil => Val.shl v1 v2 - | Oshr, v1::v2::nil => Val.shr v1 v2 - | Oshru, v1::v2::nil => Val.shru v1 v2 - | Oshrximm n, v1::nil => Val.shrx v1 (Vint n) - | Oshift s, v1::nil => eval_shift_total s v1 - | Onegf, v1::nil => Val.negf v1 - | Oabsf, v1::nil => Val.absf v1 - | Oaddf, v1::v2::nil => Val.addf v1 v2 - | Osubf, v1::v2::nil => Val.subf v1 v2 - | Omulf, v1::v2::nil => Val.mulf v1 v2 - | Odivf, v1::v2::nil => Val.divf v1 v2 - | Osingleoffloat, v1::nil => Val.singleoffloat v1 - | Ointoffloat, v1::nil => Val.intoffloat v1 - | Ointuoffloat, v1::nil => Val.intuoffloat v1 - | Ofloatofint, v1::nil => Val.floatofint v1 - | Ofloatofintu, v1::nil => Val.floatofintu v1 - | Ocmp c, _ => eval_condition_total c vl - | _, _ => Vundef +Lemma eval_negate_condition: + forall (cond: condition) (vl: list val) (b: bool) (m: mem), + eval_condition cond vl m = Some b -> + eval_condition (negate_condition cond) vl m = Some (negb b). +Proof. + intros. + destruct cond; simpl in H; FuncInv; simpl. + rewrite Val.negate_cmp_bool; rewrite H; auto. + rewrite Val.negate_cmpu_bool; rewrite H; auto. + rewrite Val.negate_cmp_bool; rewrite H; auto. + rewrite Val.negate_cmpu_bool; rewrite H; auto. + rewrite Val.negate_cmp_bool; rewrite H; auto. + rewrite Val.negate_cmpu_bool; rewrite H; auto. + rewrite H; auto. + destruct (Val.cmpf_bool c v v0); simpl in H; inv H. rewrite negb_elim; auto. +Qed. + +(** Shifting stack-relative references. This is used in [Stacking]. *) + +Definition shift_stack_addressing (delta: int) (addr: addressing) := + match addr with + | Ainstack ofs => Ainstack (Int.add delta ofs) + | _ => addr end. -Definition eval_addressing_total - (sp: val) (addr: addressing) (vl: list val) : val := - match addr, vl with - | Aindexed n, v1::nil => Val.add v1 (Vint n) - | Aindexed2, v1::v2::nil => Val.add v1 v2 - | Aindexed2shift s, v1::v2::nil => Val.add v1 (eval_shift_total s v2) - | Ainstack ofs, nil => Val.add sp (Vint ofs) - | _, _ => Vundef +Definition shift_stack_operation (delta: int) (op: operation) := + match op with + | Oaddrstack ofs => Oaddrstack (Int.add delta ofs) + | _ => op end. -Lemma eval_compare_mismatch_weaken: - forall c b, - eval_compare_mismatch c = Some b -> - Val.cmp_mismatch c = Val.of_bool b. +Lemma type_shift_stack_addressing: + forall delta addr, type_of_addressing (shift_stack_addressing delta addr) = type_of_addressing addr. Proof. - unfold eval_compare_mismatch. intros. destruct c; inv H; auto. + intros. destruct addr; auto. Qed. -Lemma eval_compare_null_weaken: - forall c i b, - eval_compare_null c i = Some b -> - (if Int.eq i Int.zero then Val.cmp_mismatch c else Vundef) = Val.of_bool b. +Lemma type_shift_stack_operation: + forall delta op, type_of_operation (shift_stack_operation delta op) = type_of_operation op. Proof. - unfold eval_compare_null. intros. - destruct (Int.eq i Int.zero); try discriminate. - apply eval_compare_mismatch_weaken; auto. + intros. destruct op; auto. Qed. -Lemma eval_condition_weaken: - forall c vl b m, - eval_condition c vl m = Some b -> - eval_condition_total c vl = Val.of_bool b. +Lemma eval_shift_stack_addressing: + forall F V (ge: Genv.t F V) sp addr vl delta, + eval_addressing ge sp (shift_stack_addressing delta addr) vl = + eval_addressing ge (Val.add sp (Vint delta)) addr vl. Proof. - intros. - unfold eval_condition in H; destruct c; FuncInv; - try subst b; try reflexivity; simpl; - try (apply eval_compare_null_weaken; auto). - destruct (Mem.valid_pointer m b0 (Int.unsigned i) && - Mem.valid_pointer m b1 (Int.unsigned i0)); try discriminate. - unfold eq_block in H. destruct (zeq b0 b1); try congruence. - apply eval_compare_mismatch_weaken; auto. - symmetry. apply Val.notbool_negb_1. + intros. destruct addr; simpl; auto. + rewrite Val.add_assoc. simpl. auto. Qed. -Lemma eval_operation_weaken: - forall sp op vl v m, - eval_operation genv sp op vl m = Some v -> - eval_operation_total sp op vl = v. +Lemma eval_shift_stack_operation: + forall F V (ge: Genv.t F V) sp op vl m delta, + eval_operation ge sp (shift_stack_operation delta op) vl m = + eval_operation ge (Val.add sp (Vint delta)) op vl m. Proof. - intros. - unfold eval_operation in H; destruct op; FuncInv; - try subst v; try reflexivity; simpl. - unfold find_symbol_offset. - destruct (Genv.find_symbol genv i); try discriminate. - congruence. - unfold offset_sp in H. - destruct sp; try discriminate. simpl. congruence. - unfold eq_block in H. destruct (zeq b b0); congruence. - destruct (Int.eq i0 Int.zero); congruence. - destruct (Int.eq i0 Int.zero); congruence. - destruct (Int.ltu i0 Int.iwordsize); congruence. - destruct (Int.ltu i0 Int.iwordsize); congruence. - destruct (Int.ltu i0 Int.iwordsize); congruence. - unfold Int.ltu in H. destruct (zlt (Int.unsigned i) (Int.unsigned (Int.repr 31))). - unfold Int.ltu. rewrite zlt_true. congruence. - assert (Int.unsigned (Int.repr 31) < Int.unsigned Int.iwordsize). vm_compute; auto. - omega. discriminate. - destruct (Float.intoffloat f); simpl in H; inv H. auto. - destruct (Float.intuoffloat f); simpl in H; inv H. auto. - caseEq (eval_condition c vl m); intros; rewrite H0 in H. - replace v with (Val.of_bool b). - eapply eval_condition_weaken; eauto. - destruct b; simpl; congruence. - discriminate. + intros. destruct op; simpl; auto. + rewrite Val.add_assoc. simpl. auto. Qed. -Lemma eval_addressing_weaken: - forall sp addr vl v, - eval_addressing genv sp addr vl = Some v -> - eval_addressing_total sp addr vl = v. +(** Transformation of addressing modes with two operands or more + into an equivalent arithmetic operation. This is used in the [Reload] + pass when a store instruction cannot be reloaded directly because + it runs out of temporary registers. *) + +(** For the ARM, there are only two binary addressing mode: [Aindexed2] + and [Aindexed2shift]. The corresponding operations are [Oadd] + and [Oaddshift]. *) + +Definition op_for_binary_addressing (addr: addressing) : operation := + match addr with + | Aindexed2 => Oadd + | Aindexed2shift s => Oaddshift s + | _ => Ointconst Int.zero (* never happens *) + end. + +Lemma eval_op_for_binary_addressing: + forall (F V: Type) (ge: Genv.t F V) sp addr args v m, + (length args >= 2)%nat -> + eval_addressing ge sp addr args = Some v -> + eval_operation ge sp (op_for_binary_addressing addr) args m = Some v. Proof. intros. - unfold eval_addressing in H; destruct addr; FuncInv; - try subst v; simpl; try reflexivity. - decEq. apply Int.add_commut. - unfold offset_sp in H. destruct sp; simpl; congruence. + unfold eval_addressing in H0; destruct addr; FuncInv; simpl in H; try omegaContradiction; simpl. + congruence. + congruence. Qed. -Lemma eval_condition_total_is_bool: - forall cond vl, Val.is_bool (eval_condition_total cond vl). +Lemma type_op_for_binary_addressing: + forall addr, + (length (type_of_addressing addr) >= 2)%nat -> + type_of_operation (op_for_binary_addressing addr) = (type_of_addressing addr, Tint). Proof. - intros; destruct cond; - destruct vl; try apply Val.undef_is_bool; - destruct vl; try apply Val.undef_is_bool; - try (destruct vl; try apply Val.undef_is_bool); simpl. - apply Val.cmp_is_bool. - apply Val.cmpu_is_bool. - apply Val.cmp_is_bool. - apply Val.cmpu_is_bool. - apply Val.cmp_is_bool. - apply Val.cmpu_is_bool. - apply Val.cmpf_is_bool. - apply Val.notbool_is_bool. + intros. destruct addr; simpl in H; reflexivity || omegaContradiction. Qed. -End EVAL_OP_TOTAL. - -(** Compatibility of the evaluation functions with the - ``is less defined'' relation over values and memory states. *) +(** Two-address operations. There are none in the ARM architecture. *) -Section EVAL_LESSDEF. +Definition two_address_op (op: operation) : bool := false. -Variable F V: Type. -Variable genv: Genv.t F V. +(** Operations that are so cheap to recompute that CSE should not factor them out. *) -Ltac InvLessdef := - match goal with - | [ H: Val.lessdef (Vint _) _ |- _ ] => - inv H; InvLessdef - | [ H: Val.lessdef (Vfloat _) _ |- _ ] => - inv H; InvLessdef - | [ H: Val.lessdef (Vptr _ _) _ |- _ ] => - inv H; InvLessdef - | [ H: Val.lessdef_list nil _ |- _ ] => - inv H; InvLessdef - | [ H: Val.lessdef_list (_ :: _) _ |- _ ] => - inv H; InvLessdef - | _ => idtac +Definition is_trivial_op (op: operation) : bool := + match op with + | Omove => true + | Ointconst _ => true + | Oaddrstack _ => true + | _ => false end. -Lemma eval_condition_lessdef: - forall cond vl1 vl2 b m1 m2, - Val.lessdef_list vl1 vl2 -> - Mem.extends m1 m2 -> - eval_condition cond vl1 m1 = Some b -> - eval_condition cond vl2 m2 = Some b. -Proof. - intros. destruct cond; simpl in *; FuncInv; InvLessdef; auto. - destruct (Mem.valid_pointer m1 b0 (Int.unsigned i) && - Mem.valid_pointer m1 b1 (Int.unsigned i0)) as [] _eqn; try discriminate. - destruct (andb_prop _ _ Heqb2) as [A B]. - assert (forall b ofs, Mem.valid_pointer m1 b ofs = true -> Mem.valid_pointer m2 b ofs = true). - intros until ofs. repeat rewrite Mem.valid_pointer_nonempty_perm. - apply Mem.perm_extends; auto. - rewrite (H _ _ A). rewrite (H _ _ B). auto. -Qed. +(** Operations that depend on the memory state. *) -Ltac TrivialExists := - match goal with - | [ |- exists v2, Some ?v1 = Some v2 /\ Val.lessdef ?v1 v2 ] => - exists v1; split; [auto | constructor] - | _ => idtac +Definition op_depends_on_memory (op: operation) : bool := + match op with + | Ocmp (Ccompu _ | Ccompushift _ _) => true + | _ => false end. -Lemma eval_operation_lessdef: - forall sp op vl1 vl2 v1 m1 m2, - Val.lessdef_list vl1 vl2 -> - Mem.extends m1 m2 -> - eval_operation genv sp op vl1 m1 = Some v1 -> - exists v2, eval_operation genv sp op vl2 m2 = Some v2 /\ Val.lessdef v1 v2. -Proof. - intros. destruct op; simpl in *; FuncInv; InvLessdef; TrivialExists. - exists v2; auto. - destruct (Genv.find_symbol genv i); inv H1. TrivialExists. - exists v1; auto. - exists (Val.sign_ext 8 v2); split. auto. apply Val.sign_ext_lessdef; auto. - exists (Val.zero_ext 8 v2); split. auto. apply Val.zero_ext_lessdef; auto. - exists (Val.sign_ext 16 v2); split. auto. apply Val.sign_ext_lessdef; auto. - exists (Val.zero_ext 16 v2); split. auto. apply Val.zero_ext_lessdef; auto. - destruct (eq_block b b0); inv H1. TrivialExists. - destruct (Int.eq i0 Int.zero); inv H1; TrivialExists. - destruct (Int.eq i0 Int.zero); inv H1; TrivialExists. - destruct (Int.ltu i0 Int.iwordsize); inv H1; TrivialExists. - destruct (Int.ltu i0 Int.iwordsize); inv H1; TrivialExists. - destruct (Int.ltu i Int.iwordsize); inv H1; TrivialExists. - destruct (Int.ltu i0 Int.iwordsize); inv H2; TrivialExists. - destruct (Int.ltu i0 Int.iwordsize); inv H2; TrivialExists. - destruct (Int.ltu i (Int.repr 31)); inv H1; TrivialExists. - exists (Val.singleoffloat v2); split. auto. apply Val.singleoffloat_lessdef; auto. - destruct (Float.intoffloat f); simpl in *; inv H1. TrivialExists. - destruct (Float.intuoffloat f); simpl in *; inv H1. TrivialExists. - exists v1; split; auto. - destruct (eval_condition c vl1 m1) as [] _eqn. - rewrite (eval_condition_lessdef c H H0 Heqo). - auto. - discriminate. -Qed. - -Lemma eval_addressing_lessdef: - forall sp addr vl1 vl2 v1, - Val.lessdef_list vl1 vl2 -> - eval_addressing genv sp addr vl1 = Some v1 -> - exists v2, eval_addressing genv sp addr vl2 = Some v2 /\ Val.lessdef v1 v2. +Lemma op_depends_on_memory_correct: + forall (F V: Type) (ge: Genv.t F V) sp op args m1 m2, + op_depends_on_memory op = false -> + eval_operation ge sp op args m1 = eval_operation ge sp op args m2. Proof. - intros. destruct addr; simpl in *; FuncInv; InvLessdef; TrivialExists. - exists v1; auto. + intros until m2. destruct op; simpl; try congruence. + intros. destruct c; simpl; auto; congruence. Qed. -End EVAL_LESSDEF. +(** * Invariance and compatibility properties. *) -(** Shifting stack-relative references. This is used in [Stacking]. *) +(** [eval_operation] and [eval_addressing] depend on a global environment + for resolving references to global symbols. We show that they give + the same results if a global environment is replaced by another that + assigns the same addresses to the same symbols. *) -Definition shift_stack_addressing (delta: int) (addr: addressing) := - match addr with - | Ainstack ofs => Ainstack (Int.add delta ofs) - | _ => addr - end. +Section GENV_TRANSF. -Definition shift_stack_operation (delta: int) (op: operation) := - match op with - | Oaddrstack ofs => Oaddrstack (Int.add delta ofs) - | _ => op - end. +Variable F1 F2 V1 V2: Type. +Variable ge1: Genv.t F1 V1. +Variable ge2: Genv.t F2 V2. +Hypothesis agree_on_symbols: + forall (s: ident), Genv.find_symbol ge2 s = Genv.find_symbol ge1 s. -Lemma type_shift_stack_addressing: - forall delta addr, type_of_addressing (shift_stack_addressing delta addr) = type_of_addressing addr. +Lemma eval_operation_preserved: + forall sp op vl m, + eval_operation ge2 sp op vl m = eval_operation ge1 sp op vl m. Proof. - intros. destruct addr; auto. + intros. + unfold eval_operation; destruct op; auto. + unfold symbol_address. rewrite agree_on_symbols; auto. Qed. -Lemma type_shift_stack_operation: - forall delta op, type_of_operation (shift_stack_operation delta op) = type_of_operation op. +Lemma eval_addressing_preserved: + forall sp addr vl, + eval_addressing ge2 sp addr vl = eval_addressing ge1 sp addr vl. Proof. - intros. destruct op; auto. + intros. + assert (UNUSED: forall (s: ident), Genv.find_symbol ge2 s = Genv.find_symbol ge1 s). + exact agree_on_symbols. + unfold eval_addressing; destruct addr; auto. Qed. -(** Compatibility of the evaluation functions with memory injections. *) +End GENV_TRANSF. -Section EVAL_INJECT. +(** Compatibility of the evaluation functions with value injections. *) + +Section EVAL_COMPAT. Variable F V: Type. Variable genv: Genv.t F V. Variable f: meminj. -Hypothesis globals: meminj_preserves_globals genv f. -Variable sp1: block. -Variable sp2: block. -Variable delta: Z. -Hypothesis sp_inj: f sp1 = Some(sp2, delta). + +Hypothesis symbol_address_inj: + forall id ofs, + val_inject f (symbol_address genv id ofs) (symbol_address genv id ofs). + +Variable m1: mem. +Variable m2: mem. + +Hypothesis valid_pointer_inj: + forall b1 ofs b2 delta, + f b1 = Some(b2, delta) -> + Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true -> + Mem.valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true. + +Hypothesis valid_pointer_no_overflow: + forall b1 ofs b2 delta, + f b1 = Some(b2, delta) -> + Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true -> + 0 <= Int.unsigned ofs + Int.unsigned (Int.repr delta) <= Int.max_unsigned. + +Hypothesis valid_different_pointers_inj: + forall b1 ofs1 b2 ofs2 b1' delta1 b2' delta2, + b1 <> b2 -> + Mem.valid_pointer m1 b1 (Int.unsigned ofs1) = true -> + Mem.valid_pointer m1 b2 (Int.unsigned ofs2) = true -> + f b1 = Some (b1', delta1) -> + f b2 = Some (b2', delta2) -> + b1' <> b2' \/ + Int.unsigned (Int.add ofs1 (Int.repr delta1)) <> Int.unsigned (Int.add ofs2 (Int.repr delta2)). Ltac InvInject := match goal with @@ -924,202 +698,330 @@ Ltac InvInject := | _ => idtac end. -Lemma eval_condition_inject: - forall cond vl1 vl2 b m1 m2, +Remark val_add_inj: + forall v1 v1' v2 v2', + val_inject f v1 v1' -> val_inject f v2 v2' -> val_inject f (Val.add v1 v2) (Val.add v1' v2'). +Proof. + intros. inv H; inv H0; simpl; econstructor; eauto. + repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. + repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. +Qed. + +Remark val_sub_inj: + forall v1 v1' v2 v2', + val_inject f v1 v1' -> val_inject f v2 v2' -> val_inject f (Val.sub v1 v2) (Val.sub v1' v2'). +Proof. + intros. inv H; inv H0; simpl; auto. + econstructor; eauto. rewrite Int.sub_add_l. auto. + destruct (zeq b1 b0); auto. subst. rewrite H1 in H. inv H. rewrite zeq_true. + rewrite Int.sub_shifted. auto. +Qed. + +Remark eval_shift_inj: + forall s v v', val_inject f v v' -> val_inject f (eval_shift s v) (eval_shift s v'). +Proof. + intros. inv H; destruct s; simpl; auto; rewrite s_range; auto. +Qed. + +Lemma eval_condition_inj: + forall cond vl1 vl2 b, val_list_inject f vl1 vl2 -> - Mem.inject f m1 m2 -> eval_condition cond vl1 m1 = Some b -> eval_condition cond vl2 m2 = Some b. Proof. - intros. destruct cond; simpl in *; FuncInv; InvInject; auto. - destruct (Mem.valid_pointer m1 b0 (Int.unsigned i)) as [] _eqn; try discriminate. - destruct (Mem.valid_pointer m1 b1 (Int.unsigned i0)) as [] _eqn; try discriminate. - simpl in H1. - exploit Mem.valid_pointer_inject_val. eauto. eexact Heqb0. econstructor; eauto. - intros V1. rewrite V1. - exploit Mem.valid_pointer_inject_val. eauto. eexact Heqb2. econstructor; eauto. - intros V2. rewrite V2. - simpl. - destruct (eq_block b0 b1); inv H1. - rewrite H3 in H5; inv H5. rewrite dec_eq_true. +Opaque Int.add. + assert (CMP: + forall c v1 v2 v1' v2' b, + val_inject f v1 v1' -> + val_inject f v2 v2' -> + Val.cmp_bool c v1 v2 = Some b -> + Val.cmp_bool c v1' v2' = Some b). + intros. inv H; simpl in H1; try discriminate; inv H0; simpl in H1; try discriminate; simpl; auto. + + assert (CMPU: + forall c v1 v2 v1' v2' b, + val_inject f v1 v1' -> + val_inject f v2 v2' -> + Val.cmpu_bool (Mem.valid_pointer m1) c v1 v2 = Some b -> + Val.cmpu_bool (Mem.valid_pointer m2) c v1' v2' = Some b). + intros. inv H; simpl in H1; try discriminate; inv H0; simpl in H1; try discriminate; simpl; auto. + destruct (Mem.valid_pointer m1 b1 (Int.unsigned ofs1)) as []_eqn; try discriminate. + destruct (Mem.valid_pointer m1 b0 (Int.unsigned ofs0)) as []_eqn; try discriminate. + rewrite (valid_pointer_inj _ H2 Heqb4). + rewrite (valid_pointer_inj _ H Heqb0). simpl. + destruct (zeq b1 b0); simpl in H1. + inv H1. rewrite H in H2; inv H2. rewrite zeq_true. decEq. apply Int.translate_cmpu. - eapply Mem.valid_pointer_inject_no_overflow; eauto. - eapply Mem.valid_pointer_inject_no_overflow; eauto. - exploit Mem.different_pointers_inject; eauto. intros P. - destruct (eq_block b3 b4); auto. - destruct P. contradiction. - destruct c; unfold eval_compare_mismatch in *; inv H2. - unfold Int.cmpu. rewrite Int.eq_false; auto. congruence. - unfold Int.cmpu. rewrite Int.eq_false; auto. congruence. + eapply valid_pointer_no_overflow; eauto. + eapply valid_pointer_no_overflow; eauto. + exploit valid_different_pointers_inj; eauto. intros P. + destruct (zeq b2 b3); auto. + destruct P. congruence. + destruct c; simpl in H1; inv H1. + simpl; decEq. rewrite Int.eq_false; auto. congruence. + simpl; decEq. rewrite Int.eq_false; auto. congruence. + + intros. destruct cond; simpl in H0; FuncInv; InvInject; simpl. + eapply CMP; eauto. + eapply CMPU; eauto. + eapply CMP. eauto. eapply eval_shift_inj. eauto. auto. + eapply CMPU. eauto. eapply eval_shift_inj. eauto. auto. + eapply CMP; eauto. + eapply CMPU; eauto. + inv H3; inv H2; simpl in H0; inv H0; auto. + inv H3; inv H2; simpl in H0; inv H0; auto. Qed. -Ltac TrivialExists2 := +Ltac TrivialExists := match goal with | [ |- exists v2, Some ?v1 = Some v2 /\ val_inject _ _ v2 ] => - exists v1; split; [auto | econstructor; eauto] + exists v1; split; auto | _ => idtac end. -Lemma eval_addressing_inject: - forall addr vl1 vl2 v1, +Lemma eval_operation_inj: + forall op sp1 vl1 sp2 vl2 v1, + val_inject f sp1 sp2 -> val_list_inject f vl1 vl2 -> - eval_addressing genv (Vptr sp1 Int.zero) addr vl1 = Some v1 -> - exists v2, - eval_addressing genv (Vptr sp2 Int.zero) (shift_stack_addressing (Int.repr delta) addr) vl2 = Some v2 - /\ val_inject f v1 v2. + eval_operation genv sp1 op vl1 m1 = Some v1 -> + exists v2, eval_operation genv sp2 op vl2 m2 = Some v2 /\ val_inject f v1 v2. Proof. - assert (UNUSED: meminj_preserves_globals genv f). exact globals. - intros. destruct addr; simpl in *; FuncInv; InvInject; TrivialExists2. - repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - repeat rewrite Int.add_assoc. auto. - repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. + intros. destruct op; simpl in H1; simpl; FuncInv; InvInject; TrivialExists. + apply val_add_inj; auto. + apply val_add_inj; auto. + apply val_add_inj; auto. apply eval_shift_inj; auto. + apply val_add_inj; auto. + + apply val_sub_inj; auto. + apply val_sub_inj; auto. apply eval_shift_inj; auto. + apply val_sub_inj; auto. apply eval_shift_inj; auto. + apply (@val_sub_inj (Vint i) (Vint i) v v'); auto. + + inv H4; inv H2; simpl; auto. + inv H4; inv H3; simpl in H1; inv H1. simpl. + destruct (Int.eq i0 Int.zero); inv H2. TrivialExists. + inv H4; inv H3; simpl in H1; inv H1. simpl. + destruct (Int.eq i0 Int.zero); inv H2. TrivialExists. + + inv H4; inv H2; simpl; auto. + exploit (eval_shift_inj s). eexact H2. intros IS. inv H4; inv IS; simpl; auto. + inv H4; simpl; auto. + inv H4; inv H2; simpl; auto. + exploit (eval_shift_inj s). eexact H2. intros IS. inv H4; inv IS; simpl; auto. + inv H4; simpl; auto. + inv H4; inv H2; simpl; auto. + exploit (eval_shift_inj s). eexact H2. intros IS. inv H4; inv IS; simpl; auto. + inv H4; simpl; auto. + inv H4; inv H2; simpl; auto. + exploit (eval_shift_inj s). eexact H2. intros IS. inv H4; inv IS; simpl; auto. + + inv H4; simpl; auto. + exploit (eval_shift_inj s). eexact H4. intros IS. inv IS; simpl; auto. + + inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto. + inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto. + inv H4; inv H2; simpl; auto. destruct (Int.ltu i0 Int.iwordsize); auto. + apply eval_shift_inj; auto. + inv H4; simpl in H1; inv H1. simpl. destruct (Int.ltu i (Int.repr 31)); inv H2. TrivialExists. + + inv H4; simpl; auto. + inv H4; simpl; auto. + inv H4; inv H2; simpl; auto. + inv H4; inv H2; simpl; auto. + inv H4; inv H2; simpl; auto. + inv H4; inv H2; simpl; auto. + inv H4; simpl; auto. + + inv H4; simpl in H1; inv H1. simpl. destruct (Float.intoffloat f0); simpl in H2; inv H2. + exists (Vint i); auto. + inv H4; simpl in H1; inv H1. simpl. destruct (Float.intuoffloat f0); simpl in H2; inv H2. + exists (Vint i); auto. + inv H4; simpl in *; inv H1. TrivialExists. + inv H4; simpl in *; inv H1. TrivialExists. + + subst v1. destruct (eval_condition c vl1 m1) as []_eqn. + exploit eval_condition_inj; eauto. intros EQ; rewrite EQ. + destruct b; simpl; constructor. + simpl; constructor. Qed. -Lemma eval_operation_inject: - forall op vl1 vl2 v1 m1 m2, +Lemma eval_addressing_inj: + forall addr sp1 vl1 sp2 vl2 v1, + val_inject f sp1 sp2 -> val_list_inject f vl1 vl2 -> - Mem.inject f m1 m2 -> - eval_operation genv (Vptr sp1 Int.zero) op vl1 m1 = Some v1 -> - exists v2, - eval_operation genv (Vptr sp2 Int.zero) (shift_stack_operation (Int.repr delta) op) vl2 m2 = Some v2 - /\ val_inject f v1 v2. + eval_addressing genv sp1 addr vl1 = Some v1 -> + exists v2, eval_addressing genv sp2 addr vl2 = Some v2 /\ val_inject f v1 v2. Proof. - intros. destruct op; simpl in *; FuncInv; InvInject; TrivialExists2. - exists v'; auto. - destruct (Genv.find_symbol genv i) as [] _eqn; inv H1. - TrivialExists2. eapply (proj1 globals); eauto. rewrite Int.add_zero; auto. - repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - exists (Val.sign_ext 8 v'); split; auto. inv H4; simpl; auto. - exists (Val.zero_ext 8 v'); split; auto. inv H4; simpl; auto. - exists (Val.sign_ext 16 v'); split; auto. inv H4; simpl; auto. - exists (Val.zero_ext 16 v'); split; auto. inv H4; simpl; auto. - repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - rewrite Int.sub_add_l. auto. - destruct (eq_block b b0); inv H1. rewrite H3 in H5; inv H5. rewrite dec_eq_true. - rewrite Int.sub_shifted. TrivialExists2. - rewrite Int.sub_add_l. auto. - destruct (Int.eq i0 Int.zero); inv H1. TrivialExists2. - destruct (Int.eq i0 Int.zero); inv H1. TrivialExists2. - destruct (Int.ltu i0 Int.iwordsize); inv H1. TrivialExists2. - destruct (Int.ltu i0 Int.iwordsize); inv H1. TrivialExists2. - destruct (Int.ltu i0 Int.iwordsize); inv H1. TrivialExists2. - destruct (Int.ltu i (Int.repr 31)); inv H1. TrivialExists2. - exists (Val.singleoffloat v'); split; auto. inv H4; simpl; auto. - destruct (Float.intoffloat f0); simpl in *; inv H1. TrivialExists2. - destruct (Float.intuoffloat f0); simpl in *; inv H1. TrivialExists2. - destruct (eval_condition c vl1 m1) as [] _eqn; try discriminate. - exploit eval_condition_inject; eauto. intros EQ; rewrite EQ. - destruct b; inv H1; TrivialExists2. + assert (UNUSED: forall id ofs, + val_inject f (symbol_address genv id ofs) (symbol_address genv id ofs)). + exact symbol_address_inj. + intros. destruct addr; simpl in H1; simpl; FuncInv; InvInject; TrivialExists. + apply val_add_inj; auto. + apply val_add_inj; auto. + apply val_add_inj; auto. apply eval_shift_inj; auto. + apply val_add_inj; auto. Qed. -End EVAL_INJECT. +End EVAL_COMPAT. -(** Recognition of integers that are valid shift amounts. *) +(** Compatibility of the evaluation functions with the ``is less defined'' relation over values. *) -Definition is_shift_amount_aux (n: int) : - { Int.ltu n Int.iwordsize = true } + - { Int.ltu n Int.iwordsize = false }. -Proof. - case (Int.ltu n Int.iwordsize). left; auto. right; auto. -Defined. +Section EVAL_LESSDEF. -Definition is_shift_amount (n: int) : option shift_amount := - match is_shift_amount_aux n with - | left H => Some(mk_shift_amount n H) - | right _ => None - end. +Variable F V: Type. +Variable genv: Genv.t F V. -Lemma is_shift_amount_Some: - forall n s, is_shift_amount n = Some s -> s_amount s = n. +Remark valid_pointer_extends: + forall m1 m2, Mem.extends m1 m2 -> + forall b1 ofs b2 delta, + Some(b1, 0) = Some(b2, delta) -> + Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true -> + Mem.valid_pointer m2 b2 (Int.unsigned (Int.add ofs (Int.repr delta))) = true. Proof. - intros until s. unfold is_shift_amount. - destruct (is_shift_amount_aux n). - simpl. intros. inv H. reflexivity. - congruence. + intros. inv H0. rewrite Int.add_zero. eapply Mem.valid_pointer_extends; eauto. Qed. -Lemma is_shift_amount_None: - forall n, is_shift_amount n = None -> Int.ltu n Int.iwordsize = true -> False. +Remark valid_pointer_no_overflow_extends: + forall m1 b1 ofs b2 delta, + Some(b1, 0) = Some(b2, delta) -> + Mem.valid_pointer m1 b1 (Int.unsigned ofs) = true -> + 0 <= Int.unsigned ofs + Int.unsigned (Int.repr delta) <= Int.max_unsigned. Proof. - intro n. unfold is_shift_amount. - destruct (is_shift_amount_aux n). - congruence. - congruence. + intros. inv H. rewrite Zplus_0_r. apply Int.unsigned_range_2. Qed. -(** Transformation of addressing modes with two operands or more - into an equivalent arithmetic operation. This is used in the [Reload] - pass when a store instruction cannot be reloaded directly because - it runs out of temporary registers. *) - -(** For the ARM, there are only two binary addressing mode: [Aindexed2] - and [Aindexed2shift]. The corresponding operations are [Oadd] - and [Oaddshift]. *) +Remark valid_different_pointers_extends: + forall m1 b1 ofs1 b2 ofs2 b1' delta1 b2' delta2, + b1 <> b2 -> + Mem.valid_pointer m1 b1 (Int.unsigned ofs1) = true -> + Mem.valid_pointer m1 b2 (Int.unsigned ofs2) = true -> + Some(b1, 0) = Some (b1', delta1) -> + Some(b2, 0) = Some (b2', delta2) -> + b1' <> b2' \/ + Int.unsigned(Int.add ofs1 (Int.repr delta1)) <> Int.unsigned(Int.add ofs2 (Int.repr delta2)). +Proof. + intros. inv H2; inv H3. auto. +Qed. -Definition op_for_binary_addressing (addr: addressing) : operation := - match addr with - | Aindexed2 => Oadd - | Aindexed2shift s => Oaddshift s - | _ => Ointconst Int.zero (* never happens *) - end. +Lemma eval_condition_lessdef: + forall cond vl1 vl2 b m1 m2, + Val.lessdef_list vl1 vl2 -> + Mem.extends m1 m2 -> + eval_condition cond vl1 m1 = Some b -> + eval_condition cond vl2 m2 = Some b. +Proof. + intros. eapply eval_condition_inj with (f := fun b => Some(b, 0)) (m1 := m1). + apply valid_pointer_extends; auto. + apply valid_pointer_no_overflow_extends; auto. + apply valid_different_pointers_extends; auto. + rewrite <- val_list_inject_lessdef. eauto. auto. +Qed. -Lemma eval_op_for_binary_addressing: - forall (F V: Type) (ge: Genv.t F V) sp addr args v m, - (length args >= 2)%nat -> - eval_addressing ge sp addr args = Some v -> - eval_operation ge sp (op_for_binary_addressing addr) args m = Some v. +Lemma eval_operation_lessdef: + forall sp op vl1 vl2 v1 m1 m2, + Val.lessdef_list vl1 vl2 -> + Mem.extends m1 m2 -> + eval_operation genv sp op vl1 m1 = Some v1 -> + exists v2, eval_operation genv sp op vl2 m2 = Some v2 /\ Val.lessdef v1 v2. Proof. - intros. - unfold eval_addressing in H0; destruct addr; FuncInv; simpl in H; try omegaContradiction; simpl. - rewrite Int.add_commut. congruence. - congruence. - congruence. + intros. rewrite val_list_inject_lessdef in H. + assert (exists v2 : val, + eval_operation genv sp op vl2 m2 = Some v2 + /\ val_inject (fun b => Some(b, 0)) v1 v2). + eapply eval_operation_inj with (m1 := m1) (sp1 := sp). + intros. rewrite <- val_inject_lessdef; auto. + apply valid_pointer_extends; auto. + apply valid_pointer_no_overflow_extends; auto. + apply valid_different_pointers_extends; auto. + rewrite <- val_inject_lessdef; auto. + eauto. auto. + destruct H2 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. Qed. -Lemma type_op_for_binary_addressing: - forall addr, - (length (type_of_addressing addr) >= 2)%nat -> - type_of_operation (op_for_binary_addressing addr) = (type_of_addressing addr, Tint). +Lemma eval_addressing_lessdef: + forall sp addr vl1 vl2 v1, + Val.lessdef_list vl1 vl2 -> + eval_addressing genv sp addr vl1 = Some v1 -> + exists v2, eval_addressing genv sp addr vl2 = Some v2 /\ Val.lessdef v1 v2. Proof. - intros. destruct addr; simpl in H; reflexivity || omegaContradiction. + intros. rewrite val_list_inject_lessdef in H. + assert (exists v2 : val, + eval_addressing genv sp addr vl2 = Some v2 + /\ val_inject (fun b => Some(b, 0)) v1 v2). + eapply eval_addressing_inj with (sp1 := sp). + intros. rewrite <- val_inject_lessdef; auto. + rewrite <- val_inject_lessdef; auto. + eauto. auto. + destruct H1 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. Qed. -(** Two-address operations. There are none in the ARM architecture. *) +End EVAL_LESSDEF. -Definition two_address_op (op: operation) : bool := false. +(** Compatibility of the evaluation functions with memory injections. *) -(** Operations that are so cheap to recompute that CSE should not factor them out. *) +Section EVAL_INJECT. -Definition is_trivial_op (op: operation) : bool := - match op with - | Omove => true - | Ointconst _ => true - | Oaddrsymbol _ _ => true - | Oaddrstack _ => true - | _ => false - end. +Variable F V: Type. +Variable genv: Genv.t F V. +Variable f: meminj. +Hypothesis globals: meminj_preserves_globals genv f. +Variable sp1: block. +Variable sp2: block. +Variable delta: Z. +Hypothesis sp_inj: f sp1 = Some(sp2, delta). +Remark symbol_address_inject: + forall id ofs, val_inject f (symbol_address genv id ofs) (symbol_address genv id ofs). +Proof. + intros. unfold symbol_address. destruct (Genv.find_symbol genv id) as []_eqn; auto. + exploit (proj1 globals); eauto. intros. + econstructor; eauto. rewrite Int.add_zero; auto. +Qed. -(** Operations that depend on the memory state. *) +Lemma eval_condition_inject: + forall cond vl1 vl2 b m1 m2, + val_list_inject f vl1 vl2 -> + Mem.inject f m1 m2 -> + eval_condition cond vl1 m1 = Some b -> + eval_condition cond vl2 m2 = Some b. +Proof. + intros. eapply eval_condition_inj with (f := f) (m1 := m1); eauto. + intros; eapply Mem.valid_pointer_inject_val; eauto. + intros; eapply Mem.valid_pointer_inject_no_overflow; eauto. + intros; eapply Mem.different_pointers_inject; eauto. +Qed. -Definition op_depends_on_memory (op: operation) : bool := - match op with - | Ocmp (Ccompu _) => true - | _ => false - end. +Lemma eval_addressing_inject: + forall addr vl1 vl2 v1, + val_list_inject f vl1 vl2 -> + eval_addressing genv (Vptr sp1 Int.zero) addr vl1 = Some v1 -> + exists v2, + eval_addressing genv (Vptr sp2 Int.zero) (shift_stack_addressing (Int.repr delta) addr) vl2 = Some v2 + /\ val_inject f v1 v2. +Proof. + intros. + rewrite eval_shift_stack_addressing. simpl. + eapply eval_addressing_inj with (sp1 := Vptr sp1 Int.zero); eauto. + exact symbol_address_inject. +Qed. -Lemma op_depends_on_memory_correct: - forall (F V: Type) (ge: Genv.t F V) sp op args m1 m2, - op_depends_on_memory op = false -> - eval_operation ge sp op args m1 = eval_operation ge sp op args m2. +Lemma eval_operation_inject: + forall op vl1 vl2 v1 m1 m2, + val_list_inject f vl1 vl2 -> + Mem.inject f m1 m2 -> + eval_operation genv (Vptr sp1 Int.zero) op vl1 m1 = Some v1 -> + exists v2, + eval_operation genv (Vptr sp2 Int.zero) (shift_stack_operation (Int.repr delta) op) vl2 m2 = Some v2 + /\ val_inject f v1 v2. Proof. - intros until m2. destruct op; simpl; try congruence. - destruct c; simpl; congruence. + intros. + rewrite eval_shift_stack_operation. simpl. + eapply eval_operation_inj with (sp1 := Vptr sp1 Int.zero) (m1 := m1); eauto. + exact symbol_address_inject. + intros; eapply Mem.valid_pointer_inject_val; eauto. + intros; eapply Mem.valid_pointer_inject_no_overflow; eauto. + intros; eapply Mem.different_pointers_inject; eauto. Qed. +End EVAL_INJECT. diff --git a/arm/SelectOp.v b/arm/SelectOp.v index 65809019..64d15cbc 100644 --- a/arm/SelectOp.v +++ b/arm/SelectOp.v @@ -60,14 +60,9 @@ Definition addrstack (ofs: int) := (** ** Integer logical negation *) -(** The natural way to write smart constructors is by pattern-matching - on their arguments, recognizing cases where cheaper operators - or combined operators are applicable. For instance, integer logical - negation has three special cases (not-and, not-or and not-xor), - along with a default case that uses not-or over its arguments and itself. - This is written naively as follows: +(** Original definition: << -Definition notint (e: expr) := +Nondetfunction notint (e: expr) := match e with | Eop (Oshift s) (t1:::Enil) => Eop (Onotshift s) (t1:::Enil) | Eop Onot (t1:::Enil) => t1 @@ -75,80 +70,39 @@ Definition notint (e: expr) := | _ => Eop Onot (e:::Enil) end. >> - However, Coq expands complex pattern-matchings like the above into - elementary matchings over all constructors of an inductive type, - resulting in much duplication of the final catch-all case. - Such duplications generate huge executable code and duplicate - cases in the correctness proofs. - - To limit this duplication, we use the following trick due to - Yves Bertot. We first define a dependent inductive type that - characterizes the expressions that match each of the 4 cases of interest. *) Inductive notint_cases: forall (e: expr), Type := - | notint_case1: - forall s t1, - notint_cases (Eop (Oshift s) (t1:::Enil)) - | notint_case2: - forall t1, - notint_cases (Eop Onot (t1:::Enil)) - | notint_case3: - forall s t1, - notint_cases (Eop (Onotshift s) (t1:::Enil)) - | notint_default: - forall (e: expr), - notint_cases e. - -(** We then define a classification function that takes an expression - and return the case in which it falls. Note that the catch-all case - [notint_default] does not state that it is mutually exclusive with - the first three, more specific cases. The classification function - nonetheless chooses the specific cases in preference to the catch-all - case. *) + | notint_case1: forall s t1, notint_cases (Eop (Oshift s) (t1:::Enil)) + | notint_case2: forall t1, notint_cases (Eop Onot (t1:::Enil)) + | notint_case3: forall s t1, notint_cases (Eop (Onotshift s) (t1:::Enil)) + | notint_default: forall (e: expr), notint_cases e. Definition notint_match (e: expr) := - match e as z1 return notint_cases z1 with - | Eop (Oshift s) (t1:::Enil) => - notint_case1 s t1 - | Eop Onot (t1:::Enil) => - notint_case2 t1 - | Eop (Onotshift s) (t1:::Enil) => - notint_case3 s t1 - | e => - notint_default e - end. - -(** Finally, the [notint] function we need is defined by a 4-case match - over the result of the classification function. Thus, no duplication - of the right-hand sides of this match occur, and the proof has only - 4 cases to consider (it proceeds by case over [notint_match e]). - Since the default case is not obviously exclusive with the three - specific cases, it is important that its right-hand side is - semantically correct for all possible values of [e], which is the - case here and for all other smart constructors. *) + match e as zz1 return notint_cases zz1 with + | Eop (Oshift s) (t1:::Enil) => notint_case1 s t1 + | Eop Onot (t1:::Enil) => notint_case2 t1 + | Eop (Onotshift s) (t1:::Enil) => notint_case3 s t1 + | e => notint_default e + end. Definition notint (e: expr) := match notint_match e with - | notint_case1 s t1 => + | notint_case1 s t1 => (* Eop (Oshift s) (t1:::Enil) *) Eop (Onotshift s) (t1:::Enil) - | notint_case2 t1 => + | notint_case2 t1 => (* Eop Onot (t1:::Enil) *) t1 - | notint_case3 s t1 => + | notint_case3 s t1 => (* Eop (Onotshift s) (t1:::Enil) *) Eop (Oshift s) (t1:::Enil) | notint_default e => Eop Onot (e:::Enil) end. -(** This programming pattern will be applied systematically for the - other smart constructors in this file. *) (** ** Boolean negation *) -Definition notbool_base (e: expr) := - Eop (Ocmp (Ccompuimm Ceq Int.zero)) (e ::: Enil). - Fixpoint notbool (e: expr) {struct e} : expr := + let default := Eop (Ocmp (Ccompuimm Ceq Int.zero)) (e ::: Enil) in match e with | Eop (Ointconst n) Enil => Eop (Ointconst (if Int.eq n Int.zero then Int.one else Int.zero)) Enil @@ -157,15 +111,14 @@ Fixpoint notbool (e: expr) {struct e} : expr := | Econdition e1 e2 e3 => Econdition e1 (notbool e2) (notbool e3) | _ => - notbool_base e + default end. (** ** Integer addition and pointer addition *) -(** Addition of an integer constant. *) - -(* -Definition addimm (n: int) (e: expr) := +(** Original definition: +<< +Nondetfunction addimm (n: int) (e: expr) := if Int.eq n Int.zero then e else match e with | Eop (Ointconst m) Enil => Eop (Ointconst(Int.add n m)) Enil @@ -174,372 +127,292 @@ Definition addimm (n: int) (e: expr) := | Eop (Oaddimm m) (t ::: Enil) => Eop (Oaddimm(Int.add n m)) (t ::: Enil) | _ => Eop (Oaddimm n) (e ::: Enil) end. +>> *) Inductive addimm_cases: forall (e: expr), Type := - | addimm_case1: - forall m, - addimm_cases (Eop (Ointconst m) Enil) - | addimm_case2: - forall s m, - addimm_cases (Eop (Oaddrsymbol s m) Enil) - | addimm_case3: - forall m, - addimm_cases (Eop (Oaddrstack m) Enil) - | addimm_case4: - forall m t, - addimm_cases (Eop (Oaddimm m) (t ::: Enil)) - | addimm_default: - forall (e: expr), - addimm_cases e. + | addimm_case1: forall m, addimm_cases (Eop (Ointconst m) Enil) + | addimm_case2: forall s m, addimm_cases (Eop (Oaddrsymbol s m) Enil) + | addimm_case3: forall m, addimm_cases (Eop (Oaddrstack m) Enil) + | addimm_case4: forall m t, addimm_cases (Eop (Oaddimm m) (t ::: Enil)) + | addimm_default: forall (e: expr), addimm_cases e. Definition addimm_match (e: expr) := - match e as z1 return addimm_cases z1 with - | Eop (Ointconst m) Enil => - addimm_case1 m - | Eop (Oaddrsymbol s m) Enil => - addimm_case2 s m - | Eop (Oaddrstack m) Enil => - addimm_case3 m - | Eop (Oaddimm m) (t ::: Enil) => - addimm_case4 m t - | e => - addimm_default e + match e as zz1 return addimm_cases zz1 with + | Eop (Ointconst m) Enil => addimm_case1 m + | Eop (Oaddrsymbol s m) Enil => addimm_case2 s m + | Eop (Oaddrstack m) Enil => addimm_case3 m + | Eop (Oaddimm m) (t ::: Enil) => addimm_case4 m t + | e => addimm_default e end. Definition addimm (n: int) (e: expr) := - if Int.eq n Int.zero then e else - match addimm_match e with - | addimm_case1 m => + if Int.eq n Int.zero then e else match addimm_match e with + | addimm_case1 m => (* Eop (Ointconst m) Enil *) Eop (Ointconst(Int.add n m)) Enil - | addimm_case2 s m => + | addimm_case2 s m => (* Eop (Oaddrsymbol s m) Enil *) Eop (Oaddrsymbol s (Int.add n m)) Enil - | addimm_case3 m => + | addimm_case3 m => (* Eop (Oaddrstack m) Enil *) Eop (Oaddrstack (Int.add n m)) Enil - | addimm_case4 m t => + | addimm_case4 m t => (* Eop (Oaddimm m) (t ::: Enil) *) Eop (Oaddimm(Int.add n m)) (t ::: Enil) | addimm_default e => Eop (Oaddimm n) (e ::: Enil) end. -(** Addition of two integer or pointer expressions. *) -(* -Definition add (e1: expr) (e2: expr) := +(** Original definition: +<< +Nondetfunction add (e1: expr) (e2: expr) := match e1, e2 with | Eop (Ointconst n1) Enil, t2 => addimm n1 t2 - | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => addimm (Int.add n1 n2) (Eop Oadd (t1:::t2:::Enil)) - | Eop(Oaddimm n1) (t1:::Enil)), t2 => addimm n1 (Eop Oadd (t1:::t2:::Enil)) + | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => + addimm (Int.add n1 n2) (Eop Oadd (t1:::t2:::Enil)) + | Eop(Oaddimm n1) (t1:::Enil), t2 => addimm n1 (Eop Oadd (t1:::t2:::Enil)) | t1, Eop (Ointconst n2) Enil => addimm n2 t1 | t1, Eop (Oaddimm n2) (t2:::Enil) => addimm n2 (Eop Oadd (t1:::t2:::Enil)) | Eop (Oshift s) (t1:::Enil), t2 => Eop (Oaddshift s) (t2:::t1:::Enil) | t1, Eop (Oshift s) (t2:::Enil) => Eop (Oaddshift s) (t1:::t2:::Enil) | _, _ => Eop Oadd (e1:::e2:::Enil) end. +>> *) Inductive add_cases: forall (e1: expr) (e2: expr), Type := - | add_case1: - forall n1 t2, - add_cases (Eop (Ointconst n1) Enil) (t2) - | add_case2: - forall n1 t1 n2 t2, - add_cases (Eop (Oaddimm n1) (t1:::Enil)) (Eop (Oaddimm n2) (t2:::Enil)) - | add_case3: - forall n1 t1 t2, - add_cases (Eop (Oaddimm n1) (t1:::Enil)) (t2) - | add_case4: - forall t1 n2, - add_cases (t1) (Eop (Ointconst n2) Enil) - | add_case5: - forall t1 n2 t2, - add_cases (t1) (Eop (Oaddimm n2) (t2:::Enil)) - | add_case6: - forall s t1 t2, - add_cases (Eop (Oshift s) (t1:::Enil)) (t2) - | add_case7: - forall t1 s t2, - add_cases (t1) (Eop (Oshift s) (t2:::Enil)) - | add_default: - forall (e1: expr) (e2: expr), - add_cases e1 e2. + | add_case1: forall n1 t2, add_cases (Eop (Ointconst n1) Enil) (t2) + | add_case2: forall n1 t1 n2 t2, add_cases (Eop (Oaddimm n1) (t1:::Enil)) (Eop (Oaddimm n2) (t2:::Enil)) + | add_case3: forall n1 t1 t2, add_cases (Eop(Oaddimm n1) (t1:::Enil)) (t2) + | add_case4: forall t1 n2, add_cases (t1) (Eop (Ointconst n2) Enil) + | add_case5: forall t1 n2 t2, add_cases (t1) (Eop (Oaddimm n2) (t2:::Enil)) + | add_case6: forall s t1 t2, add_cases (Eop (Oshift s) (t1:::Enil)) (t2) + | add_case7: forall t1 s t2, add_cases (t1) (Eop (Oshift s) (t2:::Enil)) + | add_default: forall (e1: expr) (e2: expr), add_cases e1 e2. Definition add_match (e1: expr) (e2: expr) := - match e1 as z1, e2 as z2 return add_cases z1 z2 with - | Eop (Ointconst n1) Enil, t2 => - add_case1 n1 t2 - | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => - add_case2 n1 t1 n2 t2 - | Eop(Oaddimm n1) (t1:::Enil), t2 => - add_case3 n1 t1 t2 - | t1, Eop (Ointconst n2) Enil => - add_case4 t1 n2 - | t1, Eop (Oaddimm n2) (t2:::Enil) => - add_case5 t1 n2 t2 - | Eop (Oshift s) (t1:::Enil), t2 => - add_case6 s t1 t2 - | t1, Eop (Oshift s) (t2:::Enil) => - add_case7 t1 s t2 - | e1, e2 => - add_default e1 e2 + match e1 as zz1, e2 as zz2 return add_cases zz1 zz2 with + | Eop (Ointconst n1) Enil, t2 => add_case1 n1 t2 + | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => add_case2 n1 t1 n2 t2 + | Eop(Oaddimm n1) (t1:::Enil), t2 => add_case3 n1 t1 t2 + | t1, Eop (Ointconst n2) Enil => add_case4 t1 n2 + | t1, Eop (Oaddimm n2) (t2:::Enil) => add_case5 t1 n2 t2 + | Eop (Oshift s) (t1:::Enil), t2 => add_case6 s t1 t2 + | t1, Eop (Oshift s) (t2:::Enil) => add_case7 t1 s t2 + | e1, e2 => add_default e1 e2 end. Definition add (e1: expr) (e2: expr) := match add_match e1 e2 with - | add_case1 n1 t2 => + | add_case1 n1 t2 => (* Eop (Ointconst n1) Enil, t2 *) addimm n1 t2 - | add_case2 n1 t1 n2 t2 => + | add_case2 n1 t1 n2 t2 => (* Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) *) addimm (Int.add n1 n2) (Eop Oadd (t1:::t2:::Enil)) - | add_case3 n1 t1 t2 => + | add_case3 n1 t1 t2 => (* Eop(Oaddimm n1) (t1:::Enil), t2 *) addimm n1 (Eop Oadd (t1:::t2:::Enil)) - | add_case4 t1 n2 => + | add_case4 t1 n2 => (* t1, Eop (Ointconst n2) Enil *) addimm n2 t1 - | add_case5 t1 n2 t2 => + | add_case5 t1 n2 t2 => (* t1, Eop (Oaddimm n2) (t2:::Enil) *) addimm n2 (Eop Oadd (t1:::t2:::Enil)) - | add_case6 s t1 t2 => + | add_case6 s t1 t2 => (* Eop (Oshift s) (t1:::Enil), t2 *) Eop (Oaddshift s) (t2:::t1:::Enil) - | add_case7 t1 s t2 => + | add_case7 t1 s t2 => (* t1, Eop (Oshift s) (t2:::Enil) *) Eop (Oaddshift s) (t1:::t2:::Enil) | add_default e1 e2 => Eop Oadd (e1:::e2:::Enil) end. + (** ** Integer and pointer subtraction *) -(* -Definition sub (e1: expr) (e2: expr) := +(** Original definition: +<< +Nondetfunction sub (e1: expr) (e2: expr) := match e1, e2 with | t1, Eop (Ointconst n2) Enil => addimm (Int.neg n2) t1 - | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => addimm (intsub n1 n2) (Eop Osub (t1:::t2:::Enil)) - | Eop (Oaddimm n1) (t1:::Enil), t2 => addimm n1 (Eop Osub (t1:::t2:::Rnil)) - | t1, Eop (Oaddimm n2) (t2:::Enil) => addimm (Int.neg n2) (Eop Osub (t1::::t2:::Enil)) + | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => + addimm (Int.sub n1 n2) (Eop Osub (t1:::t2:::Enil)) + | Eop (Oaddimm n1) (t1:::Enil), t2 => + addimm n1 (Eop Osub (t1:::t2:::Enil)) + | t1, Eop (Oaddimm n2) (t2:::Enil) => + addimm (Int.neg n2) (Eop Osub (t1:::t2:::Enil)) | Eop (Ointconst n1) Enil, t2 => Eop (Orsubimm n1) (t2:::Enil) | Eop (Oshift s) (t1:::Enil), t2 => Eop (Orsubshift s) (t2:::t1:::Enil) | t1, Eop (Oshift s) (t2:::Enil) => Eop (Osubshift s) (t1:::t2:::Enil) | _, _ => Eop Osub (e1:::e2:::Enil) end. +>> *) Inductive sub_cases: forall (e1: expr) (e2: expr), Type := - | sub_case1: - forall t1 n2, - sub_cases (t1) (Eop (Ointconst n2) Enil) - | sub_case2: - forall n1 t1 n2 t2, - sub_cases (Eop (Oaddimm n1) (t1:::Enil)) (Eop (Oaddimm n2) (t2:::Enil)) - | sub_case3: - forall n1 t1 t2, - sub_cases (Eop (Oaddimm n1) (t1:::Enil)) (t2) - | sub_case4: - forall t1 n2 t2, - sub_cases (t1) (Eop (Oaddimm n2) (t2:::Enil)) - | sub_case5: - forall n1 t2, - sub_cases (Eop (Ointconst n1) Enil) (t2) - | sub_case6: - forall s t1 t2, - sub_cases (Eop (Oshift s) (t1:::Enil)) (t2) - | sub_case7: - forall t1 s t2, - sub_cases (t1) (Eop (Oshift s) (t2:::Enil)) - | sub_default: - forall (e1: expr) (e2: expr), - sub_cases e1 e2. + | sub_case1: forall t1 n2, sub_cases (t1) (Eop (Ointconst n2) Enil) + | sub_case2: forall n1 t1 n2 t2, sub_cases (Eop (Oaddimm n1) (t1:::Enil)) (Eop (Oaddimm n2) (t2:::Enil)) + | sub_case3: forall n1 t1 t2, sub_cases (Eop (Oaddimm n1) (t1:::Enil)) (t2) + | sub_case4: forall t1 n2 t2, sub_cases (t1) (Eop (Oaddimm n2) (t2:::Enil)) + | sub_case5: forall n1 t2, sub_cases (Eop (Ointconst n1) Enil) (t2) + | sub_case6: forall s t1 t2, sub_cases (Eop (Oshift s) (t1:::Enil)) (t2) + | sub_case7: forall t1 s t2, sub_cases (t1) (Eop (Oshift s) (t2:::Enil)) + | sub_default: forall (e1: expr) (e2: expr), sub_cases e1 e2. Definition sub_match (e1: expr) (e2: expr) := - match e1 as z1, e2 as z2 return sub_cases z1 z2 with - | t1, Eop (Ointconst n2) Enil => - sub_case1 t1 n2 - | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => - sub_case2 n1 t1 n2 t2 - | Eop (Oaddimm n1) (t1:::Enil), t2 => - sub_case3 n1 t1 t2 - | t1, Eop (Oaddimm n2) (t2:::Enil) => - sub_case4 t1 n2 t2 - | Eop (Ointconst n1) Enil, t2 => - sub_case5 n1 t2 - | Eop (Oshift s) (t1:::Enil), t2 => - sub_case6 s t1 t2 - | t1, Eop (Oshift s) (t2:::Enil) => - sub_case7 t1 s t2 - | e1, e2 => - sub_default e1 e2 + match e1 as zz1, e2 as zz2 return sub_cases zz1 zz2 with + | t1, Eop (Ointconst n2) Enil => sub_case1 t1 n2 + | Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) => sub_case2 n1 t1 n2 t2 + | Eop (Oaddimm n1) (t1:::Enil), t2 => sub_case3 n1 t1 t2 + | t1, Eop (Oaddimm n2) (t2:::Enil) => sub_case4 t1 n2 t2 + | Eop (Ointconst n1) Enil, t2 => sub_case5 n1 t2 + | Eop (Oshift s) (t1:::Enil), t2 => sub_case6 s t1 t2 + | t1, Eop (Oshift s) (t2:::Enil) => sub_case7 t1 s t2 + | e1, e2 => sub_default e1 e2 end. Definition sub (e1: expr) (e2: expr) := match sub_match e1 e2 with - | sub_case1 t1 n2 => + | sub_case1 t1 n2 => (* t1, Eop (Ointconst n2) Enil *) addimm (Int.neg n2) t1 - | sub_case2 n1 t1 n2 t2 => + | sub_case2 n1 t1 n2 t2 => (* Eop (Oaddimm n1) (t1:::Enil), Eop (Oaddimm n2) (t2:::Enil) *) addimm (Int.sub n1 n2) (Eop Osub (t1:::t2:::Enil)) - | sub_case3 n1 t1 t2 => + | sub_case3 n1 t1 t2 => (* Eop (Oaddimm n1) (t1:::Enil), t2 *) addimm n1 (Eop Osub (t1:::t2:::Enil)) - | sub_case4 t1 n2 t2 => + | sub_case4 t1 n2 t2 => (* t1, Eop (Oaddimm n2) (t2:::Enil) *) addimm (Int.neg n2) (Eop Osub (t1:::t2:::Enil)) - | sub_case5 n1 t2 => + | sub_case5 n1 t2 => (* Eop (Ointconst n1) Enil, t2 *) Eop (Orsubimm n1) (t2:::Enil) - | sub_case6 s t1 t2 => + | sub_case6 s t1 t2 => (* Eop (Oshift s) (t1:::Enil), t2 *) Eop (Orsubshift s) (t2:::t1:::Enil) - | sub_case7 t1 s t2 => + | sub_case7 t1 s t2 => (* t1, Eop (Oshift s) (t2:::Enil) *) Eop (Osubshift s) (t1:::t2:::Enil) | sub_default e1 e2 => Eop Osub (e1:::e2:::Enil) end. + +Definition negint (e: expr) := Eop (Orsubimm Int.zero) (e ::: Enil). + (** ** Immediate shifts *) -(* -Definition shlimm (e1: expr) := - if Int.eq n Int.zero then e1 else - match e1 with - | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shl n1 n)) - | Eop (Oshift (Olsl n1)) (t1:::Enil) => if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshift (Olsl (Int.add n n1))) (t1:::Enil) else Eop (Oshift (Olsl n)) (e1:::Enil) - | _ => Eop (Oshift (Olsl n)) (e1:::Enil) - end. +(** Original definition: +<< +Nondetfunction shlimm (e1: expr) (n: int) := + if Int.eq n Int.zero then + e1 + else if negb (Int.ltu n Int.iwordsize) then + Eop Oshl (e1 ::: Eop (Ointconst n) Enil ::: Enil) + else match e1 with + | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shl n1 n)) Enil + | Eop (Oshift (Slsl n1)) (t1:::Enil) => + if Int.ltu (Int.add n n1) Int.iwordsize + then Eop (Oshift (Slsl (mk_shift_amount(Int.add n n1)))) (t1:::Enil) + else Eop (Oshift (Slsl (mk_shift_amount n))) (e1:::Enil) + | _ => Eop (Oshift (Slsl (mk_shift_amount n))) (e1:::Enil) + end. +>> *) -Inductive shlimm_cases: forall (e1: expr), Type := - | shlimm_case1: - forall n1, - shlimm_cases (Eop (Ointconst n1) Enil) - | shlimm_case2: - forall n1 t1, - shlimm_cases (Eop (Oshift (Slsl n1)) (t1:::Enil)) - | shlimm_default: - forall (e1: expr), - shlimm_cases e1. - -Definition shlimm_match (e1: expr) := - match e1 as z1 return shlimm_cases z1 with - | Eop (Ointconst n1) Enil => - shlimm_case1 n1 - | Eop (Oshift (Slsl n1)) (t1:::Enil) => - shlimm_case2 n1 t1 - | e1 => - shlimm_default e1 +Inductive shlimm_cases: forall (e1: expr) , Type := + | shlimm_case1: forall n1, shlimm_cases (Eop (Ointconst n1) Enil) + | shlimm_case2: forall n1 t1, shlimm_cases (Eop (Oshift (Slsl n1)) (t1:::Enil)) + | shlimm_default: forall (e1: expr) , shlimm_cases e1. + +Definition shlimm_match (e1: expr) := + match e1 as zz1 return shlimm_cases zz1 with + | Eop (Ointconst n1) Enil => shlimm_case1 n1 + | Eop (Oshift (Slsl n1)) (t1:::Enil) => shlimm_case2 n1 t1 + | e1 => shlimm_default e1 end. Definition shlimm (e1: expr) (n: int) := - if Int.eq n Int.zero then e1 else - match is_shift_amount n with - | None => Eop Oshl (e1 ::: Eop (Ointconst n) Enil ::: Enil) - | Some n' => - match shlimm_match e1 with - | shlimm_case1 n1 => - Eop (Ointconst(Int.shl n1 n)) Enil - | shlimm_case2 n1 t1 => - match is_shift_amount (Int.add n (s_amount n1)) with - | None => - Eop (Oshift (Slsl n')) (e1:::Enil) - | Some n'' => - Eop (Oshift (Slsl n'')) (t1:::Enil) - end - | shlimm_default e1 => - Eop (Oshift (Slsl n')) (e1:::Enil) - end - end. - -(* -Definition shruimm (e1: expr) := - if Int.eq n Int.zero then e1 else - match e1 with - | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shru n1 n)) - | Eop (Oshift (Olsr n1)) (t1:::Enil) => if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshift (Olsr (Int.add n n1))) (t1:::Enil) else Eop (Oshift (Olsr n)) (e1:::Enil) - | _ => Eop (Oshift (Olsr n)) (e1:::Enil) + if Int.eq n Int.zero then e1 else if negb (Int.ltu n Int.iwordsize) then Eop Oshl (e1 ::: Eop (Ointconst n) Enil ::: Enil) else match shlimm_match e1 with + | shlimm_case1 n1 => (* Eop (Ointconst n1) Enil *) + Eop (Ointconst(Int.shl n1 n)) Enil + | shlimm_case2 n1 t1 => (* Eop (Oshift (Slsl n1)) (t1:::Enil) *) + if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshift (Slsl (mk_shift_amount(Int.add n n1)))) (t1:::Enil) else Eop (Oshift (Slsl (mk_shift_amount n))) (e1:::Enil) + | shlimm_default e1 => + Eop (Oshift (Slsl (mk_shift_amount n))) (e1:::Enil) end. + + +(** Original definition: +<< +Nondetfunction shruimm (e1: expr) (n: int) := + if Int.eq n Int.zero then + e1 + else if negb (Int.ltu n Int.iwordsize) then + Eop Oshru (e1 ::: Eop (Ointconst n) Enil ::: Enil) + else match e1 with + | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shru n1 n)) Enil + | Eop (Oshift (Slsr n1)) (t1:::Enil) => + if Int.ltu (Int.add n n1) Int.iwordsize + then Eop (Oshift (Slsr (mk_shift_amount (Int.add n n1)))) (t1:::Enil) + else Eop (Oshift (Slsr (mk_shift_amount n))) (e1:::Enil) + | _ => Eop (Oshift (Slsr (mk_shift_amount n))) (e1:::Enil) + end. +>> *) -Inductive shruimm_cases: forall (e1: expr), Type := - | shruimm_case1: - forall n1, - shruimm_cases (Eop (Ointconst n1) Enil) - | shruimm_case2: - forall n1 t1, - shruimm_cases (Eop (Oshift (Slsr n1)) (t1:::Enil)) - | shruimm_default: - forall (e1: expr), - shruimm_cases e1. - -Definition shruimm_match (e1: expr) := - match e1 as z1 return shruimm_cases z1 with - | Eop (Ointconst n1) Enil => - shruimm_case1 n1 - | Eop (Oshift (Slsr n1)) (t1:::Enil) => - shruimm_case2 n1 t1 - | e1 => - shruimm_default e1 +Inductive shruimm_cases: forall (e1: expr) , Type := + | shruimm_case1: forall n1, shruimm_cases (Eop (Ointconst n1) Enil) + | shruimm_case2: forall n1 t1, shruimm_cases (Eop (Oshift (Slsr n1)) (t1:::Enil)) + | shruimm_default: forall (e1: expr) , shruimm_cases e1. + +Definition shruimm_match (e1: expr) := + match e1 as zz1 return shruimm_cases zz1 with + | Eop (Ointconst n1) Enil => shruimm_case1 n1 + | Eop (Oshift (Slsr n1)) (t1:::Enil) => shruimm_case2 n1 t1 + | e1 => shruimm_default e1 end. Definition shruimm (e1: expr) (n: int) := - if Int.eq n Int.zero then e1 else - match is_shift_amount n with - | None => Eop Oshru (e1 ::: Eop (Ointconst n) Enil ::: Enil) - | Some n' => - match shruimm_match e1 with - | shruimm_case1 n1 => - Eop (Ointconst(Int.shru n1 n)) Enil - | shruimm_case2 n1 t1 => - match is_shift_amount (Int.add n (s_amount n1)) with - | None => - Eop (Oshift (Slsr n')) (e1:::Enil) - | Some n'' => - Eop (Oshift (Slsr n'')) (t1:::Enil) - end - | shruimm_default e1 => - Eop (Oshift (Slsr n')) (e1:::Enil) - end - end. - -(* -Definition shrimm (e1: expr) := - match e1 with - | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shr n1 n)) - | Eop (Oshift (Oasr n1)) (t1:::Enil) => if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshift (Oasr (Int.add n n1))) (t1:::Enil) else Eop (Oshift (Oasr n)) (e1:::Enil) - | _ => Eop (Oshift (Oasr n)) (e1:::Enil) + if Int.eq n Int.zero then e1 else if negb (Int.ltu n Int.iwordsize) then Eop Oshru (e1 ::: Eop (Ointconst n) Enil ::: Enil) else match shruimm_match e1 with + | shruimm_case1 n1 => (* Eop (Ointconst n1) Enil *) + Eop (Ointconst(Int.shru n1 n)) Enil + | shruimm_case2 n1 t1 => (* Eop (Oshift (Slsr n1)) (t1:::Enil) *) + if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshift (Slsr (mk_shift_amount (Int.add n n1)))) (t1:::Enil) else Eop (Oshift (Slsr (mk_shift_amount n))) (e1:::Enil) + | shruimm_default e1 => + Eop (Oshift (Slsr (mk_shift_amount n))) (e1:::Enil) end. + + +(** Original definition: +<< +Nondetfunction shrimm (e1: expr) (n: int) := + if Int.eq n Int.zero then + e1 + else if negb (Int.ltu n Int.iwordsize) then + Eop Oshr (e1 ::: Eop (Ointconst n) Enil ::: Enil) + else + match e1 with + | Eop (Ointconst n1) Enil => Eop (Ointconst(Int.shr n1 n)) Enil + | Eop (Oshift (Sasr n1)) (t1:::Enil) => + if Int.ltu (Int.add n n1) Int.iwordsize + then Eop (Oshift (Sasr (mk_shift_amount (Int.add n n1)))) (t1:::Enil) + else Eop (Oshift (Sasr (mk_shift_amount n))) (e1:::Enil) + | _ => Eop (Oshift (Sasr (mk_shift_amount n))) (e1:::Enil) + end. +>> *) -Inductive shrimm_cases: forall (e1: expr), Type := - | shrimm_case1: - forall n1, - shrimm_cases (Eop (Ointconst n1) Enil) - | shrimm_case2: - forall n1 t1, - shrimm_cases (Eop (Oshift (Sasr n1)) (t1:::Enil)) - | shrimm_default: - forall (e1: expr), - shrimm_cases e1. - -Definition shrimm_match (e1: expr) := - match e1 as z1 return shrimm_cases z1 with - | Eop (Ointconst n1) Enil => - shrimm_case1 n1 - | Eop (Oshift (Sasr n1)) (t1:::Enil) => - shrimm_case2 n1 t1 - | e1 => - shrimm_default e1 +Inductive shrimm_cases: forall (e1: expr) , Type := + | shrimm_case1: forall n1, shrimm_cases (Eop (Ointconst n1) Enil) + | shrimm_case2: forall n1 t1, shrimm_cases (Eop (Oshift (Sasr n1)) (t1:::Enil)) + | shrimm_default: forall (e1: expr) , shrimm_cases e1. + +Definition shrimm_match (e1: expr) := + match e1 as zz1 return shrimm_cases zz1 with + | Eop (Ointconst n1) Enil => shrimm_case1 n1 + | Eop (Oshift (Sasr n1)) (t1:::Enil) => shrimm_case2 n1 t1 + | e1 => shrimm_default e1 end. Definition shrimm (e1: expr) (n: int) := - if Int.eq n Int.zero then e1 else - match is_shift_amount n with - | None => Eop Oshr (e1 ::: Eop (Ointconst n) Enil ::: Enil) - | Some n' => - match shrimm_match e1 with - | shrimm_case1 n1 => - Eop (Ointconst(Int.shr n1 n)) Enil - | shrimm_case2 n1 t1 => - match is_shift_amount (Int.add n (s_amount n1)) with - | None => - Eop (Oshift (Sasr n')) (e1:::Enil) - | Some n'' => - Eop (Oshift (Sasr n'')) (t1:::Enil) - end - | shrimm_default e1 => - Eop (Oshift (Sasr n')) (e1:::Enil) - end + if Int.eq n Int.zero then e1 else if negb (Int.ltu n Int.iwordsize) then Eop Oshr (e1 ::: Eop (Ointconst n) Enil ::: Enil) else match shrimm_match e1 with + | shrimm_case1 n1 => (* Eop (Ointconst n1) Enil *) + Eop (Ointconst(Int.shr n1 n)) Enil + | shrimm_case2 n1 t1 => (* Eop (Oshift (Sasr n1)) (t1:::Enil) *) + if Int.ltu (Int.add n n1) Int.iwordsize then Eop (Oshift (Sasr (mk_shift_amount (Int.add n n1)))) (t1:::Enil) else Eop (Oshift (Sasr (mk_shift_amount n))) (e1:::Enil) + | shrimm_default e1 => + Eop (Oshift (Sasr (mk_shift_amount n))) (e1:::Enil) end. + (** ** Integer multiply *) Definition mulimm_base (n1: int) (e2: expr) := @@ -553,170 +426,122 @@ Definition mulimm_base (n1: int) (e2: expr) := Eop Omul (Eop (Ointconst n1) Enil ::: e2 ::: Enil) end. -(* -Definition mulimm (n1: int) (e2: expr) := - if Int.eq n1 Int.zero then - Eop (Ointconst Int.zero) Enil - else if Int.eq n1 Int.one then - e2 +(** Original definition: +<< +Nondetfunction mulimm (n1: int) (e2: expr) := + if Int.eq n1 Int.zero then Eop (Ointconst Int.zero) Enil + else if Int.eq n1 Int.one then e2 else match e2 with - | Eop (Ointconst n2) Enil => Eop (Ointconst(intmul n1 n2)) Enil - | Eop (Oaddimm n2) (t2:::Enil) => addimm (intmul n1 n2) (mulimm_base n1 t2) + | Eop (Ointconst n2) Enil => Eop (Ointconst(Int.mul n1 n2)) Enil + | Eop (Oaddimm n2) (t2:::Enil) => addimm (Int.mul n1 n2) (mulimm_base n1 t2) | _ => mulimm_base n1 e2 end. +>> *) Inductive mulimm_cases: forall (e2: expr), Type := - | mulimm_case1: - forall (n2: int), - mulimm_cases (Eop (Ointconst n2) Enil) - | mulimm_case2: - forall (n2: int) (t2: expr), - mulimm_cases (Eop (Oaddimm n2) (t2:::Enil)) - | mulimm_default: - forall (e2: expr), - mulimm_cases e2. + | mulimm_case1: forall n2, mulimm_cases (Eop (Ointconst n2) Enil) + | mulimm_case2: forall n2 t2, mulimm_cases (Eop (Oaddimm n2) (t2:::Enil)) + | mulimm_default: forall (e2: expr), mulimm_cases e2. Definition mulimm_match (e2: expr) := - match e2 as z1 return mulimm_cases z1 with - | Eop (Ointconst n2) Enil => - mulimm_case1 n2 - | Eop (Oaddimm n2) (t2:::Enil) => - mulimm_case2 n2 t2 - | e2 => - mulimm_default e2 + match e2 as zz1 return mulimm_cases zz1 with + | Eop (Ointconst n2) Enil => mulimm_case1 n2 + | Eop (Oaddimm n2) (t2:::Enil) => mulimm_case2 n2 t2 + | e2 => mulimm_default e2 end. Definition mulimm (n1: int) (e2: expr) := - if Int.eq n1 Int.zero then - Eop (Ointconst Int.zero) Enil - else if Int.eq n1 Int.one then - e2 - else match mulimm_match e2 with - | mulimm_case1 n2 => + if Int.eq n1 Int.zero then Eop (Ointconst Int.zero) Enil else if Int.eq n1 Int.one then e2 else match mulimm_match e2 with + | mulimm_case1 n2 => (* Eop (Ointconst n2) Enil *) Eop (Ointconst(Int.mul n1 n2)) Enil - | mulimm_case2 n2 t2 => + | mulimm_case2 n2 t2 => (* Eop (Oaddimm n2) (t2:::Enil) *) addimm (Int.mul n1 n2) (mulimm_base n1 t2) | mulimm_default e2 => mulimm_base n1 e2 end. -(* -Definition mul (e1: expr) (e2: expr) := + +(** Original definition: +<< +Nondetfunction mul (e1: expr) (e2: expr) := match e1, e2 with | Eop (Ointconst n1) Enil, t2 => mulimm n1 t2 | t1, Eop (Ointconst n2) Enil => mulimm n2 t1 | _, _ => Eop Omul (e1:::e2:::Enil) end. +>> *) Inductive mul_cases: forall (e1: expr) (e2: expr), Type := - | mul_case1: - forall (n1: int) (t2: expr), - mul_cases (Eop (Ointconst n1) Enil) (t2) - | mul_case2: - forall (t1: expr) (n2: int), - mul_cases (t1) (Eop (Ointconst n2) Enil) - | mul_default: - forall (e1: expr) (e2: expr), - mul_cases e1 e2. - -Definition mul_match_aux (e1: expr) (e2: expr) := - match e2 as z2 return mul_cases e1 z2 with - | Eop (Ointconst n2) Enil => - mul_case2 e1 n2 - | e2 => - mul_default e1 e2 - end. + | mul_case1: forall n1 t2, mul_cases (Eop (Ointconst n1) Enil) (t2) + | mul_case2: forall t1 n2, mul_cases (t1) (Eop (Ointconst n2) Enil) + | mul_default: forall (e1: expr) (e2: expr), mul_cases e1 e2. Definition mul_match (e1: expr) (e2: expr) := - match e1 as z1 return mul_cases z1 e2 with - | Eop (Ointconst n1) Enil => - mul_case1 n1 e2 - | e1 => - mul_match_aux e1 e2 + match e1 as zz1, e2 as zz2 return mul_cases zz1 zz2 with + | Eop (Ointconst n1) Enil, t2 => mul_case1 n1 t2 + | t1, Eop (Ointconst n2) Enil => mul_case2 t1 n2 + | e1, e2 => mul_default e1 e2 end. Definition mul (e1: expr) (e2: expr) := match mul_match e1 e2 with - | mul_case1 n1 t2 => + | mul_case1 n1 t2 => (* Eop (Ointconst n1) Enil, t2 *) mulimm n1 t2 - | mul_case2 t1 n2 => + | mul_case2 t1 n2 => (* t1, Eop (Ointconst n2) Enil *) mulimm n2 t1 | mul_default e1 e2 => Eop Omul (e1:::e2:::Enil) end. -(** ** Integer division and modulus *) - -Definition mod_aux (divop: operation) (e1 e2: expr) := - Elet e1 - (Elet (lift e2) - (Eop Osub (Eletvar 1 ::: - Eop Omul (Eop divop (Eletvar 1 ::: Eletvar 0 ::: Enil) ::: - Eletvar 0 ::: - Enil) ::: - Enil))). -Inductive divu_cases: forall (e2: expr), Type := - | divu_case1: - forall (n2: int), - divu_cases (Eop (Ointconst n2) Enil) - | divu_default: - forall (e2: expr), - divu_cases e2. +(** ** Bitwise and, or, xor *) -Definition divu_match (e2: expr) := - match e2 as z1 return divu_cases z1 with +(** Original definition: +<< +Nondetfunction andimm (n1: int) (e2: expr) := + if Int.eq n1 Int.zero then Eop (Ointconst Int.zero) Enil else + match e2 with | Eop (Ointconst n2) Enil => - divu_case1 n2 - | e2 => - divu_default e2 + Eop (Ointconst (Int.and n1 n2)) Enil + | Eop (Oandimm n2) (t2:::Enil) => + Eop (Oandimm (Int.and n1 n2)) (t2:::Enil) + | _ => + Eop (Oandimm n1) (e2:::Enil) end. +>> +*) -Definition divu (e1: expr) (e2: expr) := - match divu_match e2 with - | divu_case1 n2 => - match Int.is_power2 n2 with - | Some l2 => shruimm e1 l2 - | None => Eop Odivu (e1:::e2:::Enil) - end - | divu_default e2 => - Eop Odivu (e1:::e2:::Enil) - end. +Inductive andimm_cases: forall (e2: expr), Type := + | andimm_case1: forall n2, andimm_cases (Eop (Ointconst n2) Enil) + | andimm_case2: forall n2 t2, andimm_cases (Eop (Oandimm n2) (t2:::Enil)) + | andimm_default: forall (e2: expr), andimm_cases e2. -Definition modu (e1: expr) (e2: expr) := - match divu_match e2 with - | divu_case1 n2 => - match Int.is_power2 n2 with - | Some l2 => Eop (Oandimm (Int.sub n2 Int.one)) (e1:::Enil) - | None => mod_aux Odivu e1 e2 - end - | divu_default e2 => - mod_aux Odivu e1 e2 +Definition andimm_match (e2: expr) := + match e2 as zz1 return andimm_cases zz1 with + | Eop (Ointconst n2) Enil => andimm_case1 n2 + | Eop (Oandimm n2) (t2:::Enil) => andimm_case2 n2 t2 + | e2 => andimm_default e2 end. -Definition divs (e1: expr) (e2: expr) := - match divu_match e2 with - | divu_case1 n2 => - match Int.is_power2 n2 with - | Some l2 => if Int.ltu l2 (Int.repr 31) - then Eop (Oshrximm l2) (e1:::Enil) - else Eop Odiv (e1:::e2:::Enil) - | None => Eop Odiv (e1:::e2:::Enil) - end - | divu_default e2 => - Eop Odiv (e1:::e2:::Enil) +Definition andimm (n1: int) (e2: expr) := + if Int.eq n1 Int.zero then Eop (Ointconst Int.zero) Enil else match andimm_match e2 with + | andimm_case1 n2 => (* Eop (Ointconst n2) Enil *) + Eop (Ointconst (Int.and n1 n2)) Enil + | andimm_case2 n2 t2 => (* Eop (Oandimm n2) (t2:::Enil) *) + Eop (Oandimm (Int.and n1 n2)) (t2:::Enil) + | andimm_default e2 => + Eop (Oandimm n1) (e2:::Enil) end. -Definition mods := mod_aux Odiv. (* could be improved *) - -(** ** Bitwise and, or, xor *) - -(* -Definition and (e1: expr) (e2: expr) := +(** Original definition: +<< +Nondetfunction and (e1: expr) (e2: expr) := match e1, e2 with + | Eop (Ointconst n1) Enil, t2 => andimm n1 t2 + | t1, Eop (Ointconst n2) Enil => andimm n2 t1 | Eop (Oshift s) (t1:::Enil), t2 => Eop (Oandshift s) (t2:::t1:::Enil) | t1, Eop (Oshift s) (t2:::Enil) => Eop (Oandshift s) (t1:::t2:::Enil) | Eop (Onotshift s) (t1:::Enil), t2 => Eop (Obicshift s) (t2:::t1:::Enil) @@ -725,362 +550,551 @@ Definition and (e1: expr) (e2: expr) := | t1, Eop Onot (t2:::Enil) => Eop Obic (t1:::t2:::Enil) | _, _ => Eop Oand (e1:::e2:::Enil) end. +>> *) Inductive and_cases: forall (e1: expr) (e2: expr), Type := - | and_case1: - forall s t1 t2, - and_cases (Eop (Oshift s) (t1:::Enil)) (t2) - | and_case2: - forall t1 s t2, - and_cases (t1) (Eop (Oshift s) (t2:::Enil)) - | and_case3: - forall s t1 t2, - and_cases (Eop (Onotshift s) (t1:::Enil)) (t2) - | and_case4: - forall t1 s t2, - and_cases (t1) (Eop (Onotshift s) (t2:::Enil)) - | and_case5: - forall t1 t2, - and_cases (Eop Onot (t1:::Enil)) (t2) - | and_case6: - forall t1 t2, - and_cases (t1) (Eop Onot (t2:::Enil)) - | and_default: - forall (e1: expr) (e2: expr), - and_cases e1 e2. + | and_case1: forall n1 t2, and_cases (Eop (Ointconst n1) Enil) (t2) + | and_case2: forall t1 n2, and_cases (t1) (Eop (Ointconst n2) Enil) + | and_case3: forall s t1 t2, and_cases (Eop (Oshift s) (t1:::Enil)) (t2) + | and_case4: forall t1 s t2, and_cases (t1) (Eop (Oshift s) (t2:::Enil)) + | and_case5: forall s t1 t2, and_cases (Eop (Onotshift s) (t1:::Enil)) (t2) + | and_case6: forall t1 s t2, and_cases (t1) (Eop (Onotshift s) (t2:::Enil)) + | and_case7: forall t1 t2, and_cases (Eop Onot (t1:::Enil)) (t2) + | and_case8: forall t1 t2, and_cases (t1) (Eop Onot (t2:::Enil)) + | and_default: forall (e1: expr) (e2: expr), and_cases e1 e2. Definition and_match (e1: expr) (e2: expr) := - match e1 as z1, e2 as z2 return and_cases z1 z2 with - | Eop (Oshift s) (t1:::Enil), t2 => - and_case1 s t1 t2 - | t1, Eop (Oshift s) (t2:::Enil) => - and_case2 t1 s t2 - | Eop (Onotshift s) (t1:::Enil), t2 => - and_case3 s t1 t2 - | t1, Eop (Onotshift s) (t2:::Enil) => - and_case4 t1 s t2 - | Eop Onot (t1:::Enil), t2 => - and_case5 t1 t2 - | t1, Eop Onot (t2:::Enil) => - and_case6 t1 t2 - | e1, e2 => - and_default e1 e2 + match e1 as zz1, e2 as zz2 return and_cases zz1 zz2 with + | Eop (Ointconst n1) Enil, t2 => and_case1 n1 t2 + | t1, Eop (Ointconst n2) Enil => and_case2 t1 n2 + | Eop (Oshift s) (t1:::Enil), t2 => and_case3 s t1 t2 + | t1, Eop (Oshift s) (t2:::Enil) => and_case4 t1 s t2 + | Eop (Onotshift s) (t1:::Enil), t2 => and_case5 s t1 t2 + | t1, Eop (Onotshift s) (t2:::Enil) => and_case6 t1 s t2 + | Eop Onot (t1:::Enil), t2 => and_case7 t1 t2 + | t1, Eop Onot (t2:::Enil) => and_case8 t1 t2 + | e1, e2 => and_default e1 e2 end. Definition and (e1: expr) (e2: expr) := match and_match e1 e2 with - | and_case1 s t1 t2 => + | and_case1 n1 t2 => (* Eop (Ointconst n1) Enil, t2 *) + andimm n1 t2 + | and_case2 t1 n2 => (* t1, Eop (Ointconst n2) Enil *) + andimm n2 t1 + | and_case3 s t1 t2 => (* Eop (Oshift s) (t1:::Enil), t2 *) Eop (Oandshift s) (t2:::t1:::Enil) - | and_case2 t1 s t2 => + | and_case4 t1 s t2 => (* t1, Eop (Oshift s) (t2:::Enil) *) Eop (Oandshift s) (t1:::t2:::Enil) - | and_case3 s t1 t2 => + | and_case5 s t1 t2 => (* Eop (Onotshift s) (t1:::Enil), t2 *) Eop (Obicshift s) (t2:::t1:::Enil) - | and_case4 t1 s t2 => + | and_case6 t1 s t2 => (* t1, Eop (Onotshift s) (t2:::Enil) *) Eop (Obicshift s) (t1:::t2:::Enil) - | and_case5 t1 t2 => + | and_case7 t1 t2 => (* Eop Onot (t1:::Enil), t2 *) Eop Obic (t2:::t1:::Enil) - | and_case6 t1 t2 => + | and_case8 t1 t2 => (* t1, Eop Onot (t2:::Enil) *) Eop Obic (t1:::t2:::Enil) | and_default e1 e2 => Eop Oand (e1:::e2:::Enil) end. + Definition same_expr_pure (e1 e2: expr) := match e1, e2 with | Evar v1, Evar v2 => if ident_eq v1 v2 then true else false | _, _ => false end. -(* -Definition or (e1: expr) (e2: expr) := +(** Original definition: +<< +Nondetfunction orimm (n1: int) (e2: expr) := + if Int.eq n1 Int.zero then e2 else + match e2 with + | Eop (Ointconst n2) Enil => Eop (Ointconst (Int.or n1 n2)) Enil + | Eop (Oorimm n2) (t2:::Enil) => Eop (Oorimm (Int.or n1 n2)) (t2:::Enil) + | _ => Eop (Oorimm n1) (e2:::Enil) + end. +>> +*) + +Inductive orimm_cases: forall (e2: expr), Type := + | orimm_case1: forall n2, orimm_cases (Eop (Ointconst n2) Enil) + | orimm_case2: forall n2 t2, orimm_cases (Eop (Oorimm n2) (t2:::Enil)) + | orimm_default: forall (e2: expr), orimm_cases e2. + +Definition orimm_match (e2: expr) := + match e2 as zz1 return orimm_cases zz1 with + | Eop (Ointconst n2) Enil => orimm_case1 n2 + | Eop (Oorimm n2) (t2:::Enil) => orimm_case2 n2 t2 + | e2 => orimm_default e2 + end. + +Definition orimm (n1: int) (e2: expr) := + if Int.eq n1 Int.zero then e2 else match orimm_match e2 with + | orimm_case1 n2 => (* Eop (Ointconst n2) Enil *) + Eop (Ointconst (Int.or n1 n2)) Enil + | orimm_case2 n2 t2 => (* Eop (Oorimm n2) (t2:::Enil) *) + Eop (Oorimm (Int.or n1 n2)) (t2:::Enil) + | orimm_default e2 => + Eop (Oorimm n1) (e2:::Enil) + end. + + +(** Original definition: +<< +Nondetfunction or (e1: expr) (e2: expr) := match e1, e2 with - | Eop (Oshift (Olsl n1) (t1:::Enil), Eop (Oshift (Olsr n2) (t2:::Enil)) => ... - | Eop (Oshift (Olsr n1) (t1:::Enil), Eop (Oshift (Olsl n2) (t2:::Enil)) => ... + | Eop (Ointconst n1) Enil, t2 => orimm n1 t2 + | t1, Eop (Ointconst n2) Enil => orimm n2 t1 + | Eop (Oshift (Slsl n1)) (t1:::Enil), Eop (Oshift (Slsr n2)) (t2:::Enil) => + if Int.eq (Int.add n1 n2) Int.iwordsize + && same_expr_pure t1 t2 + then Eop (Oshift (Sror n2)) (t1:::Enil) + else Eop (Oorshift (Slsr n2)) (e1:::t2:::Enil) + | Eop (Oshift (Slsr n1)) (t1:::Enil), Eop (Oshift (Slsl n2)) (t2:::Enil) => + if Int.eq (Int.add n2 n1) Int.iwordsize + && same_expr_pure t1 t2 + then Eop (Oshift (Sror n1)) (t1:::Enil) + else Eop (Oorshift (Slsl n2)) (e1:::t2:::Enil) | Eop (Oshift s) (t1:::Enil), t2 => Eop (Oorshift s) (t2:::t1:::Enil) | t1, Eop (Oshift s) (t2:::Enil) => Eop (Oorshift s) (t1:::t2:::Enil) | _, _ => Eop Oor (e1:::e2:::Enil) end. +>> *) Inductive or_cases: forall (e1: expr) (e2: expr), Type := - | or_case1: - forall n1 t1 n2 t2, - or_cases (Eop (Oshift (Slsl n1)) (t1:::Enil)) (Eop (Oshift (Slsr n2)) (t2:::Enil)) - | or_case2: - forall n1 t1 n2 t2, - or_cases (Eop (Oshift (Slsr n1)) (t1:::Enil)) (Eop (Oshift (Slsl n2)) (t2:::Enil)) - | or_case3: - forall s t1 t2, - or_cases (Eop (Oshift s) (t1:::Enil)) (t2) - | or_case4: - forall t1 s t2, - or_cases (t1) (Eop (Oshift s) (t2:::Enil)) - | or_default: - forall (e1: expr) (e2: expr), - or_cases e1 e2. + | or_case1: forall n1 t2, or_cases (Eop (Ointconst n1) Enil) (t2) + | or_case2: forall t1 n2, or_cases (t1) (Eop (Ointconst n2) Enil) + | or_case3: forall n1 t1 n2 t2, or_cases (Eop (Oshift (Slsl n1)) (t1:::Enil)) (Eop (Oshift (Slsr n2)) (t2:::Enil)) + | or_case4: forall n1 t1 n2 t2, or_cases (Eop (Oshift (Slsr n1)) (t1:::Enil)) (Eop (Oshift (Slsl n2)) (t2:::Enil)) + | or_case5: forall s t1 t2, or_cases (Eop (Oshift s) (t1:::Enil)) (t2) + | or_case6: forall t1 s t2, or_cases (t1) (Eop (Oshift s) (t2:::Enil)) + | or_default: forall (e1: expr) (e2: expr), or_cases e1 e2. Definition or_match (e1: expr) (e2: expr) := - match e1 as z1, e2 as z2 return or_cases z1 z2 with - | Eop (Oshift (Slsl n1)) (t1:::Enil), Eop (Oshift (Slsr n2)) (t2:::Enil) => - or_case1 n1 t1 n2 t2 - | Eop (Oshift (Slsr n1)) (t1:::Enil), Eop (Oshift (Slsl n2)) (t2:::Enil) => - or_case2 n1 t1 n2 t2 - | Eop (Oshift s) (t1:::Enil), t2 => - or_case3 s t1 t2 - | t1, Eop (Oshift s) (t2:::Enil) => - or_case4 t1 s t2 - | e1, e2 => - or_default e1 e2 + match e1 as zz1, e2 as zz2 return or_cases zz1 zz2 with + | Eop (Ointconst n1) Enil, t2 => or_case1 n1 t2 + | t1, Eop (Ointconst n2) Enil => or_case2 t1 n2 + | Eop (Oshift (Slsl n1)) (t1:::Enil), Eop (Oshift (Slsr n2)) (t2:::Enil) => or_case3 n1 t1 n2 t2 + | Eop (Oshift (Slsr n1)) (t1:::Enil), Eop (Oshift (Slsl n2)) (t2:::Enil) => or_case4 n1 t1 n2 t2 + | Eop (Oshift s) (t1:::Enil), t2 => or_case5 s t1 t2 + | t1, Eop (Oshift s) (t2:::Enil) => or_case6 t1 s t2 + | e1, e2 => or_default e1 e2 end. Definition or (e1: expr) (e2: expr) := match or_match e1 e2 with - | or_case1 n1 t1 n2 t2 => - if Int.eq (Int.add (s_amount n1) (s_amount n2)) Int.iwordsize - && same_expr_pure t1 t2 - then Eop (Oshift (Sror n2)) (t1:::Enil) - else Eop (Oorshift (Slsr n2)) (e1:::t2:::Enil) - | or_case2 n1 t1 n2 t2 => - if Int.eq (Int.add (s_amount n2) (s_amount n1)) Int.iwordsize - && same_expr_pure t1 t2 - then Eop (Oshift (Sror n1)) (t1:::Enil) - else Eop (Oorshift (Slsl n2)) (e1:::t2:::Enil) - | or_case3 s t1 t2 => + | or_case1 n1 t2 => (* Eop (Ointconst n1) Enil, t2 *) + orimm n1 t2 + | or_case2 t1 n2 => (* t1, Eop (Ointconst n2) Enil *) + orimm n2 t1 + | or_case3 n1 t1 n2 t2 => (* Eop (Oshift (Slsl n1)) (t1:::Enil), Eop (Oshift (Slsr n2)) (t2:::Enil) *) + if Int.eq (Int.add n1 n2) Int.iwordsize && same_expr_pure t1 t2 then Eop (Oshift (Sror n2)) (t1:::Enil) else Eop (Oorshift (Slsr n2)) (e1:::t2:::Enil) + | or_case4 n1 t1 n2 t2 => (* Eop (Oshift (Slsr n1)) (t1:::Enil), Eop (Oshift (Slsl n2)) (t2:::Enil) *) + if Int.eq (Int.add n2 n1) Int.iwordsize && same_expr_pure t1 t2 then Eop (Oshift (Sror n1)) (t1:::Enil) else Eop (Oorshift (Slsl n2)) (e1:::t2:::Enil) + | or_case5 s t1 t2 => (* Eop (Oshift s) (t1:::Enil), t2 *) Eop (Oorshift s) (t2:::t1:::Enil) - | or_case4 t1 s t2 => + | or_case6 t1 s t2 => (* t1, Eop (Oshift s) (t2:::Enil) *) Eop (Oorshift s) (t1:::t2:::Enil) | or_default e1 e2 => Eop Oor (e1:::e2:::Enil) end. -(* -Definition xor (e1: expr) (e2: expr) := + +(** Original definition: +<< +Nondetfunction xorimm (n1: int) (e2: expr) := + if Int.eq n1 Int.zero then e2 else + match e2 with + | Eop (Ointconst n2) Enil => Eop (Ointconst (Int.xor n1 n2)) Enil + | Eop (Oxorimm n2) (t2:::Enil) => Eop (Oxorimm (Int.xor n1 n2)) (t2:::Enil) + | _ => Eop (Oxorimm n1) (e2:::Enil) + end. +>> +*) + +Inductive xorimm_cases: forall (e2: expr), Type := + | xorimm_case1: forall n2, xorimm_cases (Eop (Ointconst n2) Enil) + | xorimm_case2: forall n2 t2, xorimm_cases (Eop (Oxorimm n2) (t2:::Enil)) + | xorimm_default: forall (e2: expr), xorimm_cases e2. + +Definition xorimm_match (e2: expr) := + match e2 as zz1 return xorimm_cases zz1 with + | Eop (Ointconst n2) Enil => xorimm_case1 n2 + | Eop (Oxorimm n2) (t2:::Enil) => xorimm_case2 n2 t2 + | e2 => xorimm_default e2 + end. + +Definition xorimm (n1: int) (e2: expr) := + if Int.eq n1 Int.zero then e2 else match xorimm_match e2 with + | xorimm_case1 n2 => (* Eop (Ointconst n2) Enil *) + Eop (Ointconst (Int.xor n1 n2)) Enil + | xorimm_case2 n2 t2 => (* Eop (Oxorimm n2) (t2:::Enil) *) + Eop (Oxorimm (Int.xor n1 n2)) (t2:::Enil) + | xorimm_default e2 => + Eop (Oxorimm n1) (e2:::Enil) + end. + + +(** Original definition: +<< +Nondetfunction xor (e1: expr) (e2: expr) := match e1, e2 with + | Eop (Ointconst n1) Enil, t2 => xorimm n1 t2 + | t1, Eop (Ointconst n2) Enil => xorimm n2 t1 | Eop (Oshift s) (t1:::Enil), t2 => Eop (Oxorshift s) (t2:::t1:::Enil) | t1, Eop (Oshift s) (t2:::Enil) => Eop (Oxorshift s) (t1:::t2:::Enil) | _, _ => Eop Oxor (e1:::e2:::Enil) end. +>> *) Inductive xor_cases: forall (e1: expr) (e2: expr), Type := - | xor_case1: - forall s t1 t2, - xor_cases (Eop (Oshift s) (t1:::Enil)) (t2) - | xor_case2: - forall t1 s t2, - xor_cases (t1) (Eop (Oshift s) (t2:::Enil)) - | xor_default: - forall (e1: expr) (e2: expr), - xor_cases e1 e2. + | xor_case1: forall n1 t2, xor_cases (Eop (Ointconst n1) Enil) (t2) + | xor_case2: forall t1 n2, xor_cases (t1) (Eop (Ointconst n2) Enil) + | xor_case3: forall s t1 t2, xor_cases (Eop (Oshift s) (t1:::Enil)) (t2) + | xor_case4: forall t1 s t2, xor_cases (t1) (Eop (Oshift s) (t2:::Enil)) + | xor_default: forall (e1: expr) (e2: expr), xor_cases e1 e2. Definition xor_match (e1: expr) (e2: expr) := - match e1 as z1, e2 as z2 return xor_cases z1 z2 with - | Eop (Oshift s) (t1:::Enil), t2 => - xor_case1 s t1 t2 - | t1, Eop (Oshift s) (t2:::Enil) => - xor_case2 t1 s t2 - | e1, e2 => - xor_default e1 e2 + match e1 as zz1, e2 as zz2 return xor_cases zz1 zz2 with + | Eop (Ointconst n1) Enil, t2 => xor_case1 n1 t2 + | t1, Eop (Ointconst n2) Enil => xor_case2 t1 n2 + | Eop (Oshift s) (t1:::Enil), t2 => xor_case3 s t1 t2 + | t1, Eop (Oshift s) (t2:::Enil) => xor_case4 t1 s t2 + | e1, e2 => xor_default e1 e2 end. Definition xor (e1: expr) (e2: expr) := match xor_match e1 e2 with - | xor_case1 s t1 t2 => + | xor_case1 n1 t2 => (* Eop (Ointconst n1) Enil, t2 *) + xorimm n1 t2 + | xor_case2 t1 n2 => (* t1, Eop (Ointconst n2) Enil *) + xorimm n2 t1 + | xor_case3 s t1 t2 => (* Eop (Oshift s) (t1:::Enil), t2 *) Eop (Oxorshift s) (t2:::t1:::Enil) - | xor_case2 t1 s t2 => + | xor_case4 t1 s t2 => (* t1, Eop (Oshift s) (t2:::Enil) *) Eop (Oxorshift s) (t1:::t2:::Enil) | xor_default e1 e2 => Eop Oxor (e1:::e2:::Enil) end. + +(** ** Integer division and modulus *) + +Definition mod_aux (divop: operation) (e1 e2: expr) := + Elet e1 + (Elet (lift e2) + (Eop Osub (Eletvar 1 ::: + Eop Omul (Eop divop (Eletvar 1 ::: Eletvar 0 ::: Enil) ::: + Eletvar 0 ::: + Enil) ::: + Enil))). + +Definition divs (e1: expr) (e2: expr) := Eop Odiv (e1:::e2:::Enil). + +Definition mods := mod_aux Odiv. + +Definition divuimm (e: expr) (n: int) := + match Int.is_power2 n with + | Some l => shruimm e l + | None => Eop Odivu (e ::: Eop (Ointconst n) Enil ::: Enil) + end. + +(** Original definition: +<< +Nondetfunction divu (e1: expr) (e2: expr) := + match e2 with + | Eop (Ointconst n2) Enil => divuimm e1 n2 + | _ => Eop Odivu (e1:::e2:::Enil) + end. +>> +*) + +Inductive divu_cases: forall (e2: expr), Type := + | divu_case1: forall n2, divu_cases (Eop (Ointconst n2) Enil) + | divu_default: forall (e2: expr), divu_cases e2. + +Definition divu_match (e2: expr) := + match e2 as zz1 return divu_cases zz1 with + | Eop (Ointconst n2) Enil => divu_case1 n2 + | e2 => divu_default e2 + end. + +Definition divu (e1: expr) (e2: expr) := + match divu_match e2 with + | divu_case1 n2 => (* Eop (Ointconst n2) Enil *) + divuimm e1 n2 + | divu_default e2 => + Eop Odivu (e1:::e2:::Enil) + end. + + +Definition moduimm (e: expr) (n: int) := + match Int.is_power2 n with + | Some l => Eop (Oandimm (Int.sub n Int.one)) (e ::: Enil) + | None => mod_aux Odivu e (Eop (Ointconst n) Enil) + end. + +(** Original definition: +<< +Nondetfunction modu (e1: expr) (e2: expr) := + match e2 with + | Eop (Ointconst n2) Enil => moduimm e1 n2 + | _ => mod_aux Odivu e1 e2 + end. +>> +*) + +Inductive modu_cases: forall (e2: expr), Type := + | modu_case1: forall n2, modu_cases (Eop (Ointconst n2) Enil) + | modu_default: forall (e2: expr), modu_cases e2. + +Definition modu_match (e2: expr) := + match e2 as zz1 return modu_cases zz1 with + | Eop (Ointconst n2) Enil => modu_case1 n2 + | e2 => modu_default e2 + end. + +Definition modu (e1: expr) (e2: expr) := + match modu_match e2 with + | modu_case1 n2 => (* Eop (Ointconst n2) Enil *) + moduimm e1 n2 + | modu_default e2 => + mod_aux Odivu e1 e2 + end. + + (** ** General shifts *) -Inductive shift_cases: forall (e1: expr), Type := - | shift_case1: - forall (n2: int), - shift_cases (Eop (Ointconst n2) Enil) - | shift_default: - forall (e1: expr), - shift_cases e1. +(** Original definition: +<< +Nondetfunction shl (e1: expr) (e2: expr) := + match e2 with + | Eop (Ointconst n2) Enil => shlimm e1 n2 + | _ => Eop Oshl (e1:::e2:::Enil) + end. +>> +*) + +Inductive shl_cases: forall (e2: expr), Type := + | shl_case1: forall n2, shl_cases (Eop (Ointconst n2) Enil) + | shl_default: forall (e2: expr), shl_cases e2. -Definition shift_match (e1: expr) := - match e1 as z1 return shift_cases z1 with - | Eop (Ointconst n2) Enil => - shift_case1 n2 - | e1 => - shift_default e1 +Definition shl_match (e2: expr) := + match e2 as zz1 return shl_cases zz1 with + | Eop (Ointconst n2) Enil => shl_case1 n2 + | e2 => shl_default e2 end. Definition shl (e1: expr) (e2: expr) := - match shift_match e2 with - | shift_case1 n2 => + match shl_match e2 with + | shl_case1 n2 => (* Eop (Ointconst n2) Enil *) shlimm e1 n2 - | shift_default e2 => + | shl_default e2 => Eop Oshl (e1:::e2:::Enil) end. -Definition shru (e1: expr) (e2: expr) := - match shift_match e2 with - | shift_case1 n2 => - shruimm e1 n2 - | shift_default e2 => - Eop Oshru (e1:::e2:::Enil) + +(** Original definition: +<< +Nondetfunction shr (e1: expr) (e2: expr) := + match e2 with + | Eop (Ointconst n2) Enil => shrimm e1 n2 + | _ => Eop Oshr (e1:::e2:::Enil) + end. +>> +*) + +Inductive shr_cases: forall (e2: expr), Type := + | shr_case1: forall n2, shr_cases (Eop (Ointconst n2) Enil) + | shr_default: forall (e2: expr), shr_cases e2. + +Definition shr_match (e2: expr) := + match e2 as zz1 return shr_cases zz1 with + | Eop (Ointconst n2) Enil => shr_case1 n2 + | e2 => shr_default e2 end. Definition shr (e1: expr) (e2: expr) := - match shift_match e2 with - | shift_case1 n2 => + match shr_match e2 with + | shr_case1 n2 => (* Eop (Ointconst n2) Enil *) shrimm e1 n2 - | shift_default e2 => + | shr_default e2 => Eop Oshr (e1:::e2:::Enil) end. -(** ** Comparisons *) -(* -Definition comp (e1: expr) (e2: expr) := - match e1, e2 with - | Eop (Ointconst n1) Enil, t2 => Eop (Ocmp (Ccompimm (swap_comparison c) n1)) (t2:::Enil) - | t1, Eop (Ointconst n2) Enil => Eop (Ocmp (Ccompimm c n1)) (t1:::Enil) - | Eop (Oshift s) (t1:::Enil), t2 => Eop (Ocmp (Ccompshift (swap_comparison c) s)) (t2:::t1:::Enil) - | t1, Eop (Oshift s) (t2:::Enil) => Eop (Ocmp (Ccompshift c s)) (t1:::t2:::Enil) - | _, _ => Eop (Ocmp (Ccomp c)) (e1:::e2:::Enil) +(** Original definition: +<< +Nondetfunction shru (e1: expr) (e2: expr) := + match e2 with + | Eop (Ointconst n2) Enil => shruimm e1 n2 + | _ => Eop Oshru (e1:::e2:::Enil) end. +>> *) - -Inductive comp_cases: forall (e1: expr) (e2: expr), Type := - | comp_case1: - forall n1 t2, - comp_cases (Eop (Ointconst n1) Enil) (t2) - | comp_case2: - forall t1 n2, - comp_cases (t1) (Eop (Ointconst n2) Enil) - | comp_case3: - forall s t1 t2, - comp_cases (Eop (Oshift s) (t1:::Enil)) (t2) - | comp_case4: - forall t1 s t2, - comp_cases (t1) (Eop (Oshift s) (t2:::Enil)) - | comp_default: - forall (e1: expr) (e2: expr), - comp_cases e1 e2. -Definition comp_match (e1: expr) (e2: expr) := - match e1 as z1, e2 as z2 return comp_cases z1 z2 with +Inductive shru_cases: forall (e2: expr), Type := + | shru_case1: forall n2, shru_cases (Eop (Ointconst n2) Enil) + | shru_default: forall (e2: expr), shru_cases e2. + +Definition shru_match (e2: expr) := + match e2 as zz1 return shru_cases zz1 with + | Eop (Ointconst n2) Enil => shru_case1 n2 + | e2 => shru_default e2 + end. + +Definition shru (e1: expr) (e2: expr) := + match shru_match e2 with + | shru_case1 n2 => (* Eop (Ointconst n2) Enil *) + shruimm e1 n2 + | shru_default e2 => + Eop Oshru (e1:::e2:::Enil) + end. + + +(** ** Floating-point arithmetic *) + +Definition negf (e: expr) := Eop Onegf (e ::: Enil). +Definition absf (e: expr) := Eop Oabsf (e ::: Enil). +Definition addf (e1 e2: expr) := Eop Oaddf (e1 ::: e2 ::: Enil). +Definition subf (e1 e2: expr) := Eop Osubf (e1 ::: e2 ::: Enil). +Definition mulf (e1 e2: expr) := Eop Omulf (e1 ::: e2 ::: Enil). +Definition divf (e1 e2: expr) := Eop Odivf (e1 ::: e2 ::: Enil). + +(** ** Comparisons *) + +(** Original definition: +<< +Nondetfunction comp (c: comparison) (e1: expr) (e2: expr) := + match e1, e2 with | Eop (Ointconst n1) Enil, t2 => - comp_case1 n1 t2 + Eop (Ocmp (Ccompimm (swap_comparison c) n1)) (t2:::Enil) | t1, Eop (Ointconst n2) Enil => - comp_case2 t1 n2 + Eop (Ocmp (Ccompimm c n2)) (t1:::Enil) | Eop (Oshift s) (t1:::Enil), t2 => - comp_case3 s t1 t2 + Eop (Ocmp (Ccompshift (swap_comparison c) s)) (t2:::t1:::Enil) | t1, Eop (Oshift s) (t2:::Enil) => - comp_case4 t1 s t2 - | e1, e2 => - comp_default e1 e2 + Eop (Ocmp (Ccompshift c s)) (t1:::t2:::Enil) + | _, _ => + Eop (Ocmp (Ccomp c)) (e1:::e2:::Enil) + end. +>> +*) + +Inductive comp_cases: forall (e1: expr) (e2: expr), Type := + | comp_case1: forall n1 t2, comp_cases (Eop (Ointconst n1) Enil) (t2) + | comp_case2: forall t1 n2, comp_cases (t1) (Eop (Ointconst n2) Enil) + | comp_case3: forall s t1 t2, comp_cases (Eop (Oshift s) (t1:::Enil)) (t2) + | comp_case4: forall t1 s t2, comp_cases (t1) (Eop (Oshift s) (t2:::Enil)) + | comp_default: forall (e1: expr) (e2: expr), comp_cases e1 e2. + +Definition comp_match (e1: expr) (e2: expr) := + match e1 as zz1, e2 as zz2 return comp_cases zz1 zz2 with + | Eop (Ointconst n1) Enil, t2 => comp_case1 n1 t2 + | t1, Eop (Ointconst n2) Enil => comp_case2 t1 n2 + | Eop (Oshift s) (t1:::Enil), t2 => comp_case3 s t1 t2 + | t1, Eop (Oshift s) (t2:::Enil) => comp_case4 t1 s t2 + | e1, e2 => comp_default e1 e2 end. Definition comp (c: comparison) (e1: expr) (e2: expr) := match comp_match e1 e2 with - | comp_case1 n1 t2 => + | comp_case1 n1 t2 => (* Eop (Ointconst n1) Enil, t2 *) Eop (Ocmp (Ccompimm (swap_comparison c) n1)) (t2:::Enil) - | comp_case2 t1 n2 => + | comp_case2 t1 n2 => (* t1, Eop (Ointconst n2) Enil *) Eop (Ocmp (Ccompimm c n2)) (t1:::Enil) - | comp_case3 s t1 t2 => + | comp_case3 s t1 t2 => (* Eop (Oshift s) (t1:::Enil), t2 *) Eop (Ocmp (Ccompshift (swap_comparison c) s)) (t2:::t1:::Enil) - | comp_case4 t1 s t2 => + | comp_case4 t1 s t2 => (* t1, Eop (Oshift s) (t2:::Enil) *) Eop (Ocmp (Ccompshift c s)) (t1:::t2:::Enil) | comp_default e1 e2 => Eop (Ocmp (Ccomp c)) (e1:::e2:::Enil) end. + +(** Original definition: +<< +Nondetfunction compu (c: comparison) (e1: expr) (e2: expr) := + match e1, e2 with + | Eop (Ointconst n1) Enil, t2 => + Eop (Ocmp (Ccompuimm (swap_comparison c) n1)) (t2:::Enil) + | t1, Eop (Ointconst n2) Enil => + Eop (Ocmp (Ccompuimm c n2)) (t1:::Enil) + | Eop (Oshift s) (t1:::Enil), t2 => + Eop (Ocmp (Ccompushift (swap_comparison c) s)) (t2:::t1:::Enil) + | t1, Eop (Oshift s) (t2:::Enil) => + Eop (Ocmp (Ccompushift c s)) (t1:::t2:::Enil) + | _, _ => + Eop (Ocmp (Ccompu c)) (e1:::e2:::Enil) + end. +>> +*) + +Inductive compu_cases: forall (e1: expr) (e2: expr), Type := + | compu_case1: forall n1 t2, compu_cases (Eop (Ointconst n1) Enil) (t2) + | compu_case2: forall t1 n2, compu_cases (t1) (Eop (Ointconst n2) Enil) + | compu_case3: forall s t1 t2, compu_cases (Eop (Oshift s) (t1:::Enil)) (t2) + | compu_case4: forall t1 s t2, compu_cases (t1) (Eop (Oshift s) (t2:::Enil)) + | compu_default: forall (e1: expr) (e2: expr), compu_cases e1 e2. + +Definition compu_match (e1: expr) (e2: expr) := + match e1 as zz1, e2 as zz2 return compu_cases zz1 zz2 with + | Eop (Ointconst n1) Enil, t2 => compu_case1 n1 t2 + | t1, Eop (Ointconst n2) Enil => compu_case2 t1 n2 + | Eop (Oshift s) (t1:::Enil), t2 => compu_case3 s t1 t2 + | t1, Eop (Oshift s) (t2:::Enil) => compu_case4 t1 s t2 + | e1, e2 => compu_default e1 e2 + end. + Definition compu (c: comparison) (e1: expr) (e2: expr) := - match comp_match e1 e2 with - | comp_case1 n1 t2 => + match compu_match e1 e2 with + | compu_case1 n1 t2 => (* Eop (Ointconst n1) Enil, t2 *) Eop (Ocmp (Ccompuimm (swap_comparison c) n1)) (t2:::Enil) - | comp_case2 t1 n2 => + | compu_case2 t1 n2 => (* t1, Eop (Ointconst n2) Enil *) Eop (Ocmp (Ccompuimm c n2)) (t1:::Enil) - | comp_case3 s t1 t2 => + | compu_case3 s t1 t2 => (* Eop (Oshift s) (t1:::Enil), t2 *) Eop (Ocmp (Ccompushift (swap_comparison c) s)) (t2:::t1:::Enil) - | comp_case4 t1 s t2 => + | compu_case4 t1 s t2 => (* t1, Eop (Oshift s) (t2:::Enil) *) Eop (Ocmp (Ccompushift c s)) (t1:::t2:::Enil) - | comp_default e1 e2 => + | compu_default e1 e2 => Eop (Ocmp (Ccompu c)) (e1:::e2:::Enil) end. + Definition compf (c: comparison) (e1: expr) (e2: expr) := Eop (Ocmp (Ccompf c)) (e1 ::: e2 ::: Enil). -(** ** Non-optimized operators. *) +(** ** Integer conversions *) + +Definition cast8unsigned (e: expr) := andimm (Int.repr 255) e. + +Definition cast8signed (e: expr) := shrimm (shlimm e (Int.repr 24)) (Int.repr 24). + +Definition cast16unsigned (e: expr) := andimm (Int.repr 65535) e. + +Definition cast16signed (e: expr) := shrimm (shlimm e (Int.repr 16)) (Int.repr 16). + +(** ** Floating-point conversions *) -Definition cast8unsigned (e: expr) := Eop Ocast8unsigned (e ::: Enil). -Definition cast8signed (e: expr) := Eop Ocast8signed (e ::: Enil). -Definition cast16unsigned (e: expr) := Eop Ocast16unsigned (e ::: Enil). -Definition cast16signed (e: expr) := Eop Ocast16signed (e ::: Enil). Definition singleoffloat (e: expr) := Eop Osingleoffloat (e ::: Enil). -Definition negint (e: expr) := Eop (Orsubimm Int.zero) (e ::: Enil). -Definition negf (e: expr) := Eop Onegf (e ::: Enil). -Definition absf (e: expr) := Eop Oabsf (e ::: Enil). Definition intoffloat (e: expr) := Eop Ointoffloat (e ::: Enil). Definition intuoffloat (e: expr) := Eop Ointuoffloat (e ::: Enil). Definition floatofint (e: expr) := Eop Ofloatofint (e ::: Enil). Definition floatofintu (e: expr) := Eop Ofloatofintu (e ::: Enil). -Definition addf (e1 e2: expr) := Eop Oaddf (e1 ::: e2 ::: Enil). -Definition subf (e1 e2: expr) := Eop Osubf (e1 ::: e2 ::: Enil). -Definition mulf (e1 e2: expr) := Eop Omulf (e1 ::: e2 ::: Enil). -Definition divf (e1 e2: expr) := Eop Odivf (e1 ::: e2 ::: Enil). (** ** Recognition of addressing modes for load and store operations *) -(* -Definition addressing (e: expr) := - match e with - | Eop (Oaddrstack n) Enil => (Ainstack n, Enil) - | Eop (Oaddimm n) (e1:::Enil) => (Aindexed n, e1:::Enil) - | Eop (Oaddshift s) (e1:::e2:::Enil) => (Aindexed2shift s, e1:::e2:::Enil) - | Eop Oadd (e1:::e2:::Enil) => (Aindexed2, e1:::e2:::Enil) - | _ => (Aindexed Int.zero, e:::Enil) - end. -*) - -Inductive addressing_cases: forall (e: expr), Type := - | addressing_case2: - forall n, - addressing_cases (Eop (Oaddrstack n) Enil) - | addressing_case3: - forall n e1, - addressing_cases (Eop (Oaddimm n) (e1:::Enil)) - | addressing_case4: - forall s e1 e2, - addressing_cases (Eop (Oaddshift s) (e1:::e2:::Enil)) - | addressing_case5: - forall e1 e2, - addressing_cases (Eop Oadd (e1:::e2:::Enil)) - | addressing_default: - forall (e: expr), - addressing_cases e. - -Definition addressing_match (e: expr) := - match e as z1 return addressing_cases z1 with - | Eop (Oaddrstack n) Enil => - addressing_case2 n - | Eop (Oaddimm n) (e1:::Enil) => - addressing_case3 n e1 - | Eop (Oaddshift s) (e1:::e2:::Enil) => - addressing_case4 s e1 e2 - | Eop Oadd (e1:::e2:::Enil) => - addressing_case5 e1 e2 - | e => - addressing_default e - end. - (** We do not recognize the [Aindexed2] and [Aindexed2shift] modes for floating-point accesses, since these are not supported by the hardware and emulated inefficiently in [Asmgen]. Likewise, [Aindexed2shift] are not supported for halfword and signed byte accesses. *) -Definition can_use_Aindexed (chunk: memory_chunk): bool := +Definition can_use_Aindexed2 (chunk: memory_chunk): bool := match chunk with | Mint8signed => true | Mint8unsigned => true @@ -1091,7 +1105,7 @@ Definition can_use_Aindexed (chunk: memory_chunk): bool := | Mfloat64 => false end. -Definition can_use_Aindexed2 (chunk: memory_chunk): bool := +Definition can_use_Aindexed2shift (chunk: memory_chunk): bool := match chunk with | Mint8signed => false | Mint8unsigned => true @@ -1102,22 +1116,54 @@ Definition can_use_Aindexed2 (chunk: memory_chunk): bool := | Mfloat64 => false end. -Definition addressing (chunk: memory_chunk) (e: expr) := - match addressing_match e with - | addressing_case2 n => - (Ainstack n, Enil) - | addressing_case3 n e1 => - (Aindexed n, e1:::Enil) - | addressing_case4 s e1 e2 => - if can_use_Aindexed2 chunk +(** Original definition: +<< +Nondetfunction addressing (chunk: memory_chunk) (e: expr) := + match e with + | Eop (Oaddrstack n) Enil => (Ainstack n, Enil) + | Eop (Oaddimm n) (e1:::Enil) => (Aindexed n, e1:::Enil) + | Eop (Oaddshift s) (e1:::e2:::Enil) => + if can_use_Aindexed2shift chunk then (Aindexed2shift s, e1:::e2:::Enil) else (Aindexed Int.zero, Eop (Oaddshift s) (e1:::e2:::Enil) ::: Enil) - | addressing_case5 e1 e2 => - if can_use_Aindexed chunk + | Eop Oadd (e1:::e2:::Enil) => + if can_use_Aindexed2 chunk then (Aindexed2, e1:::e2:::Enil) else (Aindexed Int.zero, Eop Oadd (e1:::e2:::Enil) ::: Enil) + | _ => (Aindexed Int.zero, e:::Enil) + end. +>> +*) + +Inductive addressing_cases: forall (e: expr), Type := + | addressing_case1: forall n, addressing_cases (Eop (Oaddrstack n) Enil) + | addressing_case2: forall n e1, addressing_cases (Eop (Oaddimm n) (e1:::Enil)) + | addressing_case3: forall s e1 e2, addressing_cases (Eop (Oaddshift s) (e1:::e2:::Enil)) + | addressing_case4: forall e1 e2, addressing_cases (Eop Oadd (e1:::e2:::Enil)) + | addressing_default: forall (e: expr), addressing_cases e. + +Definition addressing_match (e: expr) := + match e as zz1 return addressing_cases zz1 with + | Eop (Oaddrstack n) Enil => addressing_case1 n + | Eop (Oaddimm n) (e1:::Enil) => addressing_case2 n e1 + | Eop (Oaddshift s) (e1:::e2:::Enil) => addressing_case3 s e1 e2 + | Eop Oadd (e1:::e2:::Enil) => addressing_case4 e1 e2 + | e => addressing_default e + end. + +Definition addressing (chunk: memory_chunk) (e: expr) := + match addressing_match e with + | addressing_case1 n => (* Eop (Oaddrstack n) Enil *) + (Ainstack n, Enil) + | addressing_case2 n e1 => (* Eop (Oaddimm n) (e1:::Enil) *) + (Aindexed n, e1:::Enil) + | addressing_case3 s e1 e2 => (* Eop (Oaddshift s) (e1:::e2:::Enil) *) + if can_use_Aindexed2shift chunk then (Aindexed2shift s, e1:::e2:::Enil) else (Aindexed Int.zero, Eop (Oaddshift s) (e1:::e2:::Enil) ::: Enil) + | addressing_case4 e1 e2 => (* Eop Oadd (e1:::e2:::Enil) *) + if can_use_Aindexed2 chunk then (Aindexed2, e1:::e2:::Enil) else (Aindexed Int.zero, Eop Oadd (e1:::e2:::Enil) ::: Enil) | addressing_default e => (Aindexed Int.zero, e:::Enil) end. + diff --git a/arm/SelectOpproof.v b/arm/SelectOpproof.v index 9ecf1de8..fa416820 100644 --- a/arm/SelectOpproof.v +++ b/arm/SelectOpproof.v @@ -44,8 +44,6 @@ Variable m: mem. Ltac EvalOp := eapply eval_Eop; eauto with evalexpr. -Ltac TrivialOp cstr := unfold cstr; intros; EvalOp. - Ltac InvEval1 := match goal with | [ H: (eval_expr _ _ _ _ _ (Eop _ Enil) _) |- _ ] => @@ -78,6 +76,11 @@ Ltac InvEval2 := Ltac InvEval := InvEval1; InvEval2; InvEval2. +Ltac TrivialExists := + match goal with + | [ |- exists v, _ /\ Val.lessdef ?a v ] => exists a; split; [EvalOp | auto] + end. + (** * Correctness of the smart constructors *) (** We now show that the code generated by "smart constructor" functions @@ -100,440 +103,373 @@ Ltac InvEval := InvEval1; InvEval2; InvEval2. by the smart constructor. *) +Definition unary_constructor_sound (cstr: expr -> expr) (sem: val -> val) : Prop := + forall le a x, + eval_expr ge sp e m le a x -> + exists v, eval_expr ge sp e m le (cstr a) v /\ Val.lessdef (sem x) v. + +Definition binary_constructor_sound (cstr: expr -> expr -> expr) (sem: val -> val -> val) : Prop := + forall le a x b y, + eval_expr ge sp e m le a x -> + eval_expr ge sp e m le b y -> + exists v, eval_expr ge sp e m le (cstr a b) v /\ Val.lessdef (sem x y) v. + Theorem eval_addrsymbol: - forall le id ofs b, - Genv.find_symbol ge id = Some b -> - eval_expr ge sp e m le (addrsymbol id ofs) (Vptr b ofs). + forall le id ofs, + exists v, eval_expr ge sp e m le (addrsymbol id ofs) v /\ Val.lessdef (symbol_address ge id ofs) v. Proof. - intros. unfold addrsymbol. econstructor. constructor. - simpl. rewrite H. auto. + intros. unfold addrsymbol. econstructor; split. + EvalOp. simpl; eauto. + auto. Qed. Theorem eval_addrstack: - forall le ofs b n, - sp = Vptr b n -> - eval_expr ge sp e m le (addrstack ofs) (Vptr b (Int.add n ofs)). + forall le ofs, + exists v, eval_expr ge sp e m le (addrstack ofs) v /\ Val.lessdef (Val.add sp (Vint ofs)) v. Proof. - intros. unfold addrstack. econstructor. constructor. - simpl. unfold offset_sp. rewrite H. auto. + intros. unfold addrstack. econstructor; split. + EvalOp. simpl; eauto. + auto. Qed. -Theorem eval_notint: - forall le a x, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le (notint a) (Vint (Int.not x)). +Theorem eval_notint: unary_constructor_sound notint Val.notint. Proof. - unfold notint; intros until x; case (notint_match a); intros; InvEval. - EvalOp. simpl. congruence. - subst x. rewrite Int.not_involutive. auto. - EvalOp. simpl. subst x. rewrite Int.not_involutive. auto. - EvalOp. + unfold notint; red; intros until x; case (notint_match a); intros; InvEval. + subst x. TrivialExists. + exists v1; split; auto. subst. destruct v1; simpl; auto. rewrite Int.not_involutive; auto. + exists (eval_shift s v1); split. EvalOp. subst x. destruct (eval_shift s v1); simpl; auto. rewrite Int.not_involutive; auto. + TrivialExists. Qed. -Lemma eval_notbool_base: - forall le a v b, - eval_expr ge sp e m le a v -> - Val.bool_of_val v b -> - eval_expr ge sp e m le (notbool_base a) (Val.of_bool (negb b)). -Proof. - TrivialOp notbool_base. simpl. - inv H0. - rewrite Int.eq_false; auto. - rewrite Int.eq_true; auto. - reflexivity. -Qed. - -Hint Resolve Val.bool_of_true_val Val.bool_of_false_val - Val.bool_of_true_val_inv Val.bool_of_false_val_inv: valboolof. - -Theorem eval_notbool: - forall le a v b, - eval_expr ge sp e m le a v -> - Val.bool_of_val v b -> - eval_expr ge sp e m le (notbool a) (Val.of_bool (negb b)). +Theorem eval_notbool: unary_constructor_sound notbool Val.notbool. Proof. - induction a; simpl; intros; try (eapply eval_notbool_base; eauto). - destruct o; try (eapply eval_notbool_base; eauto). + assert (DFL: + forall le a x, + eval_expr ge sp e m le a x -> + exists v, eval_expr ge sp e m le (Eop (Ocmp (Ccompuimm Ceq Int.zero)) (a ::: Enil)) v + /\ Val.lessdef (Val.notbool x) v). + intros. TrivialExists. simpl. destruct x; simpl; auto. - destruct e0. InvEval. - inv H0. rewrite Int.eq_false; auto. - simpl; eauto with evalexpr. - rewrite Int.eq_true; simpl; eauto with evalexpr. - eapply eval_notbool_base; eauto. - - inv H. eapply eval_Eop; eauto. - simpl. assert (eval_condition c vl m = Some b). - generalize H6. simpl. - case (eval_condition c vl); intros. - destruct b0; inv H1; inversion H0; auto; congruence. - congruence. - rewrite (Op.eval_negate_condition _ _ _ H). - destruct b; reflexivity. - - inv H. eapply eval_Econdition; eauto. - destruct v1; eauto. + red. induction a; simpl; intros; eauto. destruct o; eauto. +(* intconst *) + destruct e0; eauto. InvEval. TrivialExists. simpl. destruct (Int.eq i Int.zero); auto. +(* cmp *) + inv H. simpl in H5. + destruct (eval_condition c vl m) as []_eqn. + TrivialExists. simpl. rewrite (eval_negate_condition _ _ _ Heqo). destruct b; inv H5; auto. + inv H5. simpl. + destruct (eval_condition (negate_condition c) vl m) as []_eqn. + destruct b; [exists Vtrue | exists Vfalse]; split; auto; EvalOp; simpl. rewrite Heqo0; auto. rewrite Heqo0; auto. + exists Vundef; split; auto; EvalOp; simpl. rewrite Heqo0; auto. +(* condition *) + inv H. destruct v1. + exploit IHa1; eauto. intros [v [A B]]. exists v; split; auto. eapply eval_Econdition; eauto. + exploit IHa2; eauto. intros [v [A B]]. exists v; split; auto. eapply eval_Econdition; eauto. Qed. Theorem eval_addimm: - forall le n a x, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le (addimm n a) (Vint (Int.add x n)). -Proof. - unfold addimm; intros until x. - generalize (Int.eq_spec n Int.zero). case (Int.eq n Int.zero); intro. - subst n. rewrite Int.add_zero. auto. - case (addimm_match a); intros; InvEval; EvalOp; simpl. + forall n, unary_constructor_sound (addimm n) (fun x => Val.add x (Vint n)). +Proof. + red; unfold addimm; intros until x. + predSpec Int.eq Int.eq_spec n Int.zero. + subst n. intros. exists x; split; auto. + destruct x; simpl; auto. rewrite Int.add_zero. auto. rewrite Int.add_zero. auto. + case (addimm_match a); intros; InvEval; simpl; TrivialExists; simpl. rewrite Int.add_commut. auto. - destruct (Genv.find_symbol ge s); discriminate. - destruct sp; simpl in H1; discriminate. - subst x. rewrite Int.add_assoc. decEq; decEq; decEq. apply Int.add_commut. + unfold symbol_address. destruct (Genv.find_symbol ge s); simpl; auto. rewrite Int.add_commut; auto. + rewrite Val.add_assoc. rewrite Int.add_commut. auto. + subst x. rewrite Val.add_assoc. rewrite Int.add_commut. auto. Qed. -Theorem eval_addimm_ptr: - forall le n a b ofs, - eval_expr ge sp e m le a (Vptr b ofs) -> - eval_expr ge sp e m le (addimm n a) (Vptr b (Int.add ofs n)). -Proof. - unfold addimm; intros until ofs. - generalize (Int.eq_spec n Int.zero). case (Int.eq n Int.zero); intro. - subst n. rewrite Int.add_zero. auto. - case (addimm_match a); intros; InvEval; EvalOp; simpl. - destruct (Genv.find_symbol ge s). - rewrite Int.add_commut. congruence. - discriminate. - destruct sp; simpl in H1; try discriminate. - inv H1. simpl. decEq. decEq. - rewrite Int.add_assoc. decEq. apply Int.add_commut. - subst. rewrite (Int.add_commut n m0). rewrite Int.add_assoc. auto. -Qed. - -Theorem eval_add: - forall le a b x y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - eval_expr ge sp e m le (add a b) (Vint (Int.add x y)). +Theorem eval_add: binary_constructor_sound add Val.add. Proof. - intros until y. + red; intros until y. unfold add; case (add_match a b); intros; InvEval. - rewrite Int.add_commut. apply eval_addimm. auto. - replace (Int.add x y) with (Int.add (Int.add i0 i) (Int.add n1 n2)). - apply eval_addimm. EvalOp. - subst x; subst y. - repeat rewrite Int.add_assoc. decEq. apply Int.add_permut. - replace (Int.add x y) with (Int.add (Int.add i y) n1). - apply eval_addimm. EvalOp. - subst x. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - apply eval_addimm. auto. - replace (Int.add x y) with (Int.add (Int.add x i) n2). - apply eval_addimm. EvalOp. - subst y. rewrite Int.add_assoc. auto. - EvalOp. simpl. subst x. rewrite Int.add_commut. auto. - EvalOp. simpl. congruence. - EvalOp. -Qed. - -Theorem eval_add_ptr: - forall le a b p x y, - eval_expr ge sp e m le a (Vptr p x) -> - eval_expr ge sp e m le b (Vint y) -> - eval_expr ge sp e m le (add a b) (Vptr p (Int.add x y)). -Proof. - intros until y. unfold add; case (add_match a b); intros; InvEval. - replace (Int.add x y) with (Int.add (Int.add i0 i) (Int.add n1 n2)). - apply eval_addimm_ptr. subst b0. EvalOp. - subst x; subst y. - repeat rewrite Int.add_assoc. decEq. apply Int.add_permut. - replace (Int.add x y) with (Int.add (Int.add i y) n1). - apply eval_addimm_ptr. subst b0. EvalOp. - subst x. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - apply eval_addimm_ptr. auto. - replace (Int.add x y) with (Int.add (Int.add x i) n2). - apply eval_addimm_ptr. EvalOp. - subst y. rewrite Int.add_assoc. auto. - EvalOp. simpl. congruence. - EvalOp. -Qed. - -Theorem eval_add_ptr_2: - forall le a b x p y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vptr p y) -> - eval_expr ge sp e m le (add a b) (Vptr p (Int.add y x)). -Proof. - intros until y. unfold add; case (add_match a b); intros; InvEval. - apply eval_addimm_ptr. auto. - replace (Int.add y x) with (Int.add (Int.add i i0) (Int.add n1 n2)). - apply eval_addimm_ptr. subst b0. EvalOp. - subst x; subst y. - repeat rewrite Int.add_assoc. decEq. - rewrite (Int.add_commut n1 n2). apply Int.add_permut. - replace (Int.add y x) with (Int.add (Int.add y i) n1). - apply eval_addimm_ptr. EvalOp. - subst x. repeat rewrite Int.add_assoc. auto. - replace (Int.add y x) with (Int.add (Int.add i x) n2). - apply eval_addimm_ptr. EvalOp. subst b0; reflexivity. - subst y. repeat rewrite Int.add_assoc. decEq. apply Int.add_commut. - EvalOp. simpl. congruence. - EvalOp. -Qed. - -Theorem eval_sub: - forall le a b x y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - eval_expr ge sp e m le (sub a b) (Vint (Int.sub x y)). -Proof. - intros until y. - unfold sub; case (sub_match a b); intros; InvEval. - rewrite Int.sub_add_opp. - apply eval_addimm. assumption. - replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)). - apply eval_addimm. EvalOp. - subst x; subst y. - repeat rewrite Int.sub_add_opp. - repeat rewrite Int.add_assoc. decEq. - rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr. - replace (Int.sub x y) with (Int.add (Int.sub i y) n1). - apply eval_addimm. EvalOp. - subst x. rewrite Int.sub_add_l. auto. - replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)). - apply eval_addimm. EvalOp. - subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r. - EvalOp. - EvalOp. simpl. congruence. - EvalOp. simpl. congruence. - EvalOp. -Qed. - -Theorem eval_sub_ptr_int: - forall le a b p x y, - eval_expr ge sp e m le a (Vptr p x) -> - eval_expr ge sp e m le b (Vint y) -> - eval_expr ge sp e m le (sub a b) (Vptr p (Int.sub x y)). -Proof. - intros until y. + rewrite Val.add_commut. apply eval_addimm; auto. + subst. + replace (Val.add (Val.add v1 (Vint n1)) (Val.add v0 (Vint n2))) + with (Val.add (Val.add v1 v0) (Val.add (Vint n1) (Vint n2))). + apply eval_addimm. EvalOp. + repeat rewrite Val.add_assoc. decEq. apply Val.add_permut. + subst. + replace (Val.add (Val.add v1 (Vint n1)) y) + with (Val.add (Val.add v1 y) (Vint n1)). + apply eval_addimm. EvalOp. + repeat rewrite Val.add_assoc. decEq. apply Val.add_commut. + apply eval_addimm; auto. + subst. rewrite <- Val.add_assoc. apply eval_addimm. EvalOp. + subst. rewrite Val.add_commut. TrivialExists. + subst. TrivialExists. + TrivialExists. +Qed. + +Theorem eval_sub: binary_constructor_sound sub Val.sub. +Proof. + red; intros until y. unfold sub; case (sub_match a b); intros; InvEval. - rewrite Int.sub_add_opp. - apply eval_addimm_ptr. assumption. - subst b0. replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)). - apply eval_addimm_ptr. EvalOp. - subst x; subst y. - repeat rewrite Int.sub_add_opp. - repeat rewrite Int.add_assoc. decEq. - rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr. - subst b0. replace (Int.sub x y) with (Int.add (Int.sub i y) n1). - apply eval_addimm_ptr. EvalOp. - subst x. rewrite Int.sub_add_l. auto. - replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)). - apply eval_addimm_ptr. EvalOp. - subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r. - EvalOp. simpl. congruence. - EvalOp. + rewrite Val.sub_add_opp. apply eval_addimm; auto. + subst. rewrite Val.sub_add_l. rewrite Val.sub_add_r. + rewrite Val.add_assoc. simpl. rewrite Int.add_commut. rewrite <- Int.sub_add_opp. + apply eval_addimm; EvalOp. + subst. rewrite Val.sub_add_l. apply eval_addimm; EvalOp. + subst. rewrite Val.sub_add_r. apply eval_addimm; EvalOp. + TrivialExists. + subst. TrivialExists. + subst. TrivialExists. + TrivialExists. Qed. -Theorem eval_sub_ptr_ptr: - forall le a b p x y, - eval_expr ge sp e m le a (Vptr p x) -> - eval_expr ge sp e m le b (Vptr p y) -> - eval_expr ge sp e m le (sub a b) (Vint (Int.sub x y)). +Theorem eval_negint: unary_constructor_sound negint (fun v => Val.sub Vzero v). Proof. - intros until y. - unfold sub; case (sub_match a b); intros; InvEval. - replace (Int.sub x y) with (Int.add (Int.sub i0 i) (Int.sub n1 n2)). - apply eval_addimm. EvalOp. - simpl; unfold eq_block. subst b0; subst b1; rewrite zeq_true. auto. - subst x; subst y. - repeat rewrite Int.sub_add_opp. - repeat rewrite Int.add_assoc. decEq. - rewrite Int.add_permut. decEq. symmetry. apply Int.neg_add_distr. - subst b0. replace (Int.sub x y) with (Int.add (Int.sub i y) n1). - apply eval_addimm. EvalOp. - simpl. unfold eq_block. rewrite zeq_true. auto. - subst x. rewrite Int.sub_add_l. auto. - subst b0. replace (Int.sub x y) with (Int.add (Int.sub x i) (Int.neg n2)). - apply eval_addimm. EvalOp. - simpl. unfold eq_block. rewrite zeq_true. auto. - subst y. rewrite (Int.add_commut i n2). symmetry. apply Int.sub_add_r. - EvalOp. simpl. unfold eq_block. rewrite zeq_true. auto. + red; intros. unfold negint. TrivialExists. Qed. Theorem eval_shlimm: - forall le a n x, - eval_expr ge sp e m le a (Vint x) -> - Int.ltu n Int.iwordsize = true -> - eval_expr ge sp e m le (shlimm a n) (Vint (Int.shl x n)). -Proof. - intros until x. unfold shlimm, is_shift_amount. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro. - intros. subst n. rewrite Int.shl_zero. auto. - destruct (is_shift_amount_aux n). simpl. - case (shlimm_match a); intros; InvEval. - EvalOp. - destruct (is_shift_amount_aux (Int.add n (s_amount n1))). - EvalOp. simpl. subst x. - decEq. decEq. symmetry. rewrite Int.add_commut. apply Int.shl_shl. - apply s_amount_ltu. auto. - rewrite Int.add_commut. auto. - EvalOp. econstructor. EvalOp. simpl. reflexivity. constructor. - simpl. congruence. - EvalOp. - congruence. + forall n, unary_constructor_sound (fun a => shlimm a n) + (fun x => Val.shl x (Vint n)). +Proof. +Opaque mk_shift_amount. + red; intros until x. unfold shlimm. + predSpec Int.eq Int.eq_spec n Int.zero. + intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shl_zero; auto. + destruct (Int.ltu n Int.iwordsize) as []_eqn; simpl. + destruct (shlimm_match a); intros. + InvEval. simpl; rewrite Heqb. TrivialExists. + destruct (Int.ltu (Int.add n n1) Int.iwordsize) as []_eqn. + InvEval. subst x. exists (Val.shl v1 (Vint (Int.add n n1))); split. EvalOp. + simpl. rewrite mk_shift_amount_eq; auto. + destruct v1; simpl; auto. rewrite s_range. simpl. rewrite Heqb. rewrite Heqb0. + rewrite Int.add_commut. rewrite Int.shl_shl; auto. apply s_range. rewrite Int.add_commut; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + intros; TrivialExists. simpl. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. auto. +Qed. + + Theorem eval_shrimm: + forall n, unary_constructor_sound (fun a => shrimm a n) + (fun x => Val.shr x (Vint n)). +Proof. + red; intros until x. unfold shrimm. + predSpec Int.eq Int.eq_spec n Int.zero. + intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shr_zero; auto. + destruct (Int.ltu n Int.iwordsize) as []_eqn; simpl. + destruct (shrimm_match a); intros. + InvEval. simpl; rewrite Heqb. TrivialExists. + destruct (Int.ltu (Int.add n n1) Int.iwordsize) as []_eqn. + InvEval. subst x. exists (Val.shr v1 (Vint (Int.add n n1))); split. EvalOp. + simpl. rewrite mk_shift_amount_eq; auto. + destruct v1; simpl; auto. rewrite s_range. simpl. rewrite Heqb. rewrite Heqb0. + rewrite Int.add_commut. rewrite Int.shr_shr; auto. apply s_range. rewrite Int.add_commut; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + intros; TrivialExists. simpl. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. auto. Qed. Theorem eval_shruimm: - forall le a n x, - eval_expr ge sp e m le a (Vint x) -> - Int.ltu n Int.iwordsize = true -> - eval_expr ge sp e m le (shruimm a n) (Vint (Int.shru x n)). -Proof. - intros until x. unfold shruimm, is_shift_amount. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro. - intros. subst n. rewrite Int.shru_zero. auto. - destruct (is_shift_amount_aux n). simpl. - case (shruimm_match a); intros; InvEval. - EvalOp. - destruct (is_shift_amount_aux (Int.add n (s_amount n1))). - EvalOp. simpl. subst x. - decEq. decEq. symmetry. rewrite Int.add_commut. apply Int.shru_shru. - apply s_amount_ltu. auto. - rewrite Int.add_commut. auto. - EvalOp. econstructor. EvalOp. simpl. reflexivity. constructor. - simpl. congruence. - EvalOp. - congruence. -Qed. - -Theorem eval_shrimm: - forall le a n x, - eval_expr ge sp e m le a (Vint x) -> - Int.ltu n Int.iwordsize = true -> - eval_expr ge sp e m le (shrimm a n) (Vint (Int.shr x n)). -Proof. - intros until x. unfold shrimm, is_shift_amount. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro. - intros. subst n. rewrite Int.shr_zero. auto. - destruct (is_shift_amount_aux n). simpl. - case (shrimm_match a); intros; InvEval. - EvalOp. - destruct (is_shift_amount_aux (Int.add n (s_amount n1))). - EvalOp. simpl. subst x. - decEq. decEq. symmetry. rewrite Int.add_commut. apply Int.shr_shr. - apply s_amount_ltu. auto. - rewrite Int.add_commut. auto. - EvalOp. econstructor. EvalOp. simpl. reflexivity. constructor. - simpl. congruence. - EvalOp. - congruence. + forall n, unary_constructor_sound (fun a => shruimm a n) + (fun x => Val.shru x (Vint n)). +Proof. + red; intros until x. unfold shruimm. + predSpec Int.eq Int.eq_spec n Int.zero. + intros; subst. exists x; split; auto. destruct x; simpl; auto. rewrite Int.shru_zero; auto. + destruct (Int.ltu n Int.iwordsize) as []_eqn; simpl. + destruct (shruimm_match a); intros. + InvEval. simpl; rewrite Heqb. TrivialExists. + destruct (Int.ltu (Int.add n n1) Int.iwordsize) as []_eqn. + InvEval. subst x. exists (Val.shru v1 (Vint (Int.add n n1))); split. EvalOp. + simpl. rewrite mk_shift_amount_eq; auto. + destruct v1; simpl; auto. destruct (Int.ltu n1 Int.iwordsize) as []_eqn; simpl; auto. + rewrite Heqb; rewrite Heqb0. rewrite Int.add_commut. rewrite Int.shru_shru; auto. rewrite Int.add_commut; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + TrivialExists. simpl. rewrite mk_shift_amount_eq; auto. + intros; TrivialExists. simpl. constructor. eauto. constructor. EvalOp. simpl; eauto. constructor. auto. Qed. Lemma eval_mulimm_base: - forall le a n x, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le (mulimm_base n a) (Vint (Int.mul x n)). + forall n, unary_constructor_sound (mulimm_base n) (fun x => Val.mul x (Vint n)). Proof. - intros; unfold mulimm_base. + intros; red; intros; unfold mulimm_base. + assert (DFL: exists v, eval_expr ge sp e m le (Eop Omul (Eop (Ointconst n) Enil ::: a ::: Enil)) v /\ Val.lessdef (Val.mul x (Vint n)) v). + TrivialExists. econstructor. EvalOp. simpl; eauto. econstructor. eauto. constructor. + rewrite Val.mul_commut. auto. generalize (Int.one_bits_decomp n). generalize (Int.one_bits_range n). - change (Z_of_nat Int.wordsize) with 32. destruct (Int.one_bits n). - intros. EvalOp. constructor. EvalOp. simpl; reflexivity. - constructor. eauto. constructor. simpl. rewrite Int.mul_commut. auto. + intros. auto. destruct l. intros. rewrite H1. simpl. - rewrite Int.add_zero. rewrite <- Int.shl_mul. - apply eval_shlimm. auto. auto with coqlib. + rewrite Int.add_zero. + replace (Vint (Int.shl Int.one i)) with (Val.shl Vone (Vint i)). rewrite Val.shl_mul. + apply eval_shlimm. auto. simpl. rewrite H0; auto with coqlib. destruct l. - intros. apply eval_Elet with (Vint x). auto. - rewrite H1. simpl. rewrite Int.add_zero. - rewrite Int.mul_add_distr_r. - rewrite <- Int.shl_mul. - rewrite <- Int.shl_mul. - apply eval_add. - apply eval_shlimm. apply eval_Eletvar. simpl. reflexivity. - auto with coqlib. - apply eval_shlimm. apply eval_Eletvar. simpl. reflexivity. - auto with coqlib. - intros. EvalOp. constructor. EvalOp. simpl; reflexivity. - constructor. eauto. constructor. simpl. rewrite Int.mul_commut. auto. + intros. rewrite H1. simpl. + exploit (eval_shlimm i (x :: le) (Eletvar 0) x). constructor; auto. intros [v1 [A1 B1]]. + exploit (eval_shlimm i0 (x :: le) (Eletvar 0) x). constructor; auto. intros [v2 [A2 B2]]. + exploit (eval_add (x :: le)). eexact A1. eexact A2. intros [v [A B]]. + exists v; split. econstructor; eauto. + rewrite Int.add_zero. + replace (Vint (Int.add (Int.shl Int.one i) (Int.shl Int.one i0))) + with (Val.add (Val.shl Vone (Vint i)) (Val.shl Vone (Vint i0))). + rewrite Val.mul_add_distr_r. + repeat rewrite Val.shl_mul. eapply Val.lessdef_trans. 2: eauto. apply Val.add_lessdef; auto. + simpl. repeat rewrite H0; auto with coqlib. + intros. auto. Qed. + Theorem eval_mulimm: - forall le a n x, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le (mulimm n a) (Vint (Int.mul x n)). -Proof. - intros until x; unfold mulimm. - generalize (Int.eq_spec n Int.zero); case (Int.eq n Int.zero); intro. - subst n. rewrite Int.mul_zero. - intro. EvalOp. - generalize (Int.eq_spec n Int.one); case (Int.eq n Int.one); intro. - subst n. rewrite Int.mul_one. auto. + forall n, unary_constructor_sound (mulimm n) (fun x => Val.mul x (Vint n)). +Proof. + intros; red; intros until x; unfold mulimm. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. exists (Vint Int.zero); split. EvalOp. + destruct x; simpl; auto. subst n. rewrite Int.mul_zero. auto. + predSpec Int.eq Int.eq_spec n Int.one. + intros. exists x; split; auto. + destruct x; simpl; auto. subst n. rewrite Int.mul_one. auto. case (mulimm_match a); intros; InvEval. - EvalOp. rewrite Int.mul_commut. reflexivity. - replace (Int.mul x n) with (Int.add (Int.mul i n) (Int.mul n n2)). - apply eval_addimm. apply eval_mulimm_base. auto. - subst x. rewrite Int.mul_add_distr_l. decEq. apply Int.mul_commut. - apply eval_mulimm_base. assumption. + TrivialExists. simpl. rewrite Int.mul_commut; auto. + subst. rewrite Val.mul_add_distr_l. + exploit eval_mulimm_base; eauto. instantiate (1 := n). intros [v' [A1 B1]]. + exploit (eval_addimm (Int.mul n n2) le (mulimm_base n t2) v'). auto. intros [v'' [A2 B2]]. + exists v''; split; auto. eapply Val.lessdef_trans. eapply Val.add_lessdef; eauto. + rewrite Val.mul_commut; auto. + apply eval_mulimm_base; auto. Qed. -Theorem eval_mul: - forall le a b x y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - eval_expr ge sp e m le (mul a b) (Vint (Int.mul x y)). +Theorem eval_mul: binary_constructor_sound mul Val.mul. Proof. - intros until y. + red; intros until y. unfold mul; case (mul_match a b); intros; InvEval. - rewrite Int.mul_commut. apply eval_mulimm. auto. + rewrite Val.mul_commut. apply eval_mulimm. auto. apply eval_mulimm. auto. - EvalOp. + TrivialExists. Qed. -Theorem eval_divs_base: - forall le a b x y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - y <> Int.zero -> - eval_expr ge sp e m le (Eop Odiv (a ::: b ::: Enil)) (Vint (Int.divs x y)). +Theorem eval_andimm: + forall n, unary_constructor_sound (andimm n) (fun x => Val.and x (Vint n)). Proof. - intros. EvalOp; simpl. - predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto. + intros; red; intros until x. unfold andimm. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. exists (Vint Int.zero); split. EvalOp. + destruct x; simpl; auto. subst n. rewrite Int.and_zero. auto. + case (andimm_match a); intros. + InvEval. TrivialExists. simpl. rewrite Int.and_commut; auto. + InvEval. subst. rewrite Val.and_assoc. simpl. rewrite Int.and_commut. TrivialExists. + TrivialExists. Qed. -Theorem eval_divs: - forall le a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - y <> Int.zero -> - eval_expr ge sp e m le (divs a b) (Vint (Int.divs x y)). -Proof. - intros until y. - unfold divs; case (divu_match b); intros; InvEval. - caseEq (Int.is_power2 y); intros. - caseEq (Int.ltu i (Int.repr 31)); intros. - EvalOp. simpl. unfold Int.ltu. rewrite zlt_true. - rewrite (Int.divs_pow2 x y i H0). auto. - exploit Int.ltu_inv; eauto. - change (Int.unsigned (Int.repr 31)) with 31. - change (Int.unsigned Int.iwordsize) with 32. - omega. - apply eval_divs_base. auto. EvalOp. auto. - apply eval_divs_base. auto. EvalOp. auto. - apply eval_divs_base; auto. +Theorem eval_and: binary_constructor_sound and Val.and. +Proof. + red; intros until y; unfold and; case (and_match a b); intros; InvEval. + rewrite Val.and_commut. apply eval_andimm; auto. + apply eval_andimm; auto. + subst. rewrite Val.and_commut. TrivialExists. + subst. TrivialExists. + subst. rewrite Val.and_commut. TrivialExists. + subst. TrivialExists. + subst. rewrite Val.and_commut. TrivialExists. + subst. TrivialExists. + TrivialExists. +Qed. + +Theorem eval_orimm: + forall n, unary_constructor_sound (orimm n) (fun x => Val.or x (Vint n)). +Proof. + intros; red; intros until x. unfold orimm. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. subst. exists x; split; auto. + destruct x; simpl; auto. rewrite Int.or_zero; auto. + destruct (orimm_match a); intros; InvEval. + TrivialExists. simpl. rewrite Int.or_commut; auto. + subst. rewrite Val.or_assoc. simpl. rewrite Int.or_commut. TrivialExists. + TrivialExists. +Qed. + +Remark eval_same_expr: + forall a1 a2 le v1 v2, + same_expr_pure a1 a2 = true -> + eval_expr ge sp e m le a1 v1 -> + eval_expr ge sp e m le a2 v2 -> + a1 = a2 /\ v1 = v2. +Proof. + intros until v2. + destruct a1; simpl; try (intros; discriminate). + destruct a2; simpl; try (intros; discriminate). + case (ident_eq i i0); intros. + subst i0. inversion H0. inversion H1. split. auto. congruence. + discriminate. +Qed. + +Theorem eval_or: binary_constructor_sound or Val.or. +Proof. + red; intros until y; unfold or; case (or_match a b); intros; InvEval. + rewrite Val.or_commut. apply eval_orimm; auto. + apply eval_orimm; auto. +(* shl - shru *) + destruct (Int.eq (Int.add n1 n2) Int.iwordsize && same_expr_pure t1 t2) as []_eqn. + destruct (andb_prop _ _ Heqb0). + generalize (Int.eq_spec (Int.add n1 n2) Int.iwordsize); rewrite H1; intros. + exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst. + exists (Val.ror v0 (Vint n2)); split. EvalOp. + destruct v0; simpl; auto. + destruct (Int.ltu n1 Int.iwordsize) as []_eqn; auto. + destruct (Int.ltu n2 Int.iwordsize) as []_eqn; auto. + simpl. rewrite <- Int.or_ror; auto. + subst. TrivialExists. + econstructor. EvalOp. simpl; eauto. econstructor; eauto. constructor. + simpl. auto. +(* shru - shr *) + destruct (Int.eq (Int.add n2 n1) Int.iwordsize && same_expr_pure t1 t2) as []_eqn. + destruct (andb_prop _ _ Heqb0). + generalize (Int.eq_spec (Int.add n2 n1) Int.iwordsize); rewrite H1; intros. + exploit eval_same_expr; eauto. intros [EQ1 EQ2]. subst. + exists (Val.ror v0 (Vint n1)); split. EvalOp. + destruct v0; simpl; auto. + destruct (Int.ltu n1 Int.iwordsize) as []_eqn; auto. + destruct (Int.ltu n2 Int.iwordsize) as []_eqn; auto. + simpl. rewrite Int.or_commut. rewrite <- Int.or_ror; auto. + subst. TrivialExists. + econstructor. EvalOp. simpl; eauto. econstructor; eauto. constructor. + simpl. auto. +(* orshift *) + subst. rewrite Val.or_commut. TrivialExists. + subst. TrivialExists. +(* default *) + TrivialExists. +Qed. + +Theorem eval_xorimm: + forall n, unary_constructor_sound (xorimm n) (fun x => Val.xor x (Vint n)). +Proof. + intros; red; intros until x. unfold xorimm. + predSpec Int.eq Int.eq_spec n Int.zero. + intros. exists x; split. auto. + destruct x; simpl; auto. subst n. rewrite Int.xor_zero. auto. + destruct (xorimm_match a); intros; InvEval. + TrivialExists. simpl. rewrite Int.xor_commut; auto. + subst. rewrite Val.xor_assoc. simpl. rewrite Int.xor_commut. TrivialExists. + TrivialExists. +Qed. + +Theorem eval_xor: binary_constructor_sound xor Val.xor. +Proof. + red; intros until y; unfold xor; case (xor_match a b); intros; InvEval. + rewrite Val.xor_commut. apply eval_xorimm; auto. + apply eval_xorimm; auto. + subst. rewrite Val.xor_commut. TrivialExists. + subst. TrivialExists. + TrivialExists. Qed. Lemma eval_mod_aux: forall divop semdivop, - (forall sp x y m, - y <> Int.zero -> - eval_operation ge sp divop (Vint x :: Vint y :: nil) m = - Some (Vint (semdivop x y))) -> - forall le a b x y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - y <> Int.zero -> - eval_expr ge sp e m le (mod_aux divop a b) - (Vint (Int.sub x (Int.mul (semdivop x y) y))). + (forall sp x y m, eval_operation ge sp divop (x :: y :: nil) m = semdivop x y) -> + forall le a b x y z, + eval_expr ge sp e m le a x -> + eval_expr ge sp e m le b y -> + semdivop x y = Some z -> + eval_expr ge sp e m le (mod_aux divop a b) (Val.sub x (Val.mul z y)). Proof. intros; unfold mod_aux. eapply eval_Elet. eexact H0. eapply eval_Elet. @@ -545,424 +481,246 @@ Proof. eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity. eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity. apply eval_Enil. - apply H. assumption. + rewrite H. eauto. eapply eval_Econs. apply eval_Eletvar. simpl; reflexivity. apply eval_Enil. simpl; reflexivity. apply eval_Enil. reflexivity. Qed. -Theorem eval_mods: - forall le a b x y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - y <> Int.zero -> - eval_expr ge sp e m le (mods a b) (Vint (Int.mods x y)). +Theorem eval_divs: + forall le a b x y z, + eval_expr ge sp e m le a x -> + eval_expr ge sp e m le b y -> + Val.divs x y = Some z -> + exists v, eval_expr ge sp e m le (divs a b) v /\ Val.lessdef z v. Proof. - intros; unfold mods. - rewrite Int.mods_divs. - eapply eval_mod_aux; eauto. - intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero. - contradiction. auto. + intros. unfold divs. exists z; split. EvalOp. auto. Qed. -Lemma eval_divu_base: - forall le a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - y <> Int.zero -> - eval_expr ge sp e m le (Eop Odivu (a ::: b ::: Enil)) (Vint (Int.divu x y)). +Theorem eval_mods: + forall le a b x y z, + eval_expr ge sp e m le a x -> + eval_expr ge sp e m le b y -> + Val.mods x y = Some z -> + exists v, eval_expr ge sp e m le (mods a b) v /\ Val.lessdef z v. Proof. - intros. EvalOp. simpl. - predSpec Int.eq Int.eq_spec y Int.zero. contradiction. auto. + intros; unfold mods. + exploit Val.mods_divs; eauto. intros [v [A B]]. + subst. econstructor; split; eauto. + apply eval_mod_aux with (semdivop := Val.divs); auto. Qed. -Theorem eval_divu: - forall le a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - y <> Int.zero -> - eval_expr ge sp e m le (divu a b) (Vint (Int.divu x y)). +Theorem eval_divuimm: + forall le n a x z, + eval_expr ge sp e m le a x -> + Val.divu x (Vint n) = Some z -> + exists v, eval_expr ge sp e m le (divuimm a n) v /\ Val.lessdef z v. Proof. - intros until y. - unfold divu; case (divu_match b); intros; InvEval. - caseEq (Int.is_power2 y). - intros. rewrite (Int.divu_pow2 x y i H0). - apply eval_shruimm. auto. - apply Int.is_power2_range with y. auto. - intros. apply eval_divu_base. auto. EvalOp. auto. - eapply eval_divu_base; eauto. + intros; unfold divuimm. + destruct (Int.is_power2 n) as []_eqn. + replace z with (Val.shru x (Vint i)). apply eval_shruimm; auto. + eapply Val.divu_pow2; eauto. + TrivialExists. + econstructor. eauto. econstructor. EvalOp. simpl; eauto. constructor. auto. Qed. -Theorem eval_modu: - forall le a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - y <> Int.zero -> - eval_expr ge sp e m le (modu a b) (Vint (Int.modu x y)). -Proof. - intros until y; unfold modu; case (divu_match b); intros; InvEval. - caseEq (Int.is_power2 y). - intros. rewrite (Int.modu_and x y i H0). - EvalOp. - intro. rewrite Int.modu_divu. eapply eval_mod_aux. - intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero. - contradiction. auto. - auto. EvalOp. auto. auto. - rewrite Int.modu_divu. eapply eval_mod_aux. - intros. simpl. predSpec Int.eq Int.eq_spec y0 Int.zero. - contradiction. auto. auto. auto. auto. auto. -Qed. - -Theorem eval_and: - forall le a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - eval_expr ge sp e m le (and a b) (Vint (Int.and x y)). -Proof. - intros until y; unfold and; case (and_match a b); intros; InvEval. - rewrite Int.and_commut. EvalOp. simpl. congruence. - EvalOp. simpl. congruence. - rewrite Int.and_commut. EvalOp. simpl. congruence. - EvalOp. simpl. congruence. - rewrite Int.and_commut. EvalOp. simpl. congruence. - EvalOp. simpl. congruence. +Theorem eval_divu: + forall le a x b y z, + eval_expr ge sp e m le a x -> + eval_expr ge sp e m le b y -> + Val.divu x y = Some z -> + exists v, eval_expr ge sp e m le (divu a b) v /\ Val.lessdef z v. +Proof. + intros until z. unfold divu; destruct (divu_match b); intros; InvEval. + eapply eval_divuimm; eauto. + TrivialExists. +Qed. + +Theorem eval_moduimm: + forall le n a x z, + eval_expr ge sp e m le a x -> + Val.modu x (Vint n) = Some z -> + exists v, eval_expr ge sp e m le (moduimm a n) v /\ Val.lessdef z v. +Proof. + intros; unfold moduimm. + destruct (Int.is_power2 n) as []_eqn. + replace z with (Val.and x (Vint (Int.sub n Int.one))). TrivialExists. + eapply Val.modu_pow2; eauto. + exploit Val.modu_divu; eauto. intros [v [A B]]. + subst. econstructor; split; eauto. + apply eval_mod_aux with (semdivop := Val.divu); auto. EvalOp. Qed. -Remark eval_same_expr: - forall a1 a2 le v1 v2, - same_expr_pure a1 a2 = true -> - eval_expr ge sp e m le a1 v1 -> - eval_expr ge sp e m le a2 v2 -> - a1 = a2 /\ v1 = v2. +Theorem eval_modu: + forall le a x b y z, + eval_expr ge sp e m le a x -> + eval_expr ge sp e m le b y -> + Val.modu x y = Some z -> + exists v, eval_expr ge sp e m le (modu a b) v /\ Val.lessdef z v. Proof. - intros until v2. - destruct a1; simpl; try (intros; discriminate). - destruct a2; simpl; try (intros; discriminate). - case (ident_eq i i0); intros. - subst i0. inversion H0. inversion H1. split. auto. congruence. - discriminate. + intros until y; unfold modu; case (modu_match b); intros; InvEval. + eapply eval_moduimm; eauto. + exploit Val.modu_divu; eauto. intros [v [A B]]. + subst. econstructor; split; eauto. + apply eval_mod_aux with (semdivop := Val.divu); auto. Qed. -Lemma eval_or: - forall le a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - eval_expr ge sp e m le (or a b) (Vint (Int.or x y)). -Proof. - intros until y; unfold or; case (or_match a b); intros; InvEval. - caseEq (Int.eq (Int.add (s_amount n1) (s_amount n2)) Int.iwordsize - && same_expr_pure t1 t2); intro. - destruct (andb_prop _ _ H1). - generalize (Int.eq_spec (Int.add (s_amount n1) (s_amount n2)) Int.iwordsize). - rewrite H4. intro. - exploit eval_same_expr; eauto. intros [EQ1 EQ2]. inv EQ1. inv EQ2. - simpl. EvalOp. simpl. decEq. decEq. apply Int.or_ror. - destruct n1; auto. destruct n2; auto. auto. - EvalOp. econstructor. EvalOp. simpl. reflexivity. - econstructor; eauto with evalexpr. - simpl. congruence. - caseEq (Int.eq (Int.add (s_amount n2) (s_amount n1)) Int.iwordsize - && same_expr_pure t1 t2); intro. - destruct (andb_prop _ _ H1). - generalize (Int.eq_spec (Int.add (s_amount n2) (s_amount n1)) Int.iwordsize). - rewrite H4. intro. - exploit eval_same_expr; eauto. intros [EQ1 EQ2]. inv EQ1. inv EQ2. - simpl. EvalOp. simpl. decEq. decEq. rewrite Int.or_commut. apply Int.or_ror. - destruct n2; auto. destruct n1; auto. auto. - EvalOp. econstructor. EvalOp. simpl. reflexivity. - econstructor; eauto with evalexpr. - simpl. congruence. - EvalOp. simpl. rewrite Int.or_commut. congruence. - EvalOp. simpl. congruence. - EvalOp. -Qed. - -Theorem eval_xor: - forall le a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - eval_expr ge sp e m le (xor a b) (Vint (Int.xor x y)). +Theorem eval_shl: binary_constructor_sound shl Val.shl. Proof. - intros until y; unfold xor; case (xor_match a b); intros; InvEval. - rewrite Int.xor_commut. EvalOp. simpl. congruence. - EvalOp. simpl. congruence. - EvalOp. + red; intros until y; unfold shl; case (shl_match b); intros. + InvEval. apply eval_shlimm; auto. + TrivialExists. Qed. -Theorem eval_shl: - forall le a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - Int.ltu y Int.iwordsize = true -> - eval_expr ge sp e m le (shl a b) (Vint (Int.shl x y)). +Theorem eval_shr: binary_constructor_sound shr Val.shr. Proof. - intros until y; unfold shl; case (shift_match b); intros. - InvEval. apply eval_shlimm; auto. - EvalOp. simpl. rewrite H1. auto. + red; intros until y; unfold shr; case (shr_match b); intros. + InvEval. apply eval_shrimm; auto. + TrivialExists. Qed. -Theorem eval_shru: - forall le a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - Int.ltu y Int.iwordsize = true -> - eval_expr ge sp e m le (shru a b) (Vint (Int.shru x y)). +Theorem eval_shru: binary_constructor_sound shru Val.shru. Proof. - intros until y; unfold shru; case (shift_match b); intros. + red; intros until y; unfold shru; case (shru_match b); intros. InvEval. apply eval_shruimm; auto. - EvalOp. simpl. rewrite H1. auto. + TrivialExists. Qed. -Theorem eval_shr: - forall le a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - Int.ltu y Int.iwordsize = true -> - eval_expr ge sp e m le (shr a b) (Vint (Int.shr x y)). + +Theorem eval_negf: unary_constructor_sound negf Val.negf. Proof. - intros until y; unfold shr; case (shift_match b); intros. - InvEval. apply eval_shrimm; auto. - EvalOp. simpl. rewrite H1. auto. + red; intros. TrivialExists. Qed. -Theorem eval_cast8signed: - forall le a v, - eval_expr ge sp e m le a v -> - eval_expr ge sp e m le (cast8signed a) (Val.sign_ext 8 v). -Proof. TrivialOp cast8signed. Qed. - -Theorem eval_cast8unsigned: - forall le a v, - eval_expr ge sp e m le a v -> - eval_expr ge sp e m le (cast8unsigned a) (Val.zero_ext 8 v). -Proof. TrivialOp cast8unsigned. Qed. +Theorem eval_absf: unary_constructor_sound absf Val.absf. +Proof. + red; intros. TrivialExists. +Qed. -Theorem eval_cast16signed: - forall le a v, - eval_expr ge sp e m le a v -> - eval_expr ge sp e m le (cast16signed a) (Val.sign_ext 16 v). -Proof. TrivialOp cast16signed. Qed. +Theorem eval_addf: binary_constructor_sound addf Val.addf. +Proof. + red; intros; TrivialExists. +Qed. + +Theorem eval_subf: binary_constructor_sound subf Val.subf. +Proof. + red; intros; TrivialExists. +Qed. -Theorem eval_cast16unsigned: - forall le a v, - eval_expr ge sp e m le a v -> - eval_expr ge sp e m le (cast16unsigned a) (Val.zero_ext 16 v). -Proof. TrivialOp cast16unsigned. Qed. +Theorem eval_mulf: binary_constructor_sound mulf Val.mulf. +Proof. + red; intros; TrivialExists. +Qed. -Theorem eval_singleoffloat: - forall le a v, - eval_expr ge sp e m le a v -> - eval_expr ge sp e m le (singleoffloat a) (Val.singleoffloat v). -Proof. TrivialOp singleoffloat. Qed. +Theorem eval_divf: binary_constructor_sound divf Val.divf. +Proof. + red; intros; TrivialExists. +Qed. Theorem eval_comp: - forall le c a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - eval_expr ge sp e m le (comp c a b) (Val.of_bool(Int.cmp c x y)). -Proof. - intros until y. - unfold comp; case (comp_match a b); intros; InvEval. - EvalOp. simpl. rewrite Int.swap_cmp. destruct (Int.cmp c x y); reflexivity. - EvalOp. simpl. destruct (Int.cmp c x y); reflexivity. - EvalOp. simpl. rewrite H. rewrite Int.swap_cmp. destruct (Int.cmp c x y); reflexivity. - EvalOp. simpl. rewrite H0. destruct (Int.cmp c x y); reflexivity. - EvalOp. simpl. destruct (Int.cmp c x y); reflexivity. -Qed. - -Theorem eval_compu_int: - forall le c a x b y, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vint y) -> - eval_expr ge sp e m le (compu c a b) (Val.of_bool(Int.cmpu c x y)). -Proof. - intros until y. - unfold compu; case (comp_match a b); intros; InvEval. - EvalOp. simpl. rewrite Int.swap_cmpu. destruct (Int.cmpu c x y); reflexivity. - EvalOp. simpl. destruct (Int.cmpu c x y); reflexivity. - EvalOp. simpl. rewrite Int.swap_cmpu. rewrite H. destruct (Int.cmpu c x y); reflexivity. - EvalOp. simpl. rewrite H0. destruct (Int.cmpu c x y); reflexivity. - EvalOp. simpl. destruct (Int.cmpu c x y); reflexivity. -Qed. - -Remark eval_compare_null_trans: - forall c x v, - (if Int.eq x Int.zero then Cminor.eval_compare_mismatch c else None) = Some v -> - match eval_compare_null c x with - | Some true => Some Vtrue - | Some false => Some Vfalse - | None => None (A:=val) - end = Some v. -Proof. - unfold Cminor.eval_compare_mismatch, eval_compare_null; intros. - destruct (Int.eq x Int.zero); try discriminate. - destruct c; try discriminate; auto. -Qed. - -Theorem eval_compu_ptr_int: - forall le c a x1 x2 b y v, - eval_expr ge sp e m le a (Vptr x1 x2) -> - eval_expr ge sp e m le b (Vint y) -> - (if Int.eq y Int.zero then Cminor.eval_compare_mismatch c else None) = Some v -> - eval_expr ge sp e m le (compu c a b) v. -Proof. - intros until v. - unfold compu; case (comp_match a b); intros; InvEval. - EvalOp. simpl. apply eval_compare_null_trans; auto. - EvalOp. simpl. rewrite H0. apply eval_compare_null_trans; auto. - EvalOp. simpl. apply eval_compare_null_trans; auto. -Qed. - -Remark eval_swap_compare_null_trans: - forall c x v, - (if Int.eq x Int.zero then Cminor.eval_compare_mismatch c else None) = Some v -> - match eval_compare_null (swap_comparison c) x with - | Some true => Some Vtrue - | Some false => Some Vfalse - | None => None (A:=val) - end = Some v. -Proof. - unfold Cminor.eval_compare_mismatch, eval_compare_null; intros. - destruct (Int.eq x Int.zero); try discriminate. - destruct c; simpl; try discriminate; auto. -Qed. - -Theorem eval_compu_int_ptr: - forall le c a x b y1 y2 v, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le b (Vptr y1 y2) -> - (if Int.eq x Int.zero then Cminor.eval_compare_mismatch c else None) = Some v -> - eval_expr ge sp e m le (compu c a b) v. -Proof. - intros until v. - unfold compu; case (comp_match a b); intros; InvEval. - EvalOp. simpl. apply eval_swap_compare_null_trans; auto. - EvalOp. simpl. rewrite H. apply eval_swap_compare_null_trans; auto. - EvalOp. simpl. apply eval_compare_null_trans; auto. -Qed. - -Theorem eval_compu_ptr_ptr: - forall le c a x1 x2 b y1 y2, - eval_expr ge sp e m le a (Vptr x1 x2) -> - eval_expr ge sp e m le b (Vptr y1 y2) -> - Mem.valid_pointer m x1 (Int.unsigned x2) - && Mem.valid_pointer m y1 (Int.unsigned y2) = true -> - x1 = y1 -> - eval_expr ge sp e m le (compu c a b) (Val.of_bool(Int.cmpu c x2 y2)). -Proof. - intros until y2. - unfold compu; case (comp_match a b); intros; InvEval. - EvalOp. simpl. rewrite H1. subst y1. rewrite dec_eq_true. - destruct (Int.cmpu c x2 y2); reflexivity. -Qed. - -Theorem eval_compu_ptr_ptr_2: - forall le c a x1 x2 b y1 y2 v, - eval_expr ge sp e m le a (Vptr x1 x2) -> - eval_expr ge sp e m le b (Vptr y1 y2) -> - Mem.valid_pointer m x1 (Int.unsigned x2) - && Mem.valid_pointer m y1 (Int.unsigned y2) = true -> - x1 <> y1 -> - Cminor.eval_compare_mismatch c = Some v -> - eval_expr ge sp e m le (compu c a b) v. -Proof. - intros until y2. - unfold compu; case (comp_match a b); intros; InvEval. - EvalOp. simpl. rewrite H1. rewrite dec_eq_false; auto. - destruct c; simpl in H3; inv H3; auto. + forall c, binary_constructor_sound (comp c) (Val.cmp c). +Proof. + intros; red; intros until y. unfold comp; case (comp_match a b); intros; InvEval. + TrivialExists. simpl. rewrite Val.swap_cmp_bool. auto. + TrivialExists. + subst. TrivialExists. simpl. rewrite Val.swap_cmp_bool. auto. + subst. TrivialExists. + TrivialExists. Qed. -Theorem eval_compf: - forall le c a x b y, - eval_expr ge sp e m le a (Vfloat x) -> - eval_expr ge sp e m le b (Vfloat y) -> - eval_expr ge sp e m le (compf c a b) (Val.of_bool(Float.cmp c x y)). +Theorem eval_compu: + forall c, binary_constructor_sound (compu c) (Val.cmpu (Mem.valid_pointer m) c). Proof. - intros. unfold compf. EvalOp. simpl. - destruct (Float.cmp c x y); reflexivity. + intros; red; intros until y. unfold compu; case (compu_match a b); intros; InvEval. + TrivialExists. simpl. rewrite Val.swap_cmpu_bool. auto. + TrivialExists. + subst. TrivialExists. simpl. rewrite Val.swap_cmpu_bool. auto. + subst. TrivialExists. + TrivialExists. Qed. -Theorem eval_negint: - forall le a x, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le (negint a) (Vint (Int.neg x)). -Proof. intros; unfold negint; EvalOp. Qed. - -Theorem eval_negf: - forall le a x, - eval_expr ge sp e m le a (Vfloat x) -> - eval_expr ge sp e m le (negf a) (Vfloat (Float.neg x)). -Proof. intros; unfold negf; EvalOp. Qed. +Theorem eval_compf: + forall c, binary_constructor_sound (compf c) (Val.cmpf c). +Proof. + intros; red; intros. unfold compf. TrivialExists. +Qed. -Theorem eval_absf: - forall le a x, - eval_expr ge sp e m le a (Vfloat x) -> - eval_expr ge sp e m le (absf a) (Vfloat (Float.abs x)). -Proof. intros; unfold absf; EvalOp. Qed. +Theorem eval_cast8signed: unary_constructor_sound cast8signed (Val.sign_ext 8). +Proof. + red; intros. unfold cast8signed. + exploit (eval_shlimm (Int.repr 24)); eauto. intros [v1 [A1 B1]]. + exploit (eval_shrimm (Int.repr 24)). eexact A1. intros [v2 [A2 B2]]. + exists v2; split; auto. + destruct x; simpl; auto. simpl in *. inv B1. simpl in *. inv B2. + rewrite Int.sign_ext_shr_shl. auto. compute; auto. +Qed. -Theorem eval_addf: - forall le a x b y, - eval_expr ge sp e m le a (Vfloat x) -> - eval_expr ge sp e m le b (Vfloat y) -> - eval_expr ge sp e m le (addf a b) (Vfloat (Float.add x y)). -Proof. intros; unfold addf; EvalOp. Qed. +Theorem eval_cast8unsigned: unary_constructor_sound cast8unsigned (Val.zero_ext 8). +Proof. + red; intros until x. unfold cast8unsigned. + rewrite Val.zero_ext_and. apply eval_andimm. compute; auto. +Qed. -Theorem eval_subf: - forall le a x b y, - eval_expr ge sp e m le a (Vfloat x) -> - eval_expr ge sp e m le b (Vfloat y) -> - eval_expr ge sp e m le (subf a b) (Vfloat (Float.sub x y)). -Proof. intros; unfold subf; EvalOp. Qed. +Theorem eval_cast16signed: unary_constructor_sound cast16signed (Val.sign_ext 16). +Proof. + red; intros. unfold cast16signed. + exploit (eval_shlimm (Int.repr 16)); eauto. intros [v1 [A1 B1]]. + exploit (eval_shrimm (Int.repr 16)). eexact A1. intros [v2 [A2 B2]]. + exists v2; split; auto. + destruct x; simpl; auto. simpl in *. inv B1. simpl in *. inv B2. + rewrite Int.sign_ext_shr_shl. auto. compute; auto. +Qed. -Theorem eval_mulf: - forall le a x b y, - eval_expr ge sp e m le a (Vfloat x) -> - eval_expr ge sp e m le b (Vfloat y) -> - eval_expr ge sp e m le (mulf a b) (Vfloat (Float.mul x y)). -Proof. intros; unfold mulf; EvalOp. Qed. +Theorem eval_cast16unsigned: unary_constructor_sound cast16unsigned (Val.zero_ext 16). +Proof. + red; intros until x. unfold cast8unsigned. + rewrite Val.zero_ext_and. apply eval_andimm. compute; auto. +Qed. -Theorem eval_divf: - forall le a x b y, - eval_expr ge sp e m le a (Vfloat x) -> - eval_expr ge sp e m le b (Vfloat y) -> - eval_expr ge sp e m le (divf a b) (Vfloat (Float.div x y)). -Proof. intros; unfold divf; EvalOp. Qed. +Theorem eval_singleoffloat: unary_constructor_sound singleoffloat Val.singleoffloat. +Proof. + red; intros. unfold singleoffloat. TrivialExists. +Qed. Theorem eval_intoffloat: - forall le a x n, - eval_expr ge sp e m le a (Vfloat x) -> - Float.intoffloat x = Some n -> - eval_expr ge sp e m le (intoffloat a) (Vint n). + forall le a x y, + eval_expr ge sp e m le a x -> + Val.intoffloat x = Some y -> + exists v, eval_expr ge sp e m le (intoffloat a) v /\ Val.lessdef y v. Proof. - intros; unfold intoffloat; EvalOp. - simpl. rewrite H0. auto. + intros; unfold intoffloat. TrivialExists. Qed. -Theorem eval_intuoffloat: - forall le a x n, - eval_expr ge sp e m le a (Vfloat x) -> - Float.intuoffloat x = Some n -> - eval_expr ge sp e m le (intuoffloat a) (Vint n). +Theorem eval_floatofint: + forall le a x y, + eval_expr ge sp e m le a x -> + Val.floatofint x = Some y -> + exists v, eval_expr ge sp e m le (floatofint a) v /\ Val.lessdef y v. Proof. - intros; unfold intuoffloat; EvalOp. - simpl. rewrite H0. auto. + intros; unfold floatofint. TrivialExists. Qed. -Theorem eval_floatofint: - forall le a x, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le (floatofint a) (Vfloat (Float.floatofint x)). -Proof. intros; unfold floatofint; EvalOp. Qed. +Theorem eval_intuoffloat: + forall le a x y, + eval_expr ge sp e m le a x -> + Val.intuoffloat x = Some y -> + exists v, eval_expr ge sp e m le (intuoffloat a) v /\ Val.lessdef y v. +Proof. + intros; unfold intuoffloat. TrivialExists. +Qed. Theorem eval_floatofintu: - forall le a x, - eval_expr ge sp e m le a (Vint x) -> - eval_expr ge sp e m le (floatofintu a) (Vfloat (Float.floatofintu x)). -Proof. intros; unfold floatofintu; EvalOp. Qed. + forall le a x y, + eval_expr ge sp e m le a x -> + Val.floatofintu x = Some y -> + exists v, eval_expr ge sp e m le (floatofintu a) v /\ Val.lessdef y v. +Proof. + intros; unfold floatofintu. TrivialExists. +Qed. -Lemma eval_addressing: +Theorem eval_addressing: forall le chunk a v b ofs, eval_expr ge sp e m le a v -> v = Vptr b ofs -> @@ -974,29 +732,16 @@ Lemma eval_addressing: Proof. intros until v. unfold addressing; case (addressing_match a); intros; InvEval. exists (@nil val). split. eauto with evalexpr. simpl. auto. - exists (Vptr b0 i :: nil). split. eauto with evalexpr. - simpl. congruence. - destruct (can_use_Aindexed2 chunk). - exists (Vptr b0 i :: Vint i0 :: nil). - split. eauto with evalexpr. simpl. congruence. - exists (Vptr b0 ofs :: nil). - split. constructor. econstructor. eauto with evalexpr. simpl. congruence. constructor. - simpl. rewrite Int.add_zero. congruence. - destruct (can_use_Aindexed chunk). - exists (Vint i :: Vptr b0 i0 :: nil). - split. eauto with evalexpr. simpl. - rewrite Int.add_commut. congruence. - exists (Vptr b0 ofs :: nil). - split. constructor. econstructor. eauto with evalexpr. simpl. congruence. constructor. - simpl. rewrite Int.add_zero. congruence. - destruct (can_use_Aindexed chunk). - exists (Vptr b0 i :: Vint i0 :: nil). - split. eauto with evalexpr. simpl. congruence. - exists (Vptr b0 ofs :: nil). - split. constructor. econstructor. eauto with evalexpr. simpl. congruence. constructor. - simpl. rewrite Int.add_zero. congruence. - exists (v :: nil). split. eauto with evalexpr. - subst v. simpl. rewrite Int.add_zero. auto. + exists (v1 :: nil); split. eauto with evalexpr. simpl. congruence. + destruct (can_use_Aindexed2shift chunk); simpl. + exists (v1 :: v0 :: nil); split. eauto with evalexpr. congruence. + exists (Vptr b ofs :: nil); split. constructor. EvalOp. simpl. congruence. constructor. + simpl. rewrite Int.add_zero; auto. + destruct (can_use_Aindexed2 chunk); simpl. + exists (v1 :: v0 :: nil); split. eauto with evalexpr. congruence. + exists (Vptr b ofs :: nil); split. constructor. EvalOp. simpl. congruence. constructor. + simpl. rewrite Int.add_zero; auto. + exists (v :: nil); split. eauto with evalexpr. subst. simpl. rewrite Int.add_zero; auto. Qed. End CMCONSTR. -- cgit