master: Fix avx-512 register allocation

The branch "master" has been updated in SBCL:
       via  188ae65ab579a79792da9941fab2de7978b3eeaa (commit)
      from  19040616e7e04ff181eefbfc126134b98d7aa571 (commit)

- Log -----------------------------------------------------------------
commit 188ae65ab579a79792da9941fab2de7978b3eeaa
Author: Stas Boukarev <[email protected]>
Date:   Wed Aug 26 01:55:19 2026 +0300

    Fix avx-512 register allocation
    
    Don't assign zmm0-15 first and run out of registers for xmm/ymm.
    Assign zmm31-0 instead.
---
 src/compiler/pack.lisp                 | 48 +++++++++++++++++++++++++++++-----
 src/compiler/x86-64/simd-pack-512.lisp | 30 ++++++++++-----------
 2 files changed, 56 insertions(+), 22 deletions(-)

diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp
index 89f09fde8..906f78460 100644
--- a/src/compiler/pack.lisp
+++ b/src/compiler/pack.lisp
@@ -402,6 +402,25 @@
                   (incf ,bias 8))
          ,result))))
 
+
+(defmacro do-sc-locations-back ((location locations &optional result)
+                                &body body)
+  (let ((bitmap '#:bits)
+        (bias '#:bias))
+    `(let ((,bitmap ,locations)
+           (,bias (- sb-vm:finite-sc-offset-limit 8)))
+       (declare (type sb-vm:finite-sc-offset-map ,bitmap))
+       (declare (type (integer -8 ,sb-vm:finite-sc-offset-limit) ,bias))
+       (block nil
+         (loop named #:outer repeat (/ sb-vm:finite-sc-offset-limit 8)
+               do (when (ldb-test (byte 8 ,bias) ,bitmap)
+                    ;; scan 8 bits starting at BIAS from highest to lowest
+                    (loop named #:inner
+                          for ,location downfrom (+ ,bias 7) to ,bias
+                          when (logbitp ,location ,bitmap) do (progn ,@body)))
+                  (decf ,bias 8))
+         ,result))))
+
 ;;; If load TN packing fails, try to give a helpful error message. We
 ;;; find a TN in each location that conflicts, and print it.
 (defun failed-to-pack-load-tn-error (scs op)
@@ -1486,6 +1505,10 @@
                      (return-from select-location start-offset))))
              (try (locations)
                (do-sc-locations (location locations nil element-size)
+                 (attempt-location location)))
+             (try-backward (locations)
+               (do-sc-locations-back (location locations)
+                 (print location)
                  (attempt-location location))))
       (if (eq (sb-kind sb) :unbounded)
           (let ((size (finite-sb-current-size sb)))
@@ -1495,13 +1518,24 @@
           (let* ((locations (sc-locations sc))
                  (reserved (sc-reserve-locations sc))
                  (wired (logandc2 (finite-sb-wired-map sb) reserved)))
-            ;; Try non wired locatiions first
-            (try (logandc2 locations wired))
-            ;; Then the wired locations that are present in this SC.
-            (try (logand locations wired))
-            ;; And only then when requested try the reserved locations.
-            (when use-reserved-locs
-              (try reserved)))))))
+            (cond #+sb-simd-pack-512
+                  ((sc-is tn sb-vm::int-avx512-reg sb-vm::double-avx512-reg sb-vm::single-avx512-reg)
+                   ;; ZMM registers are registers from 0 to 31,
+                   ;; XMM/YMM are from 0 to 15, if ZMMs are packed
+                   ;; first into 0-15, then XMM/YMM won't have
+                   ;; anywhere to go, pack ZMMs from 31 and down.
+                   (try-backward (logandc2 locations wired))
+                   (try-backward (logand locations wired))
+                   (when use-reserved-locs
+                     (try-backward reserved)))
+                  (t
+                   ;; Try non wired locatiions first
+                   (try (logandc2 locations wired))
+                   ;; Then the wired locations that are present in this SC.
+                     (try (logand locations wired))
+                     ;; And only then when requested try the reserved locations.
+                     (when use-reserved-locs
+                       (try reserved)))))))))
 
 ;;; If a save TN, return the saved TN, otherwise return TN. This is
 ;;; useful for getting the conflicts of a TN that might be a save TN.
diff --git a/src/compiler/x86-64/simd-pack-512.lisp b/src/compiler/x86-64/simd-pack-512.lisp
index 4c2f7111f..6a00eeb28 100644
--- a/src/compiler/x86-64/simd-pack-512.lisp
+++ b/src/compiler/x86-64/simd-pack-512.lisp
@@ -636,24 +636,24 @@
   (:result-types simd-pack-512-single)
   (:temporary (:sc single-avx512-reg) t0 t1 t2 t3)
   (:generator 5
-     (inst vunpcklps t0 p0 p1)
-     (inst vunpcklps t1 p2 p3)
-     (inst vshufps dst t0 t1 #x44)
+    (inst vunpcklps t0 p0 p1)
+    (inst vunpcklps t1 p2 p3)
+    (inst vshufps dst t0 t1 #x44)
 
-     (inst vunpcklps t2 p4 p5)
-     (inst vunpcklps t3 p6 p7)
-     (inst vshufps t0 t2 t3 #x44)
-     (inst vinsertf32x4 dst dst t0 1)
+    (inst vunpcklps t2 p4 p5)
+    (inst vunpcklps t3 p6 p7)
+    (inst vshufps t0 t2 t3 #x44)
+    (inst vinsertf32x4 dst dst t0 1)
 
-     (inst vunpcklps t2 p8 p9)
-     (inst vunpcklps t3 p10 p11)
-     (inst vshufps t0 t2 t3 #x44)
-     (inst vinsertf32x4 dst dst t0 2)
+    (inst vunpcklps t2 p8 p9)
+    (inst vunpcklps t3 p10 p11)
+    (inst vshufps t0 t2 t3 #x44)
+    (inst vinsertf32x4 dst dst t0 2)
 
-     (inst vunpcklps t2 p12 p13)
-     (inst vunpcklps t3 p14 p15)
-     (inst vshufps t0 t2 t3 #x44)
-     (inst vinsertf32x4 dst dst t0 3)))
+    (inst vunpcklps t2 p12 p13)
+    (inst vunpcklps t3 p14 p15)
+    (inst vshufps t0 t2 t3 #x44)
+    (inst vinsertf32x4 dst dst t0 3)))
 
 (defknown %simd-pack-512-single-item
   (simd-pack-512 (integer 0 15)) single-float (flushable))

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


hooks/post-receive
-- 
SBCL