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

stassats via Sbcl-commits <[email protected]> Mon, 29 Jun 2026 02:36:25 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  b6b1188ebfafdaaef369c881433a88890389f12b (commit)
      from  d8a8a93405f245d34a7d3dead3294a2c9e433e0d (commit)

- Log -----------------------------------------------------------------
commit b6b1188ebfafdaaef369c881433a88890389f12b
Author: Stas Boukarev <[email protected]>
Date:   Mon Jun 29 05:35:13 2026 +0300

    x86-64, load-fp-immediate: dispatch on the value, not destination
    
    Fixes lp#2158587
---
 src/compiler/x86-64/float.lisp | 19 ++++++++++---------
 tests/float-2.pure.lisp        |  7 ++++++-
 2 files changed, 16 insertions(+), 10 deletions(-)

diff --git a/src/compiler/x86-64/float.lisp b/src/compiler/x86-64/float.lisp
index f6846f3e7..de9fcdbe8 100644
--- a/src/compiler/x86-64/float.lisp
+++ b/src/compiler/x86-64/float.lisp
@@ -78,16 +78,17 @@
    (fp-immediate) (double-reg)
    (fp-immediate) (complex-single-reg)
    (fp-immediate) (complex-double-reg))
-  (if (member (tn-value x) '(0f0 0d0 #c(0d0 0d0) #c(0f0 0f0)))
-      (sc-case y
-        ((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))))
+  (let ((x (tn-value x)))
+    (if (member x '(0f0 0d0 #c(0d0 0d0) #c(0f0 0f0)))
         (sc-case y
-          (single-reg (inst movss y x))
-          (double-reg (inst movsd y x))
-          (complex-single-reg (inst movq y x))
-          (complex-double-reg (inst movapd y x))))))
+          ((single-reg complex-single-reg) (inst xorps y y))
+          ((double-reg complex-double-reg) (inst xorpd y y)))
+        (let ((c (register-inline-constant 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)
   ((single-stack) (single-reg))
diff --git a/tests/float-2.pure.lisp b/tests/float-2.pure.lisp
index 939204411..a8930b93b 100644
--- a/tests/float-2.pure.lisp
+++ b/tests/float-2.pure.lisp
@@ -925,4 +925,9 @@ fractional bits."
    ()
    `(lambda (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))))

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


hooks/post-receive
-- 
SBCL