master: Save avx-512 registers around foreign calls

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

- Log -----------------------------------------------------------------
commit 50e47018399676a507a2c6a94269599f15b428c8
Author: Stas Boukarev <[email protected]>
Date:   Tue Aug 25 19:30:31 2026 +0300

    Save avx-512 registers around foreign calls
    
    Without wiring any temporaries
---
 src/compiler/life.lisp          |  9 ++++++++-
 src/compiler/meta-vmdef.lisp    |  6 +++---
 src/compiler/pack.lisp          | 27 +++++++++++++++++++--------
 src/compiler/vop.lisp           |  2 +-
 src/compiler/x86-64/alloc.lisp  | 10 +++-------
 src/compiler/x86-64/c-call.lisp | 21 ++-------------------
 6 files changed, 36 insertions(+), 39 deletions(-)

diff --git a/src/compiler/life.lisp b/src/compiler/life.lisp
index 0e8d53ba9..ce7760058 100644
--- a/src/compiler/life.lisp
+++ b/src/compiler/life.lisp
@@ -634,7 +634,14 @@
 (defun saved-after-read (tn block)
   (do ((vop (ir2-block-last-vop block) (vop-prev vop)))
       ((null vop) t)
-    (when (vop-info-save-p (vop-info vop)) (return t))
+    (case (vop-info-save-p (vop-info vop))
+      ((nil))
+      #+sb-simd-pack-512
+      (:avx512
+       (when (sb-vm::avx512-tn-p tn)
+         (return t)))
+      (t
+       (return t)))
     (when (find-in #'tn-ref-across tn (vop-args vop) :key #'tn-ref-tn)
       (return nil))))
 
diff --git a/src/compiler/meta-vmdef.lisp b/src/compiler/meta-vmdef.lisp
index 73b650574..260b48625 100644
--- a/src/compiler/meta-vmdef.lisp
+++ b/src/compiler/meta-vmdef.lisp
@@ -333,7 +333,7 @@
   (translate () :type list)
   (ltn-policy :fast :type ltn-policy)
   ;; stuff used by life analysis
-  (save-p nil :type (member t nil :compute-only :force-to-stack))
+  (save-p nil :type (member t nil :compute-only :force-to-stack #+sb-simd-pack-512 :avx512))
   ;; info about how to emit MOVE-ARG VOPs for the &MORE operand in
   ;; call/return VOPs
   (move-args nil :type (member nil :local-call :full-call :known-return :fixed))
@@ -1108,7 +1108,7 @@
         (:save-p
          (setf (vop-parse-save-p parse)
                (vop-spec-arg spec
-                             '(member t nil :compute-only :force-to-stack))))
+                             '(member t nil :compute-only :force-to-stack #+sb-simd-pack-512 :avx512))))
         (:optional-results
          (setf (vop-parse-optional-results parse)
                (append (vop-parse-optional-results parse)
@@ -1733,7 +1733,7 @@
 ;;;     In the generator, bind the specified variable to the VOP or
 ;;;     the Node that generated this VOP.
 ;;;
-;;; :SAVE-P {NIL | T | :COMPUTE-ONLY | :FORCE-TO-STACK}
+;;; :SAVE-P {NIL | T | :COMPUTE-ONLY | :FORCE-TO-STACK | :AVX-512 }
 ;;;     Indicates how a VOP wants live registers saved.
 ;;;
 ;;; :MOVE-ARGS {NIL | :FULL-CALL | :LOCAL-CALL | :KNOWN-RETURN}
diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp
index 906f78460..c53060eef 100644
--- a/src/compiler/pack.lisp
+++ b/src/compiler/pack.lisp
@@ -651,14 +651,25 @@
   (declare (type ir2-block block))
   (do ((vop (ir2-block-start-vop block) (vop-next vop)))
       ((null vop))
-    (when (eq (vop-info-save-p (vop-info vop)) t)
-      (do-live-tns (tn (vop-save-set vop) block)
-        (when (and (sc-save-p (tn-sc tn))
-                   (not (eq (tn-kind tn) :component))
-                   ;; Ignore closed over but not read values (due to
-                   ;; type propagation)
-                   (tn-offset tn))
-          (basic-save-tn tn vop)))))
+    (case (vop-info-save-p (vop-info vop))
+      ((t)
+       (do-live-tns (tn (vop-save-set vop) block)
+         (when (and (sc-save-p (tn-sc tn))
+                    (not (eq (tn-kind tn) :component))
+                    ;; Ignore closed over but not read values (due to
+                    ;; type propagation)
+                    (tn-offset tn))
+           (basic-save-tn tn vop))))
+      #+sb-simd-pack-512
+      (:avx512
+       (do-live-tns (tn (vop-save-set vop) block)
+         (when (and (sc-save-p (tn-sc tn))
+                    (not (eq (tn-kind tn) :component))
+                    ;; Ignore closed over but not read values (due to
+                    ;; type propagation)
+                    (tn-offset tn)
+                    (sb-vm::avx512-tn-p tn))
+           (basic-save-tn tn vop))))))
 
   (values))
 
diff --git a/src/compiler/vop.lisp b/src/compiler/vop.lisp
index aeca73d7b..ad6266024 100644
--- a/src/compiler/vop.lisp
+++ b/src/compiler/vop.lisp
@@ -675,7 +675,7 @@
   ;;    used by NLX entry vops.
   ;; -- If :COMPUTE-ONLY, just compute the save set, don't do any saving.
   ;;    This is used to get the live variables for debug info.
-  (save-p nil :type (member t nil :force-to-stack :compute-only))
+  (save-p nil :type (member t nil :force-to-stack :compute-only #+sb-simd-pack-512 :avx512))
   ;; info for automatic emission of move-arg VOPs by representation
   ;; selection. If NIL, then do nothing special. If non-null, then
   ;; there must be a more arg. Each more arg is moved to its passing
diff --git a/src/compiler/x86-64/alloc.lisp b/src/compiler/x86-64/alloc.lisp
index 56a2babfa..564176918 100644
--- a/src/compiler/x86-64/alloc.lisp
+++ b/src/compiler/x86-64/alloc.lisp
@@ -213,12 +213,8 @@
 (define-vop (sb-c::end-pseudo-atomic)
   (:generator 1 (emit-end-pseudo-atomic)))
 
-(defun avx512-state-tn-p (tn)
-  (sc-is tn
-         int-avx512-reg
-         double-avx512-reg
-         single-avx512-reg
-         mask-reg))
+(defun avx512-tn-p (tn)
+  (sc-is tn int-avx512-reg double-avx512-reg single-avx512-reg mask-reg))
 
 (defun avx512-state-used-p ()
   (when (and #+sb-xc-host (boundp '*component-being-compiled*))
@@ -226,7 +222,7 @@
       (flet ((used-p (tn)
                (do ((tn tn (sb-c::tn-next tn)))
                    ((null tn))
-                 (when (avx512-state-tn-p tn)
+                 (when (avx512-tn-p tn)
                    (return-from avx512-state-used-p t)))))
         (used-p (sb-c::ir2-component-normal-tns comp))
         (used-p (sb-c::ir2-component-wired-tns comp))))))
diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp
index 4302bc766..361e41bed 100644
--- a/src/compiler/x86-64/c-call.lisp
+++ b/src/compiler/x86-64/c-call.lisp
@@ -670,25 +670,8 @@ Floats are passed in integer registers."
              collect `(:temporary
                        (:sc single-reg :offset ,float :from :eval :to :result)
                        ,(car (push (make-symbol varname) vars))))
-
-       ;; AVX-512 high ZMM registers, ZMM16-31.
-       #+(and sb-simd-pack-512 nil)
-       (append
-        (loop for zmm from 16 below 32
-              for varname = (format nil "ZMM~D" zmm)
-              collect `(:temporary
-                        (:sc single-avx512-reg :offset ,zmm
-                         :from :eval :to :result)
-                        ,(car (push (make-symbol varname) vars))))
-
-        ;; AVX-512 opmask registers K1-K7.
-        ;; K0 is not allocatable so not listed here
-        (loop for mask from 1 to 7
-              for varname = (format nil "MASK~D" mask)
-              collect `(:temporary
-                        (:sc mask-reg :offset ,mask :from :eval :to :result)
-                        ,(car (push (make-symbol varname) vars)))))
-
+       #+sb-simd-pack-512
+       '((:save-p :avx512))
        `((:ignore ,@vars))))))
 
 (define-vop (call-out)

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


hooks/post-receive
-- 
SBCL