From 19aed83caebcae1103e0c4f6e200744492f17545 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Fri, 24 Apr 2020 15:17:37 +0200 Subject: Use Hashtbl.find_opt. Replace the pattern `try Some (Hashtbl.find ...) with Not_found -> None` by a call to the function Hashtbl.find_opt. --- arm/Machregsaux.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'arm') diff --git a/arm/Machregsaux.ml b/arm/Machregsaux.ml index ce5c67f6..21425851 100644 --- a/arm/Machregsaux.ml +++ b/arm/Machregsaux.ml @@ -25,7 +25,7 @@ let _ = let is_scratch_register s = s = "R14" || s = "r14" let name_of_register r = - try Some (Hashtbl.find register_names r) with Not_found -> None + Hashtbl.find_opt register_names r let register_by_name s = Machregs.register_by_name (coqstring_uppercase_ascii_of_camlstring s) -- cgit From faa1d7fbfd7c9d5aa333d9b353a6118e105c4428 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Sat, 25 Apr 2020 16:52:33 +0200 Subject: Remove the `can_reserve_register` function. The function is in fact just a call to the function`is_callee_save_register` from `Conventions1.v`. --- arm/Machregsaux.ml | 4 ---- arm/Machregsaux.mli | 1 - 2 files changed, 5 deletions(-) (limited to 'arm') diff --git a/arm/Machregsaux.ml b/arm/Machregsaux.ml index 21425851..7d278613 100644 --- a/arm/Machregsaux.ml +++ b/arm/Machregsaux.ml @@ -29,7 +29,3 @@ let name_of_register r = let register_by_name s = Machregs.register_by_name (coqstring_uppercase_ascii_of_camlstring s) - -let can_reserve_register r = - List.mem r Conventions1.int_callee_save_regs - || List.mem r Conventions1.float_callee_save_regs diff --git a/arm/Machregsaux.mli b/arm/Machregsaux.mli index 9404568d..884100bb 100644 --- a/arm/Machregsaux.mli +++ b/arm/Machregsaux.mli @@ -15,4 +15,3 @@ 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 -- cgit From ad2ea9c2e701dd82c26e6cd3e8a777be9bdef2a2 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Wed, 29 Apr 2020 15:12:54 +0200 Subject: Move shared code in new file. The name_of_register and register_of_name function are shared between all architectures and can be moved in a common file. --- arm/Machregsaux.ml | 16 ---------------- arm/Machregsaux.mli | 2 -- 2 files changed, 18 deletions(-) (limited to 'arm') diff --git a/arm/Machregsaux.ml b/arm/Machregsaux.ml index 7d278613..a4624a9d 100644 --- a/arm/Machregsaux.ml +++ b/arm/Machregsaux.ml @@ -12,20 +12,4 @@ (** Auxiliary functions on machine registers *) -open Camlcoq -open Machregs - -let register_names : (mreg, string) Hashtbl.t = Hashtbl.create 31 - -let _ = - List.iter - (fun (s, r) -> Hashtbl.add register_names r (camlstring_of_coqstring s)) - Machregs.register_names - let is_scratch_register s = s = "R14" || s = "r14" - -let name_of_register r = - Hashtbl.find_opt register_names r - -let register_by_name s = - Machregs.register_by_name (coqstring_uppercase_ascii_of_camlstring s) diff --git a/arm/Machregsaux.mli b/arm/Machregsaux.mli index 884100bb..f3d52849 100644 --- a/arm/Machregsaux.mli +++ b/arm/Machregsaux.mli @@ -12,6 +12,4 @@ (** Auxiliary functions on machine registers *) -val name_of_register: Machregs.mreg -> string option -val register_by_name: string -> Machregs.mreg option val is_scratch_register: string -> bool -- cgit From fde847543e8169082db0138a9713a8c0ab0cc167 Mon Sep 17 00:00:00 2001 From: Bernhard Schommer Date: Tue, 30 Jun 2020 12:44:23 +0200 Subject: Added missing hint database name. --- arm/Asmgenproof.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'arm') diff --git a/arm/Asmgenproof.v b/arm/Asmgenproof.v index 25f91d23..a592e12a 100644 --- a/arm/Asmgenproof.v +++ b/arm/Asmgenproof.v @@ -225,7 +225,7 @@ Proof. TailNoLabel. eapply tail_nolabel_trans; TailNoLabel. Qed. -Hint Resolve indexed_memory_access_label. +Hint Resolve indexed_memory_access_label: labels. Remark loadind_label: forall base ofs ty dst k c, loadind base ofs ty dst k = OK c -> tail_nolabel k c. -- cgit From 465f6b4120bb38d2ef2871de4972df92ee935ed6 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sat, 25 Jul 2020 10:37:05 +0200 Subject: No need to process __builtin_fabs in $ARCH/Asmexpand.ml __builtin_fabs has already been expanded in backend/Selection.v . --- arm/Asmexpand.ml | 2 -- 1 file changed, 2 deletions(-) (limited to 'arm') diff --git a/arm/Asmexpand.ml b/arm/Asmexpand.ml index 89aab5c7..e1e72dbc 100644 --- a/arm/Asmexpand.ml +++ b/arm/Asmexpand.ml @@ -349,8 +349,6 @@ let expand_builtin_inline name args res = emit (Prsb(res, res, SOimm _32)); emit (Plabel lbl2) (* Float arithmetic *) - | "__builtin_fabs", [BA(FR a1)], BR(FR res) -> - emit (Pfabsd (res,a1)) | "__builtin_fsqrt", [BA(FR a1)], BR(FR res) -> emit (Pfsqrt (res,a1)) (* 64-bit integer arithmetic *) -- cgit From bc20d7c0d16d07790fb6eb608bf608237b0abbc3 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sat, 25 Jul 2020 17:47:25 +0200 Subject: Move declarations of __builtin_clz* and __builtin_ctz* to C2C.ml These functions are now available on all targets. --- arm/CBuiltins.ml | 13 ------------- 1 file changed, 13 deletions(-) (limited to 'arm') diff --git a/arm/CBuiltins.ml b/arm/CBuiltins.ml index d6a1ea35..6462a8c5 100644 --- a/arm/CBuiltins.ml +++ b/arm/CBuiltins.ml @@ -22,19 +22,6 @@ let builtins = { "__builtin_va_list", TPtr(TVoid [], []) ]; builtin_functions = [ - (* Integer arithmetic *) - "__builtin_clz", - (TInt(IInt, []), [TInt(IUInt, [])], false); - "__builtin_clzl", - (TInt(IInt, []), [TInt(IULong, [])], false); - "__builtin_clzll", - (TInt(IInt, []), [TInt(IULongLong, [])], false); - "__builtin_ctz", - (TInt(IInt, []), [TInt(IUInt, [])], false); - "__builtin_ctzl", - (TInt(IInt, []), [TInt(IULong, [])], false); - "__builtin_ctzll", - (TInt(IInt, []), [TInt(IULongLong, [])], false); (* Memory accesses *) "__builtin_read16_reversed", (TInt(IUShort, []), [TPtr(TInt(IUShort, [AConst]), [])], false); -- cgit From 77ce8ba291afa9f5629a160df440f9af6614f3ef Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 27 Jul 2020 09:54:00 +0200 Subject: Add __builtin_sqrt as synonymous for __builtin_fsqrt __builtin_sqrt (no "f") is the name used by GCC and Clang. --- arm/Asmexpand.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'arm') diff --git a/arm/Asmexpand.ml b/arm/Asmexpand.ml index e1e72dbc..f4e79a37 100644 --- a/arm/Asmexpand.ml +++ b/arm/Asmexpand.ml @@ -349,7 +349,7 @@ let expand_builtin_inline name args res = emit (Prsb(res, res, SOimm _32)); emit (Plabel lbl2) (* Float arithmetic *) - | "__builtin_fsqrt", [BA(FR a1)], BR(FR res) -> + | ("__builtin_fsqrt" | "__builtin_sqrt"), [BA(FR a1)], BR(FR res) -> emit (Pfsqrt (res,a1)) (* 64-bit integer arithmetic *) | "__builtin_negl", [BA_splitlong(BA(IR ah), BA(IR al))], -- cgit From ab0d9476db875a82cf293623d18552b62f239d5c Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Mon, 21 Sep 2020 14:15:57 +0200 Subject: Support the use of already-installed MenhirLib and Flocq libraries configure flags -use-external-Flocq and -use external-MenhirLib. --- arm/Archi.v | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'arm') diff --git a/arm/Archi.v b/arm/Archi.v index 16d6c71d..2ca79710 100644 --- a/arm/Archi.v +++ b/arm/Archi.v @@ -16,9 +16,8 @@ (** Architecture-dependent parameters for ARM *) +From Flocq Require Import Binary Bits. Require Import ZArith List. -(*From Flocq*) -Require Import Binary Bits. Definition ptr64 := false. -- cgit From a4cfb9c2ffdef07fa0d478e66f279687c9823d42 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Sun, 6 Dec 2020 16:47:01 +0100 Subject: ARM modeling of registers destroyed by pseudo-instructions Pflid destroys IR14 Inlined built-in functions destroy IR14 --- arm/Asm.v | 4 ++-- arm/Asmgenproof.v | 6 ++++-- 2 files changed, 6 insertions(+), 4 deletions(-) (limited to 'arm') diff --git a/arm/Asm.v b/arm/Asm.v index 194074ac..293df274 100644 --- a/arm/Asm.v +++ b/arm/Asm.v @@ -696,7 +696,7 @@ Definition exec_instr (f: function) (i: instruction) (rs: regset) (m: mem) : out | Pfsubd r1 r2 r3 => Next (nextinstr (rs#r1 <- (Val.subf rs#r2 rs#r3))) m | Pflid r1 f => - Next (nextinstr (rs#r1 <- (Vfloat f))) m + Next (nextinstr (rs#IR14 <- Vundef #r1 <- (Vfloat f))) m | Pfcmpd r1 r2 => Next (nextinstr (compare_float rs rs#r1 rs#r2)) m | Pfcmpzd r1 => @@ -923,7 +923,7 @@ Inductive step: state -> trace -> state -> Prop := external_call ef ge vargs m t vres m' -> rs' = nextinstr (set_res res vres - (undef_regs (map preg_of (destroyed_by_builtin ef)) rs)) -> + (undef_regs (IR IR14 :: map preg_of (destroyed_by_builtin ef)) rs)) -> step (State rs m) t (State rs' m') | exec_step_external: forall b ef args res rs m t rs' m', diff --git a/arm/Asmgenproof.v b/arm/Asmgenproof.v index a592e12a..f60f4b48 100644 --- a/arm/Asmgenproof.v +++ b/arm/Asmgenproof.v @@ -754,13 +754,15 @@ Opaque loadind. econstructor; eauto. instantiate (2 := tf); instantiate (1 := x). unfold nextinstr. rewrite Pregmap.gss. - rewrite set_res_other. rewrite undef_regs_other_2. + rewrite set_res_other. simpl. rewrite undef_regs_other_2. + rewrite Pregmap.gso by auto with asmgen. rewrite <- H1. simpl. econstructor; eauto. eapply code_tail_next_int; eauto. rewrite preg_notin_charact. intros. auto with asmgen. auto with asmgen. apply agree_nextinstr. eapply agree_set_res; auto. - eapply agree_undef_regs; eauto. intros; apply undef_regs_other_2; auto. + eapply agree_undef_regs; eauto. + intros. simpl. rewrite undef_regs_other_2; auto. apply Pregmap.gso. auto with asmgen. congruence. - (* Mgoto *) -- cgit