diff options
author | David Monniaux <david.monniaux@univ-grenoble-alpes.fr> | 2020-11-18 21:07:29 +0100 |
---|---|---|
committer | David Monniaux <david.monniaux@univ-grenoble-alpes.fr> | 2020-11-18 21:07:29 +0100 |
commit | 8384d27c122ec4ca4b7ad0f524df52b61a49c66a (patch) | |
tree | d86ff8780c4435d3b4fe92b5251e0f9b447b86c7 /riscV | |
parent | 362bdda28ca3c4dcc992575cbbe9400b64425990 (diff) | |
parent | e6e036b3f285d2f3ba2a5036a413eb9c7d7534cd (diff) | |
download | compcert-kvx-8384d27c122ec4ca4b7ad0f524df52b61a49c66a.tar.gz compcert-kvx-8384d27c122ec4ca4b7ad0f524df52b61a49c66a.zip |
Merge branch 'master' (Absint 3.8) into kvx-work-merge3.8
Diffstat (limited to 'riscV')
-rw-r--r-- | riscV/Archi.v | 3 | ||||
-rw-r--r-- | riscV/Asmexpand.ml | 113 | ||||
-rw-r--r-- | riscV/Machregs.v | 25 | ||||
-rw-r--r-- | riscV/Machregsaux.ml | 18 | ||||
-rw-r--r-- | riscV/Machregsaux.mli | 3 |
5 files changed, 136 insertions, 26 deletions
diff --git a/riscV/Archi.v b/riscV/Archi.v index 9bdaad99..1bb80e89 100644 --- a/riscV/Archi.v +++ b/riscV/Archi.v @@ -16,9 +16,8 @@ (** Architecture-dependent parameters for RISC-V *) +From Flocq Require Import Binary Bits. Require Import ZArith List. -(*From Flocq*) -Require Import Binary Bits. Parameter ptr64 : bool. diff --git a/riscV/Asmexpand.ml b/riscV/Asmexpand.ml index 7e36abf8..810514a3 100644 --- a/riscV/Asmexpand.ml +++ b/riscV/Asmexpand.ml @@ -394,6 +394,90 @@ let expand_bswap64 d s = emit (Psrlil(X31, X s, coqint_of_camlint 56l)); emit (Porl(d, X X1, X X31)) +(* Count leading zeros. Algorithm 5-7 from Hacker's Delight, + re-rolled as a loop to produce more compact code. *) + +let expand_clz ~sixtyfour ~splitlong = + (* Input: X in X5 or (X5, X6) if splitlong + Result: N in X7 + Temporaries: S in X8, Y in X9 *) + let lbl1 = new_label() in + let lbl2 = new_label() in + (* N := bitsize of X's type (32 or 64) *) + expand_loadimm32 X7 (coqint_of_camlint + (if sixtyfour || splitlong then 64l else 32l)); + (* S := initial shift amount (16 or 32) *) + expand_loadimm32 X8 (coqint_of_camlint (if sixtyfour then 32l else 16l)); + if splitlong then begin + (* if (Xhigh == 0) goto lbl1 *) + emit (Pbeqw(X X6, X0, lbl1)); + (* N := 32 *) + expand_loadimm32 X7 (coqint_of_camlint 32l); + (* X := Xhigh *) + emit (Pmv(X5, X6)) + end; + (* lbl1: *) + emit (Plabel lbl1); + (* Y := X >> S *) + emit (if sixtyfour then Psrll(X9, X X5, X X8) else Psrlw(X9, X X5, X X8)); + (* if (Y == 0) goto lbl2 *) + emit (if sixtyfour then Pbeql(X X9, X0, lbl2) else Pbeqw(X X9, X0, lbl2)); + (* N := N - S *) + emit (Psubw(X7, X X7, X X8)); + (* X := Y *) + emit (Pmv(X5, X9)); + (* lbl2: *) + emit (Plabel lbl2); + (* S := S / 2 *) + emit (Psrliw(X8, X X8, _1)); + (* if (S != 0) goto lbl1; *) + emit (Pbnew(X X8, X0, lbl1)); + (* N := N - X *) + emit (Psubw(X7, X X7, X X5)) + +(* Count trailing zeros. Algorithm 5-14 from Hacker's Delight, + re-rolled as a loop to produce more compact code. *) + +let expand_ctz ~sixtyfour ~splitlong = + (* Input: X in X6 or (X5, X6) if splitlong + Result: N in X7 + Temporaries: S in X8, Y in X9 *) + let lbl1 = new_label() in + let lbl2 = new_label() in + (* N := bitsize of X's type (32 or 64) *) + expand_loadimm32 X7 (coqint_of_camlint + (if sixtyfour || splitlong then 64l else 32l)); + (* S := initial shift amount (16 or 32) *) + expand_loadimm32 X8 (coqint_of_camlint (if sixtyfour then 32l else 16l)); + if splitlong then begin + (* if (Xlow == 0) goto lbl1 *) + emit (Pbeqw(X X5, X0, lbl1)); + (* N := 32 *) + expand_loadimm32 X7 (coqint_of_camlint 32l); + (* X := Xlow *) + emit (Pmv(X6, X5)) + end; + (* lbl1: *) + emit (Plabel lbl1); + (* Y := X >> S *) + emit (if sixtyfour then Pslll(X9, X X6, X X8) else Psllw(X9, X X6, X X8)); + (* if (Y == 0) goto lbl2 *) + emit (if sixtyfour then Pbeql(X X9, X0, lbl2) else Pbeqw(X X9, X0, lbl2)); + (* N := N - S *) + emit (Psubw(X7, X X7, X X8)); + (* X := Y *) + emit (Pmv(X6, X9)); + (* lbl2: *) + emit (Plabel lbl2); + (* S := S / 2 *) + emit (Psrliw(X8, X X8, _1)); + (* if (S != 0) goto lbl1; *) + emit (Pbnew(X X8, X0, lbl1)); + (* N := N - most significant bit of X *) + emit (if sixtyfour then Psrlil(X6, X X6, coqint_of_camlint 63l) + else Psrliw(X6, X X6, coqint_of_camlint 31l)); + emit (Psubw(X7, X X7, X X6)) + (* Handling of compiler-inlined builtins *) let expand_builtin_inline name args res = @@ -418,10 +502,33 @@ let expand_builtin_inline name args res = assert (ah = X6 && al = X5 && rh = X5 && rl = X6); expand_bswap32 X5 X5; expand_bswap32 X6 X6 + (* Count zeros *) + | "__builtin_clz", [BA(IR a)], BR(IR res) -> + assert (a = X5 && res = X7); + expand_clz ~sixtyfour:false ~splitlong:false + | "__builtin_clzl", [BA(IR a)], BR(IR res) -> + assert (a = X5 && res = X7); + expand_clz ~sixtyfour:Archi.ptr64 ~splitlong:false + | "__builtin_clzll", [BA(IR a)], BR(IR res) -> + assert (a = X5 && res = X7); + expand_clz ~sixtyfour:true ~splitlong:false + | "__builtin_clzll", [BA_splitlong(BA(IR ah), BA(IR al))], BR(IR res) -> + assert (al = X5 && ah = X6 && res = X7); + expand_clz ~sixtyfour:false ~splitlong:true + | "__builtin_ctz", [BA(IR a)], BR(IR res) -> + assert (a = X6 && res = X7); + expand_ctz ~sixtyfour:false ~splitlong:false + | "__builtin_ctzl", [BA(IR a)], BR(IR res) -> + assert (a = X6 && res = X7); + expand_ctz ~sixtyfour:Archi.ptr64 ~splitlong:false + | "__builtin_ctzll", [BA(IR a)], BR(IR res) -> + assert (a = X6 && res = X7); + expand_ctz ~sixtyfour:true ~splitlong:false + | "__builtin_ctzll", [BA_splitlong(BA(IR ah), BA(IR al))], BR(IR res) -> + assert (al = X5 && ah = X6 && res = X7); + expand_ctz ~sixtyfour:false ~splitlong:true (* Float arithmetic *) - | "__builtin_fabs", [BA(FR a1)], BR(FR res) -> - emit (Pfabsd(res, a1)) - | "__builtin_fsqrt", [BA(FR a1)], BR(FR res) -> + | ("__builtin_fsqrt" | "__builtin_sqrt"), [BA(FR a1)], BR(FR res) -> emit (Pfsqrtd(res, a1)) | "__builtin_fmadd", [BA(FR a1); BA(FR a2); BA(FR a3)], BR(FR res) -> emit (Pfmaddd(res, a1, a2, a3)) diff --git a/riscV/Machregs.v b/riscV/Machregs.v index d8bb4a4b..d469e594 100644 --- a/riscV/Machregs.v +++ b/riscV/Machregs.v @@ -194,6 +194,17 @@ Definition destroyed_by_builtin (ef: external_function): list mreg := match ef with | EF_inline_asm txt sg clob => destroyed_by_clobber clob | EF_memcpy sz al => R5 :: R6 :: R7 :: F0 :: nil + | EF_builtin name sg => + if string_dec name "__builtin_clz" + || string_dec name "__builtin_clzl" + || string_dec name "__builtin_clzll" then + R5 :: R8 :: R9 :: nil + else if string_dec name "__builtin_ctz" + || string_dec name "__builtin_ctzl" + || string_dec name "__builtin_ctzll" then + R6 :: R8 :: R9 :: nil + else + nil | _ => nil end. @@ -213,6 +224,20 @@ Definition mregs_for_builtin (ef: external_function): list (option mreg) * list( | EF_builtin name sg => if (negb Archi.ptr64) && string_dec name "__builtin_bswap64" then (Some R6 :: Some R5 :: nil, Some R5 :: Some R6 :: nil) + else if string_dec name "__builtin_clz" + || string_dec name "__builtin_clzl" then + (Some R5 :: nil, Some R7 :: nil) + else if string_dec name "__builtin_clzll" then + if Archi.ptr64 + then (Some R5 :: nil, Some R7 :: nil) + else (Some R6 :: Some R5 :: nil, Some R7 :: nil) + else if string_dec name "__builtin_ctz" + || string_dec name "__builtin_ctzl" then + (Some R6 :: nil, Some R7 :: nil) + else if string_dec name "__builtin_ctzll" then + if Archi.ptr64 + then (Some R6 :: nil, Some R7 :: nil) + else (Some R6 :: Some R5 :: nil, Some R7 :: nil) else (nil, nil) | _ => diff --git a/riscV/Machregsaux.ml b/riscV/Machregsaux.ml index 07097eaf..840943e7 100644 --- a/riscV/Machregsaux.ml +++ b/riscV/Machregsaux.ml @@ -12,25 +12,7 @@ (** 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 r = false - -let name_of_register r = - try Some (Hashtbl.find register_names r) with Not_found -> None - -let register_by_name s = - Machregs.register_by_name (coqstring_uppercase_ascii_of_camlstring s) - -let can_reserve_register r = Conventions1.is_callee_save r let class_of_type = function | AST.Tint | AST.Tlong -> 0 diff --git a/riscV/Machregsaux.mli b/riscV/Machregsaux.mli index d7117c21..01b0f9fd 100644 --- a/riscV/Machregsaux.mli +++ b/riscV/Machregsaux.mli @@ -12,9 +12,6 @@ (** 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 -val can_reserve_register: Machregs.mreg -> bool val class_of_type: AST.typ -> int |