master: Don't cons constant complexes for local calls

stassats via Sbcl-commits <[email protected]> Sun, 28 Jun 2026 13:03:20 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  225e9c1f80f29930e1227cc66c832c3b9ae31474 (commit)
      from  b81fef15a67dd19e7fe9f1d1822330c86a3a5671 (commit)

- Log -----------------------------------------------------------------
commit 225e9c1f80f29930e1227cc66c832c3b9ae31474
Author: Stas Boukarev <[email protected]>
Date:   Sat Jun 27 18:27:09 2026 +0300

    Don't cons constant complexes for local calls
    
    If they end up in descriptor registers.
---
 src/compiler/represent.lisp | 10 ++++++----
 tests/compiler-ir.pure.lisp | 10 ++++++++++
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/src/compiler/represent.lisp b/src/compiler/represent.lisp
index dc51eecda..e19f71bd8 100644
--- a/src/compiler/represent.lisp
+++ b/src/compiler/represent.lisp
@@ -477,7 +477,7 @@
                        (cond
                          ((not write-p)
                           (or
-                           (coerce-from-constant op temp load-scs)
+                           (coerce-from-constant op-tn op temp load-scs)
                            (emit-move (or (maybe-move-from-fixnum+-1 op-tn temp
                                                                      op)
                                           res)
@@ -628,10 +628,12 @@
                                                   ,most-positive-fixnum)))
              (template-or-lose 'sb-vm::move-from-fixnum-1))))))
 
-(defun coerce-from-constant (x-tn-ref y &optional load-scs)
+(defun coerce-from-constant (x x-tn-ref y &optional load-scs)
   (when (and (sc-is y sb-vm::descriptor-reg sb-vm::control-stack)
              (tn-ref-type x-tn-ref))
-    (multiple-value-bind (constantp value) (type-singleton-p (tn-ref-type x-tn-ref))
+    (multiple-value-bind (constantp value) (if (constant-tn-p x)
+                                               (values t (tn-value x))
+                                               (type-singleton-p (tn-ref-type x-tn-ref)))
       (when constantp
         (let ((constant (find-constant value)))
           (cond #+(or arm64 x86-64)
@@ -852,7 +854,7 @@
                        (eq (tn-kind y) :normal))
                   (delete-vop vop))
                  ((eq res info))
-                 ((coerce-from-constant args y))
+                 ((coerce-from-constant x args y))
                  (res
                   (or
                    (jump-over-move-coercion vop x y block)
diff --git a/tests/compiler-ir.pure.lisp b/tests/compiler-ir.pure.lisp
index 20f481d22..a0e4bd442 100644
--- a/tests/compiler-ir.pure.lisp
+++ b/tests/compiler-ir.pure.lisp
@@ -670,3 +670,13 @@
                                              (lambda (b) (+ b 1)))
                                  1))))
              1)))
+
+(with-test (:name :complex-constants-to-locals)
+  (assert (= (count 'sb-vm::move-from-complex-double
+                    (ir2-vops '(lambda ()
+                                (flet ((f (p)
+                                         p))
+                                  (let ((p #c(1d0 2d0)))
+                                    (f p)
+                                    (f p))))))
+             0)))

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


hooks/post-receive
-- 
SBCL