From 23fa2a18e015b9d330ad6f1f08cf50adf90bd80b Mon Sep 17 00:00:00 2001 From: David Monniaux Date: Thu, 21 Mar 2019 22:39:27 +0100 Subject: try to be portable across archs --- arm/Machregsaux.ml | 5 +++++ arm/Machregsaux.mli | 2 ++ 2 files changed, 7 insertions(+) (limited to 'arm') diff --git a/arm/Machregsaux.ml b/arm/Machregsaux.ml index ce5c67f6..14c75155 100644 --- a/arm/Machregsaux.ml +++ b/arm/Machregsaux.ml @@ -33,3 +33,8 @@ let register_by_name s = let can_reserve_register r = List.mem r Conventions1.int_callee_save_regs || List.mem r Conventions1.float_callee_save_regs + +let class_of_type = function + | AST.Tint | AST.Tlong -> 0 + | AST.Tfloat | AST.Tsingle -> 1 + | AST.Tany32 | AST.Tany64 -> assert false diff --git a/arm/Machregsaux.mli b/arm/Machregsaux.mli index 9404568d..d7117c21 100644 --- a/arm/Machregsaux.mli +++ b/arm/Machregsaux.mli @@ -16,3 +16,5 @@ val name_of_register: Machregs.mreg -> string option val register_by_name: string -> Machregs.mreg option val is_scratch_register: string -> bool val can_reserve_register: Machregs.mreg -> bool + +val class_of_type: AST.typ -> int -- cgit From 5281141d38a492eea3e080e087b91a314b0be020 Mon Sep 17 00:00:00 2001 From: David Monniaux Date: Fri, 22 Mar 2019 09:51:56 +0100 Subject: ARM repasse --- arm/SelectLong.vp | 2 +- arm/SelectLongproof.v | 1 + arm/SelectOp.vp | 8 ++++++++ arm/SelectOpproof.v | 28 ++++++++++++++++++++++++++-- 4 files changed, 36 insertions(+), 3 deletions(-) (limited to 'arm') diff --git a/arm/SelectLong.vp b/arm/SelectLong.vp index cc7a38f6..b4cdd0e3 100644 --- a/arm/SelectLong.vp +++ b/arm/SelectLong.vp @@ -16,6 +16,6 @@ Require Import Coqlib. Require Import Compopts. Require Import AST Integers Floats. Require Import Op CminorSel. -Require Import SelectOp SplitLong. +Require Import OpHelpers SelectOp SplitLong. (** This file is empty because we use the default implementation provided in [SplitLong]. *) diff --git a/arm/SelectLongproof.v b/arm/SelectLongproof.v index a82c082c..a65a38d4 100644 --- a/arm/SelectLongproof.v +++ b/arm/SelectLongproof.v @@ -16,6 +16,7 @@ Require Import String Coqlib Maps Integers Floats Errors. Require Archi. Require Import AST Values Memory Globalenvs Events. Require Import Cminor Op CminorSel. +Require Import OpHelpers OpHelpersproof. Require Import SelectOp SelectOpproof SplitLong SplitLongproof. Require Import SelectLong. diff --git a/arm/SelectOp.vp b/arm/SelectOp.vp index c361df65..f3f01730 100644 --- a/arm/SelectOp.vp +++ b/arm/SelectOp.vp @@ -42,6 +42,7 @@ Require Import AST. Require Import Integers. Require Import Floats. Require Import Op. +Require Import OpHelpers. Require Import CminorSel. Local Open Scope cminorsel_scope. @@ -508,3 +509,10 @@ Nondetfunction builtin_arg (e: expr) := | Eop (Oaddimm n) (e1:::Enil) => BA_addptr (BA e1) (BA_int n) | _ => BA e end. + +(* floats *) +Definition divf_base (e1: expr) (e2: expr) := + Eop Odivf (e1 ::: e2 ::: Enil). + +Definition divfs_base (e1: expr) (e2: expr) := + Eop Odivfs (e1 ::: e2 ::: Enil). diff --git a/arm/SelectOpproof.v b/arm/SelectOpproof.v index d4aac9b6..212bcfd7 100644 --- a/arm/SelectOpproof.v +++ b/arm/SelectOpproof.v @@ -24,6 +24,7 @@ Require Import Cminor. Require Import Op. Require Import CminorSel. Require Import SelectOp. +Require Import OpHelpers OpHelpersproof. Local Open Scope cminorsel_scope. Local Transparent Archi.ptr64. @@ -76,8 +77,10 @@ Ltac TrivialExists := (** * Correctness of the smart constructors *) Section CMCONSTR. - -Variable ge: genv. +Variable prog: program. +Variable hf: helper_functions. +Hypothesis HELPERS: helper_functions_declared prog hf. +Let ge := Genv.globalenv prog. Variable sp: val. Variable e: env. Variable m: mem. @@ -893,4 +896,25 @@ Proof. - constructor; auto. Qed. + +(* floating-point division without HELPERS *) +Theorem eval_divf_base: + forall le a b x 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 (divf_base a b) v /\ Val.lessdef (Val.divf x y) v. +Proof. + intros; unfold divf_base. + TrivialExists. +Qed. + +Theorem eval_divfs_base: + forall le a b x 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 (divfs_base a b) v /\ Val.lessdef (Val.divfs x y) v. +Proof. + intros; unfold divfs_base. + TrivialExists. +Qed. End CMCONSTR. -- cgit From b7e0d70de2ace6f0a22f9f65cc244d875ee48496 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sat, 1 Jun 2019 08:48:20 +0200 Subject: ARM: select is not supported at type Tlong --- arm/SelectOp.vp | 9 ++++++++- arm/SelectOpproof.v | 4 +++- 2 files changed, 11 insertions(+), 2 deletions(-) (limited to 'arm') diff --git a/arm/SelectOp.vp b/arm/SelectOp.vp index 61ea6283..d04832d6 100644 --- a/arm/SelectOp.vp +++ b/arm/SelectOp.vp @@ -383,7 +383,14 @@ Definition compfs (c: comparison) (e1: expr) (e2: expr) := Eop (Ocmp (Ccompfs c)) (e1 ::: e2 ::: Enil). Definition select (ty: typ) (cond: condition) (args: exprlist) (e1 e2: expr) := - Some (Eop (Osel cond ty) (e1 ::: e2 ::: args)). + if match ty with + | Tint => true + | Tfloat => true + | Tsingle => true + | _ => false + end + then Some (Eop (Osel cond ty) (e1 ::: e2 ::: args)) + else None. (** ** Integer conversions *) diff --git a/arm/SelectOpproof.v b/arm/SelectOpproof.v index f281f7ce..8b546971 100644 --- a/arm/SelectOpproof.v +++ b/arm/SelectOpproof.v @@ -746,7 +746,9 @@ Theorem eval_select: eval_expr ge sp e m le a v /\ Val.lessdef (Val.select (Some b) v1 v2 ty) v. Proof. - unfold select; intros; inv H. rewrite <- H3; TrivialExists. + unfold select; intros. + destruct (match ty with Tint | Tfloat | Tsingle => true | _ => false end); inv H. + rewrite <- H3; TrivialExists. Qed. Theorem eval_cast8signed: unary_constructor_sound cast8signed (Val.sign_ext 8). -- cgit From 4c379d48b35e7c8156f3953fede31d5e47faf8ca Mon Sep 17 00:00:00 2001 From: David Monniaux Date: Fri, 19 Jul 2019 18:59:44 +0200 Subject: helpers broke compilation --- arm/SelectOp.vp | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) (limited to 'arm') diff --git a/arm/SelectOp.vp b/arm/SelectOp.vp index ed4c2c95..5506157c 100644 --- a/arm/SelectOp.vp +++ b/arm/SelectOp.vp @@ -516,16 +516,14 @@ Nondetfunction builtin_arg (e: expr) := | _ => BA e end. -<<<<<<< HEAD (* floats *) Definition divf_base (e1: expr) (e2: expr) := Eop Odivf (e1 ::: e2 ::: Enil). Definition divfs_base (e1: expr) (e2: expr) := Eop Odivfs (e1 ::: e2 ::: Enil). -======= + (** Platform-specific known builtins *) Definition platform_builtin (b: platform_builtin) (args: exprlist) : option expr := None. ->>>>>>> 91381b65f5aa76e5195caae9ef331b3f5f95afaf -- cgit From 35febfa5b231a71234a1b32c128169352e96eaca Mon Sep 17 00:00:00 2001 From: David Monniaux Date: Sat, 7 Sep 2019 12:27:43 +0200 Subject: fixes for ARM --- arm/Asmexpand.ml | 27 +++++++++++++-------------- arm/Asmgen.v | 13 +++++++++---- arm/Asmgenproof.v | 7 +++++++ arm/Asmgenproof1.v | 8 +++++--- arm/Op.v | 40 ++++++++++++++++++++++++++++++++++++++++ 5 files changed, 74 insertions(+), 21 deletions(-) (limited to 'arm') diff --git a/arm/Asmexpand.ml b/arm/Asmexpand.ml index a4ec0c5d..5d5779d4 100644 --- a/arm/Asmexpand.ml +++ b/arm/Asmexpand.ml @@ -18,7 +18,6 @@ open Asm open Asmexpandaux open AST open Camlcoq -open Integers exception Error of string @@ -104,7 +103,7 @@ let memcpy_small_arg sz arg tmp = (r, _0) | BA_addrstack ofs -> if offset_in_range ofs - && offset_in_range (Int.add ofs (Int.repr (Z.of_uint sz))) + && offset_in_range (Integers.Int.add ofs (Integers.Int.repr (Z.of_uint sz))) then (IR13, ofs) else begin expand_addimm tmp IR13 ofs; (tmp, _0) end | _ -> @@ -119,19 +118,19 @@ let expand_builtin_memcpy_small sz al src dst = if sz >= 8 && al >= 4 && !Clflags.option_ffpu then begin emit (Pfldd (FR7,rsrc,osrc)); emit (Pfstd (FR7,rdst,odst)); - copy (Int.add osrc _8) (Int.add odst _8) (sz - 8) + copy (Integers.Int.add osrc _8) (Integers.Int.add odst _8) (sz - 8) end else if sz >= 4 && al >= 4 then begin emit (Pldr (IR14,rsrc,SOimm osrc)); emit (Pstr (IR14,rdst,SOimm odst)); - copy (Int.add osrc _4) (Int.add odst _4) (sz - 4) + copy (Integers.Int.add osrc _4) (Integers.Int.add odst _4) (sz - 4) end else if sz >= 2 && al >= 2 then begin emit (Pldrh (IR14,rsrc,SOimm osrc)); emit (Pstrh (IR14,rdst,SOimm odst)); - copy (Int.add osrc _2) (Int.add odst _2) (sz - 2) + copy (Integers.Int.add osrc _2) (Integers.Int.add odst _2) (sz - 2) end else if sz >= 1 then begin emit (Pldrb (IR14,rsrc,SOimm osrc)); emit (Pstrb (IR14,rdst,SOimm odst)); - copy (Int.add osrc _1) (Int.add odst _1) (sz - 1) + copy (Integers.Int.add osrc _1) (Integers.Int.add odst _1) (sz - 1) end in copy osrc odst sz @@ -188,8 +187,8 @@ let expand_builtin_vload_common chunk base ofs res = | Mint32, BR(IR res) -> emit (Pldr (res, base, SOimm ofs)) | Mint64, BR_splitlong(BR(IR res1), BR(IR res2)) -> - let ofs_hi = if Archi.big_endian then ofs else Int.add ofs _4 in - let ofs_lo = if Archi.big_endian then Int.add ofs _4 else ofs in + let ofs_hi = if Archi.big_endian then ofs else Integers.Int.add ofs _4 in + let ofs_lo = if Archi.big_endian then Integers.Int.add ofs _4 else ofs in if base <> res2 then begin emit (Pldr (res2, base, SOimm ofs_lo)); emit (Pldr (res1, base, SOimm ofs_hi)) @@ -209,7 +208,7 @@ let expand_builtin_vload chunk args res = | [BA(IR addr)] -> expand_builtin_vload_common chunk addr _0 res | [BA_addrstack ofs] -> - if offset_in_range (Int.add ofs (Memdata.size_chunk chunk)) then + if offset_in_range (Integers.Int.add ofs (Memdata.size_chunk chunk)) then expand_builtin_vload_common chunk IR13 ofs res else begin expand_addimm IR14 IR13 ofs; @@ -219,7 +218,7 @@ let expand_builtin_vload chunk args res = emit (Ploadsymbol (IR14,id,ofs)); expand_builtin_vload_common chunk IR14 _0 res | [BA_addptr(BA(IR addr), BA_int ofs)] -> - if offset_in_range (Int.add ofs (Memdata.size_chunk chunk)) then + if offset_in_range (Integers.Int.add ofs (Memdata.size_chunk chunk)) then expand_builtin_vload_common chunk addr ofs res else begin expand_addimm IR14 addr ofs; @@ -237,8 +236,8 @@ let expand_builtin_vstore_common chunk base ofs src = | Mint32, BA(IR src) -> emit (Pstr (src, base, SOimm ofs)) | Mint64, BA_splitlong(BA(IR src1), BA(IR src2)) -> - let ofs_hi = if Archi.big_endian then ofs else Int.add ofs _4 in - let ofs_lo = if Archi.big_endian then Int.add ofs _4 else ofs in + let ofs_hi = if Archi.big_endian then ofs else Integers.Int.add ofs _4 in + let ofs_lo = if Archi.big_endian then Integers.Int.add ofs _4 else ofs in emit (Pstr (src2, base, SOimm ofs_lo)); emit (Pstr (src1, base, SOimm ofs_hi)) | Mfloat32, BA(FR src) -> @@ -253,7 +252,7 @@ let expand_builtin_vstore chunk args = | [BA(IR addr); src] -> expand_builtin_vstore_common chunk addr _0 src | [BA_addrstack ofs; src] -> - if offset_in_range (Int.add ofs (Memdata.size_chunk chunk)) then + if offset_in_range (Integers.Int.add ofs (Memdata.size_chunk chunk)) then expand_builtin_vstore_common chunk IR13 ofs src else begin expand_addimm IR14 IR13 ofs; @@ -263,7 +262,7 @@ let expand_builtin_vstore chunk args = emit (Ploadsymbol (IR14,id,ofs)); expand_builtin_vstore_common chunk IR14 _0 src | [BA_addptr(BA(IR addr), BA_int ofs); src] -> - if offset_in_range (Int.add ofs (Memdata.size_chunk chunk)) then + if offset_in_range (Integers.Int.add ofs (Memdata.size_chunk chunk)) then expand_builtin_vstore_common chunk addr ofs src else begin expand_addimm IR14 addr ofs; diff --git a/arm/Asmgen.v b/arm/Asmgen.v index 1a1e7f2f..016a1c5a 100644 --- a/arm/Asmgen.v +++ b/arm/Asmgen.v @@ -689,8 +689,12 @@ Definition transl_memory_access_float None mk_immed addr args k. -Definition transl_load (chunk: memory_chunk) (addr: addressing) - (args: list mreg) (dst: mreg) (k: code) := +Definition transl_load (trap : trapping_mode) + (chunk: memory_chunk) (addr: addressing) + (args: list mreg) (dst: mreg) (k: code) := + match trap with + | NOTRAP => Error (msg "Asmgen.transl_load non-trapping loads unsupported on Arm") + | TRAP => match chunk with | Mint8signed => transl_memory_access_int Pldrsb mk_immed_mem_small dst addr args k @@ -708,6 +712,7 @@ Definition transl_load (chunk: memory_chunk) (addr: addressing) transl_memory_access_float Pfldd mk_immed_mem_float dst addr args k | _ => Error (msg "Asmgen.transl_load") + end end. Definition transl_store (chunk: memory_chunk) (addr: addressing) @@ -747,8 +752,8 @@ Definition transl_instr (f: Mach.function) (i: Mach.instruction) else loadind_int IR13 f.(fn_link_ofs) IR12 c) | Mop op args res => transl_op op args res k - | Mload chunk addr args dst => - transl_load chunk addr args dst k + | Mload trap chunk addr args dst => + transl_load trap chunk addr args dst k | Mstore chunk addr args src => transl_store chunk addr args src k | Mcall sig (inl arg) => diff --git a/arm/Asmgenproof.v b/arm/Asmgenproof.v index 25f91d23..92ae524f 100644 --- a/arm/Asmgenproof.v +++ b/arm/Asmgenproof.v @@ -303,6 +303,7 @@ Proof. eapply tail_nolabel_trans. 2: eapply loadind_label; eauto. unfold loadind_int; TailNoLabel. eapply transl_op_label; eauto. unfold transl_load, transl_memory_access_int, transl_memory_access_float in H. + destruct t; try discriminate. destruct m; monadInv H; eapply transl_memory_access_label; eauto; simpl; auto. unfold transl_store, transl_memory_access_int, transl_memory_access_float in H. destruct m; monadInv H; eapply transl_memory_access_label; eauto; simpl; auto. @@ -618,6 +619,12 @@ Opaque loadind. split. eapply agree_set_undef_mreg; eauto. congruence. simpl; congruence. +- (* Mload notrap1 *) + inv AT. simpl in *. unfold bind in *. destruct (transl_code _ _ _) in *; discriminate. + +- (* Mload notrap *) + inv AT. simpl in *. unfold bind in *. destruct (transl_code _ _ _) in *; discriminate. + - (* Mstore *) assert (eval_addressing tge sp addr rs##args = Some a). rewrite <- H. apply eval_addressing_preserved. exact symbols_preserved. diff --git a/arm/Asmgenproof1.v b/arm/Asmgenproof1.v index 807e069d..7ef7b776 100644 --- a/arm/Asmgenproof1.v +++ b/arm/Asmgenproof1.v @@ -1540,8 +1540,8 @@ Proof. Qed. Lemma transl_load_correct: - forall chunk addr args dst k c (rs: regset) a m v, - transl_load chunk addr args dst k = OK c -> + forall trap chunk addr args dst k c (rs: regset) a m v, + transl_load trap chunk addr args dst k = OK c -> eval_addressing ge (rs#SP) addr (map rs (map preg_of args)) = Some a -> Mem.loadv chunk m a = Some v -> exists rs', @@ -1549,7 +1549,9 @@ Lemma transl_load_correct: /\ rs'#(preg_of dst) = v /\ forall r, data_preg r = true -> r <> preg_of dst -> rs'#r = rs#r. Proof. - intros. destruct chunk; simpl in H. + intros. + destruct trap; try (simpl in *; discriminate). + destruct chunk; simpl in H. eapply transl_load_int_correct; eauto. eapply transl_load_int_correct; eauto. eapply transl_load_int_correct; eauto. diff --git a/arm/Op.v b/arm/Op.v index cc90e043..9de365e9 100644 --- a/arm/Op.v +++ b/arm/Op.v @@ -975,6 +975,20 @@ Proof. apply Val.offset_ptr_inject; auto. Qed. +Lemma eval_addressing_inj_none: + forall addr sp1 vl1 sp2 vl2, + (forall id ofs, + In id (globals_addressing addr) -> + Val.inject f (Genv.symbol_address ge1 id ofs) (Genv.symbol_address ge2 id ofs)) -> + Val.inject f sp1 sp2 -> + Val.inject_list f vl1 vl2 -> + eval_addressing ge1 sp1 addr vl1 = None -> + eval_addressing ge2 sp2 addr vl2 = None. +Proof. + intros until vl2. intros Hglobal Hinjsp Hinjvl. + destruct addr; simpl in *; + inv Hinjvl; trivial; try discriminate; inv H0; trivial; try discriminate; inv H2; trivial; try discriminate. +Qed. End EVAL_COMPAT. (** Compatibility of the evaluation functions with the ``is less defined'' relation over values. *) @@ -1080,6 +1094,19 @@ Proof. destruct H1 as [v2 [A B]]. exists v2; split; auto. rewrite val_inject_lessdef; auto. Qed. +Lemma eval_addressing_lessdef_none: + forall sp addr vl1 vl2, + Val.lessdef_list vl1 vl2 -> + eval_addressing genv sp addr vl1 = None -> + eval_addressing genv sp addr vl2 = None. +Proof. + intros. rewrite val_inject_list_lessdef in H. + eapply eval_addressing_inj_none with (sp1 := sp). + intros. rewrite <- val_inject_lessdef; auto. + rewrite <- val_inject_lessdef; auto. + eauto. auto. +Qed. + End EVAL_LESSDEF. (** Compatibility of the evaluation functions with memory injections. *) @@ -1132,6 +1159,19 @@ Proof. econstructor; eauto. rewrite Ptrofs.add_zero_l; auto. Qed. +Lemma eval_addressing_inject_none: + forall addr vl1 vl2, + Val.inject_list f vl1 vl2 -> + eval_addressing genv (Vptr sp1 Ptrofs.zero) addr vl1 = None -> + eval_addressing genv (Vptr sp2 Ptrofs.zero) (shift_stack_addressing delta addr) vl2 = None. +Proof. + intros. + rewrite eval_shift_stack_addressing. + eapply eval_addressing_inj_none with (sp1 := Vptr sp1 Ptrofs.zero); eauto. + intros. apply symbol_address_inject. + econstructor; eauto. rewrite Ptrofs.add_zero_l; auto. +Qed. + Lemma eval_operation_inject: forall op vl1 vl2 v1 m1 m2, Val.inject_list f vl1 vl2 -> -- cgit From c7156a4fd9c449c7610942a2fbf1e0908459b7f6 Mon Sep 17 00:00:00 2001 From: David Monniaux Date: Mon, 23 Sep 2019 19:48:20 +0200 Subject: add: non trapping ops --- arm/Op.v | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) (limited to 'arm') diff --git a/arm/Op.v b/arm/Op.v index 9de365e9..671bdbe4 100644 --- a/arm/Op.v +++ b/arm/Op.v @@ -518,6 +518,32 @@ Proof with (try exact I; try reflexivity). unfold Val.select. destruct (eval_condition c vl m). apply Val.normalize_type. exact I. Qed. + +Definition is_trapping_op (op : operation) := + match op with + | Odiv | Odivu + | Oshrximm _ + | Ointoffloat | Ointuoffloat + | Ointofsingle | Ointuofsingle + | Ofloatofint | Ofloatofintu + | Osingleofint | Osingleofintu => true + | _ => false + end. + + +Lemma is_trapping_op_sound: + forall op vl sp m, + op <> Omove -> + is_trapping_op op = false -> + (List.length vl) = (List.length (fst (type_of_operation op))) -> + eval_operation genv sp op vl m <> None. +Proof. + destruct op; intros; simpl in *; try congruence. + all: try (destruct vl as [ | vh1 vl1]; try discriminate). + all: try (destruct vl1 as [ | vh2 vl2]; try discriminate). + all: try (destruct vl2 as [ | vh3 vl3]; try discriminate). + all: try (destruct vl3 as [ | vh4 vl4]; try discriminate). +Qed. End SOUNDNESS. (** * Manipulating and transforming operations *) -- cgit From 9475c5637c5d650f43955abe8f995797893affe1 Mon Sep 17 00:00:00 2001 From: David Monniaux Date: Tue, 14 Jan 2020 23:37:20 +0100 Subject: ARM generation of 2-instruction signed division by 2 (as opposed to 3-instruction) --- arm/Asmgen.v | 3 +++ arm/Asmgenproof1.v | 24 +++++++++++++++++++++--- 2 files changed, 24 insertions(+), 3 deletions(-) (limited to 'arm') diff --git a/arm/Asmgen.v b/arm/Asmgen.v index 1a1e7f2f..0ec0a4d0 100644 --- a/arm/Asmgen.v +++ b/arm/Asmgen.v @@ -481,6 +481,9 @@ Definition transl_op do r <- ireg_of res; do r1 <- ireg_of a1; if Int.eq n Int.zero then OK (Pmov r (SOreg r1) :: k) + else if Int.eq n Int.one then + OK (Padd IR14 r1 (SOlsr r1 (Int.repr 31)) :: + Pmov r (SOasr IR14 n) :: k) else OK (Pmov IR14 (SOasr r1 (Int.repr 31)) :: Padd IR14 r1 (SOlsr IR14 (Int.sub Int.iwordsize n)) :: diff --git a/arm/Asmgenproof1.v b/arm/Asmgenproof1.v index 807e069d..2b125cda 100644 --- a/arm/Asmgenproof1.v +++ b/arm/Asmgenproof1.v @@ -1264,15 +1264,32 @@ Local Transparent destroyed_by_op. destruct (rs x0) eqn: X0; simpl in H0; try discriminate. destruct (Int.ltu i (Int.repr 31)) eqn: LTU; inv H0. revert EQ2. predSpec Int.eq Int.eq_spec i Int.zero; intros EQ2. + { (* i = 0 *) inv EQ2. econstructor. split. apply exec_straight_one. simpl. reflexivity. auto. split. Simpl. unfold Int.shrx. rewrite Int.shl_zero. unfold Int.divs. change (Int.signed Int.one) with 1. rewrite Z.quot_1_r. rewrite Int.repr_signed. auto. intros. Simpl. - (* i <> 0 *) - inv EQ2. - assert (LTU': Int.ltu (Int.sub Int.iwordsize i) Int.iwordsize = true). + } + { (* i <> 0 *) + revert EQ2. predSpec Int.eq Int.eq_spec i Int.one; intros EQ2. + { + inv EQ2. + econstructor; split. + eapply exec_straight_two; simpl; reflexivity. + split. + { rewrite X0. + rewrite Int.shrx1_shr by reflexivity. + Simpl. + } + { intros. + Simpl. + } + } + clear H0. + inv EQ2. + assert (LTU': Int.ltu (Int.sub Int.iwordsize i) Int.iwordsize = true). { generalize (Int.ltu_inv _ _ LTU). intros. unfold Int.sub, Int.ltu. rewrite Int.unsigned_repr_wordsize. @@ -1306,6 +1323,7 @@ Local Transparent destroyed_by_op. rewrite LTU'; simpl. rewrite LTU''; simpl. f_equal. symmetry. apply Int.shrx_shr_2. assumption. intros. unfold rs3; Simpl. unfold rs2; Simpl. unfold rs1; Simpl. + } (* intoffloat *) econstructor; split. apply exec_straight_one; simpl. rewrite H0; simpl. eauto. auto. Transparent destroyed_by_op. -- cgit From 1b6667cf268189104bc3320e83fa23fe0d053717 Mon Sep 17 00:00:00 2001 From: David Monniaux Date: Fri, 7 Feb 2020 14:29:32 +0100 Subject: stubs to keep compiling on architectures not K1c --- arm/DuplicateOpcodeHeuristic.ml | 3 +++ 1 file changed, 3 insertions(+) create mode 100644 arm/DuplicateOpcodeHeuristic.ml (limited to 'arm') diff --git a/arm/DuplicateOpcodeHeuristic.ml b/arm/DuplicateOpcodeHeuristic.ml new file mode 100644 index 00000000..85505245 --- /dev/null +++ b/arm/DuplicateOpcodeHeuristic.ml @@ -0,0 +1,3 @@ +exception HeuristicSucceeded + +let opcode_heuristic code cond ifso ifnot preferred = () -- cgit