[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: arm64: remove %ash/right VOPs.
From:       stassats via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date:       2023-04-30 16:47:44
Message-ID: 1682873264.307519.13338 () sfp-scm-5 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  e81be73ce9e7669ff4b233ca8e62c05805ae07d2 (commit)
      from  511519c5baf9b7b0525d3d755b51bff602426d91 (commit)

- Log -----------------------------------------------------------------
commit e81be73ce9e7669ff4b233ca8e62c05805ae07d2
Author: Stas Boukarev <stassats@gmail.com>
Date:   Fri Apr 28 22:53:49 2023 +0300

    arm64: remove %ash/right VOPs.
    
    The generic ASH VOP does a better job cutting the shift amount to 64.
---
 src/compiler/arm64/arith.lisp | 92 ++++++++++++++++---------------------------
 1 file changed, 35 insertions(+), 57 deletions(-)

diff --git a/src/compiler/arm64/arith.lisp b/src/compiler/arm64/arith.lisp
index d5cf8c7ea..df6133c69 100644
--- a/src/compiler/arm64/arith.lisp
+++ b/src/compiler/arm64/arith.lisp
@@ -484,32 +484,45 @@
   (:arg-refs nil amount-ref)
   (:variant-vars variant)
   (:generator 5
-    (cond
-      ((csubtypep (tn-ref-type amount-ref)
-                  (specifier-type `(integer -63 63)))
-       (inst neg temp amount)
-       (inst lsl result number amount)
-       (inst tbz amount 63 done)
-       (ecase variant
-         (:signed (inst asr result number temp))
-         (:unsigned (inst lsr result number temp))))
-      (t
-       (inst cmp amount 0)
-       (inst csneg temp amount amount :ge)
-       (unless (csubtypep (tn-ref-type amount-ref)
-                          (specifier-type `(integer -63 63)))
+    (let ((negative (csubtypep (tn-ref-type amount-ref)
+                               (specifier-type `(integer * 0)))))
+      (cond
+        ((csubtypep (tn-ref-type amount-ref)
+                    (specifier-type `(integer -63 63)))
+         (inst neg temp amount)
+         (unless negative
+           (inst lsl result number amount)
+           (inst tbz amount 63 done))
+         (ecase variant
+           (:signed (inst asr result number temp))
+           (:unsigned (inst lsr result number temp))))
+        ((not negative)
+         (inst cmp amount 0)
+         (inst csneg temp amount amount :ge)
          (inst cmp temp n-word-bits)
          ;; Only the first 6 bits count for shifts.
          ;; This sets all bits to 1 if AMOUNT is larger than 63,
          ;; cutting the amount to 63.
-         (inst csinv temp temp zr-tn :lo))
-       (inst lsl result number temp)
-       (inst tbz amount 63 done)
-       (ecase variant
-         (:signed (inst asr result number temp))
-         (:unsigned
-          (inst csel result number zr-tn :lo)
-          (inst lsr result result temp)))))
+         (inst csinv temp temp zr-tn :lo)
+         (inst lsl result number temp)
+         (inst tbz amount 63 done)
+         (ecase variant
+           (:signed (inst asr result number temp))
+           (:unsigned
+            (unless (csubtypep (tn-ref-type amount-ref)
+                               (specifier-type `(integer -63 *)))
+              (inst csel result number zr-tn :lo))
+            (inst lsr result result temp))))
+        (t
+         (inst neg temp amount)
+         (inst cmp temp n-word-bits)
+         (ecase variant
+           (:signed
+            (inst csinv temp temp zr-tn :lo)
+            (inst asr result number temp))
+           (:unsigned
+            (inst csel result number zr-tn :lo)
+            (inst lsr result result temp))))))
     done))
 
 (define-vop (fast-ash-modfx/signed/unsigned=>fixnum)
@@ -621,41 +634,6 @@
   (def fast-ash-left/signed=>signed fast-ash-left-c/signed=>signed signed-reg \
signed-num signed-reg 3)  (def fast-ash-left/unsigned=>unsigned \
fast-ash-left-c/unsigned=>unsigned unsigned-reg unsigned-num unsigned-reg 3))  
-(define-vop (fast-%ash/right/unsigned)
-  (:translate %ash/right)
-  (:policy :fast-safe)
-  (:args (number :scs (unsigned-reg))
-         (amount :scs (unsigned-reg)))
-  (:arg-types unsigned-num unsigned-num)
-  (:results (result :scs (unsigned-reg) :from (:argument 0)))
-  (:result-types unsigned-num)
-  (:generator 4
-     (inst lsr result number amount)))
-
-(define-vop (fast-%ash/right/signed)
-  (:translate %ash/right)
-  (:policy :fast-safe)
-  (:args (number :scs (signed-reg))
-         (amount :scs (unsigned-reg)))
-  (:arg-types signed-num unsigned-num)
-  (:results (result :scs (signed-reg) :from (:argument 0)))
-  (:result-types signed-num)
-  (:generator 4
-    (inst asr result number amount)))
-
-(define-vop (fast-%ash/right/fixnum)
-  (:translate %ash/right)
-  (:policy :fast-safe)
-  (:args (number :scs (any-reg))
-         (amount :scs (unsigned-reg) :target temp))
-  (:arg-types tagged-num unsigned-num)
-  (:results (result :scs (any-reg) :from (:argument 0)))
-  (:result-types tagged-num)
-  (:temporary (:sc unsigned-reg :target result) temp)
-  (:generator 3
-    (inst asr temp number amount)
-    (inst and result temp (bic-mask fixnum-tag-mask))))
-
 (define-vop (fast-ash-left-modfx/fixnum=>fixnum
              fast-ash-left/fixnum=>fixnum)
   (:variant t)

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL


_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits


[prev in list] [next in list] [prev in thread] [next in thread]