common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

x86-64, load-fp-immediate: dispatch on the value, not destination

Browse source 
Fixes lp#2158587
This commit is contained in:
Stas Boukarev 2026-06-29 05:35:13 +03:00
parent d8a8a93405
commit b6b1188ebf
2 changed files with 16 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
src/compiler/x86-64/float.lisp
View file

@ -78,16 +78,17 @@
(fp-immediate) (double-reg) (fp-immediate) (double-reg)
(fp-immediate) (complex-single-reg) (fp-immediate) (complex-single-reg)
(fp-immediate) (complex-double-reg)) (fp-immediate) (complex-double-reg))
(if (member (tn-value x) '(0f0 0d0 #c(0d0 0d0) #c(0f0 0f0))) (let ((x (tn-value x)))
(sc-case y (if (member x '(0f0 0d0 #c(0d0 0d0) #c(0f0 0f0)))
((single-reg complex-single-reg) (inst xorps y y))
((double-reg complex-double-reg) (inst xorpd y y)))
(let ((x (register-inline-constant (tn-value x))))
(sc-case y (sc-case y
(single-reg (inst movss y x)) ((single-reg complex-single-reg) (inst xorps y y))
(double-reg (inst movsd y x)) ((double-reg complex-double-reg) (inst xorpd y y)))
(complex-single-reg (inst movq y x)) (let ((c (register-inline-constant x)))
(complex-double-reg (inst movapd y x)))))) (etypecase x
(single-float (inst movss y c))
(double-float (inst movsd y c))
(complex-single-float (inst movq y c))
(complex-double-float (inst movupd y c)))))))
(define-move-fun (load-single 2) (vop x y) (define-move-fun (load-single 2) (vop x y)
((single-stack) (single-reg)) ((single-stack) (single-reg))

7
tests/float-2.pure.lisp
View file

@ -925,4 +925,9 @@ fractional bits."
() ()
`(lambda (d) `(lambda (d)
(- #c(1d0 3d0) (the double-float d))) (- #c(1d0 3d0) (the double-float d)))
((4d0) #C(-3d0 3d0)))) ((4d0) #C(-3d0 3d0)))
(checked-compile-and-assert
()
`(lambda (c)
(- 5 (the (complex double-float) c)))
((#c(1d0 3)) #C(4d0 -3))))