master: arm64: better complex-float-=
stassats via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via c33aaa910bbff76a97f6347dc2df1b7cd99ac976 (commit)
from 5b897710fc37863c45b268d33f59ce437492c7df (commit)
- Log -----------------------------------------------------------------
commit c33aaa910bbff76a97f6347dc2df1b7cd99ac976
Author: Stas Boukarev <[email protected]>
Date: Sun Aug 30 07:32:46 2026 +0300
arm64: better complex-float-=
---
src/compiler/arm64/float.lisp | 74 ++++++++++++++++++++++++++++++-------------
src/compiler/arm64/insts.lisp | 55 +++++++++++++++++++++-----------
2 files changed, 88 insertions(+), 41 deletions(-)
diff --git a/src/compiler/arm64/float.lisp b/src/compiler/arm64/float.lisp
index 46d0f96a0..94bb55166 100644
--- a/src/compiler/arm64/float.lisp
+++ b/src/compiler/arm64/float.lisp
@@ -606,35 +606,63 @@
`(progn
(define-vop (,complex-complex-name)
(:translate =)
- (:args (x :scs (,complex-sc)) (y :scs (,complex-sc)))
+ (:args (x :scs (,complex-sc))
+ (y :scs (,complex-sc (fp-immediate
+ (zerop (tn-value tn))))))
(:arg-types ,complex-type ,complex-type)
(:temporary (:sc ,complex-sc) mask)
- (:temporary (:sc unsigned-reg) min)
(:conditional :ne)
+ (:vop-var vop)
(:policy :fast-safe)
(:generator 3
- (inst fcmeq mask x y ,float-size)
- (inst uminv mask mask ,byte-size)
- (inst umov min mask 0 :b)
- (inst cmp min 0)))
+ (when (sc-is y fp-immediate)
+ (setf y (tn-value y)))
+ (inst fcmeq mask x y ,float-size)
+ ,@(if (eq real-type 'double-float)
+ `((inst uminv mask mask ,byte-size)
+ (inst umov tmp-tn mask 0 :b)
+ (inst cmp tmp-tn 0))
+ `((inst umov tmp-tn mask 0 :d)
+ (inst cmn tmp-tn 1)
+ (change-vop-flags vop '(:eq))))))
(define-vop (,eql-complex-complex-name)
(:translate eql)
- (:args (x :scs (,complex-sc)) (y :scs (,complex-sc)))
+ (:args (x :scs (,complex-sc))
+ (y :scs (,complex-sc (fp-immediate
+ (member (tn-value tn) '(#c(0d0 0d0) #c(0f0 0f0)))))))
(:arg-types ,complex-type ,complex-type)
- (:temporary (:sc ,complex-sc) mask)
- (:temporary (:sc unsigned-reg) min)
+ (:temporary (:sc ,complex-sc
+ ,@(when (eq real-type 'single-float)
+ `(:unused-if (and (sc-is y fp-immediate)
+ (eql (tn-value y) #c(0f0 0f0))))))
+ mask)
(:conditional :ne)
+ (:vop-var vop)
(:policy :fast-safe)
(:generator 3
- (inst cmeq mask x y ,byte-size)
- (inst uminv mask mask ,byte-size)
- (inst umov min mask 0 :b)
- (inst cmp min 0)))
+ (when (sc-is y fp-immediate)
+ (setf y 0))
+
+ ,@(if (eq real-type 'double-float)
+ `((inst cmeq mask x y ,byte-size)
+ (inst uminv mask mask ,byte-size)
+ (inst umov tmp-tn mask 0 :b)
+ (inst cmp tmp-tn 0))
+ `((cond ((eq y 0)
+ (inst umov tmp-tn x 0 :d)
+ (inst cmn tmp-tn 0)
+ (change-vop-flags vop '(:eq)))
+ (t
+ (inst cmeq mask x y ,byte-size)
+ (inst umov tmp-tn mask 0 :d)
+ (inst cmn tmp-tn 1)
+ (change-vop-flags vop '(:eq))))))))
(define-vop (,real-complex-name ,complex-complex-name)
(:args (x :scs (,real-sc)) (y :scs (,complex-sc)))
(:arg-types ,real-type ,complex-type))
(define-vop (,complex-real-name ,complex-complex-name)
- (:args (x :scs (,complex-sc)) (y :scs (,real-sc)))
+ (:args (x :scs (,complex-sc)) (y :scs (,real-sc (fp-immediate
+ (zerop (tn-value tn))))))
(:arg-types ,complex-type ,real-type)))))
(define-complex-float-=
=/complex-single-float =/complex-real-single-float
@@ -1005,10 +1033,11 @@
(:generator 3
(sc-case x
(complex-single-reg
- (inst ins r 0 x (ecase slot
- (:real 0)
- (:imag 1))
- :s))
+ (ecase slot
+ (:real
+ (move-float r x))
+ (:imag
+ (inst ins r 0 x 1 :s))))
(complex-single-stack
(inst ldr r
(@ (current-nfp-tn vop)
@@ -1040,10 +1069,11 @@
(:generator 3
(sc-case x
(complex-double-reg
- (inst ins r 0 x (ecase slot
- (:real 0)
- (:imag 1))
- :d))
+ (ecase slot
+ (:real
+ (move-float r x))
+ (:imag
+ (inst ins r 0 x 1 :d))))
(complex-double-stack
(loadw r (current-nfp-tn vop) (+ (ecase slot (:real 0) (:imag 1))
(tn-offset x)))))))
diff --git a/src/compiler/arm64/insts.lisp b/src/compiler/arm64/insts.lisp
index 70023117c..2444fa856 100644
--- a/src/compiler/arm64/insts.lisp
+++ b/src/compiler/arm64/insts.lisp
@@ -3170,10 +3170,7 @@
(fpr-offset rd)))))
((and (fp-register-p rd)
(fp-register-p rn))
- (assert (and (eq (tn-sc rd) (tn-sc rn))) (rd rn)
- "Arguments should have the same fp storage class: ~s ~s."
- rd rn)
- (emit-fp-data-processing-1 segment (fp-reg-type rn) 0
+ (emit-fp-data-processing-1 segment (fp-reg-type rd) 0
(fpr-offset rn) (fpr-offset rd)))
((and (register-p rd)
(fp-register-p rn))
@@ -3684,25 +3681,45 @@
(def sshl #b0 #b01001)
(def ushl #b1 #b01001))
-(macrolet ((def (name u neg op)
+(macrolet ((def (name u neg op &optional zero-u zero)
`(define-instruction ,name (segment rd rn rm size)
- (:printer simd-three-same-float ((u ,u) (neg ,neg) (op ,op)))
+ ,@(when op
+ `((:printer simd-three-same-float ((u ,u) (neg ,neg) (op ,op)))))
+ ,@(when zero
+ `((:printer simd-two-misc ((u ,zero-u) (op ,zero))
+ '(:name :tab rd ", " rn ", " "#0.0"))))
(:emitter
(aver (member size '(:2s :4s :2d)))
(multiple-value-bind (q size) (encode-vector-size size)
- (emit-simd-three-same-float
- segment
- q
- ,u
- ,neg
- (logand 1 size)
- (fpr-offset rm)
- ,op
- (fpr-offset rn)
- (fpr-offset rd)))))))
- (def fcmeq #b0 #b0 #b11100)
- (def fcmge #b1 #b0 #b11100)
- (def fcmgt #b1 #b1 #b11100))
+ (cond ,@(when zero
+ `(((and (numberp rm) (zerop rm))
+ (emit-simd-two-misc segment
+ q
+ ,zero-u
+ 0
+ size
+ ,zero
+ (fpr-offset rn)
+ (fpr-offset rd)))))
+ (t
+ ,(if op
+ `(emit-simd-three-same-float segment
+ q
+ ,u
+ ,neg
+ (logand 1 size)
+ (fpr-offset rm)
+ ,op
+ (fpr-offset rn)
+ (fpr-offset rd))
+ `(error "Can be compared only with 0.0")))))))))
+ (def fcmeq #b0 #b0 #b11100 0 #b01101)
+ (def fcmge #b1 #b0 #b11100 1 #b01100)
+ (def fcmgt #b1 #b1 #b11100 0 #b01100)
+ (def fcmle nil nil nil 1 #b01101)
+ (def fcmlt nil nil nil 0 #b01110)
+ (def facge #b1 #b0 #b11101)
+ (def facgt #b1 #b1 #b11101))
(def-emitter simd-scalar-three-same
(#b01 2 30)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL