master: Fix arena-related crash

The branch "master" has been updated in SBCL:
       via  8796281182447fa2091610881629204729b04793 (commit)
      from  e3c2db021f4f5138ec1f04b3c0c83148c362a45d (commit)

- Log -----------------------------------------------------------------
commit 8796281182447fa2091610881629204729b04793
Author: Douglas Katzman <[email protected]>
Date:   Thu Jul 16 15:46:05 2026 +0000

    Fix arena-related crash
---
 src/code/target-defstruct.lisp | 11 +++++++----
 tests/arena.impure.lisp        | 20 ++++++++++++++++++++
 2 files changed, 27 insertions(+), 4 deletions(-)

diff --git a/src/code/target-defstruct.lisp b/src/code/target-defstruct.lisp
index 6130d606c..93540faf3 100644
--- a/src/code/target-defstruct.lisp
+++ b/src/code/target-defstruct.lisp
@@ -614,6 +614,7 @@
                   (h (progn ,@body)))
              (if (< h ,nbuckets) ,resultform)))))))
 
+;;; Unclear why this is in SB-PCL package. It's used more from here.
 (declaim (inline sb-pcl::search-struct-slot-name-vector))
 (defun sb-pcl::search-struct-slot-name-vector (mapper slot-name)
   (declare (optimize (sb-c::insert-array-bounds-checks 0)))
@@ -665,6 +666,7 @@
 ;;; until the function is called (which may never occur), and secondly the caller
 ;;; is never delayed by waiting for the compiler.
 (defun install-struct-slot-mapper (layout)
+  (declare (sb-c::tlab :system))
   (let* ((dd (layout-dd layout))
          (slots (dd-slots dd))
          (keys (map 'vector #'dsd-name slots))
@@ -683,6 +685,7 @@
       (return-from install-struct-slot-mapper
         (setf (layout-slot-mapper layout) vector)))
     (let ((me (%make-slot-mapper-fn))
+          (name `(slot-mapper ,(dd-name dd)))
           (pairs (map 'list #'cons keys values)))
       (setf (sb-kernel:%funcallable-instance-fun me)
             (lambda (symbol)
@@ -692,13 +695,13 @@
               (let ((old (layout-slot-mapper layout)))
                 (if (neq old me) ; if it's not ME, then it's either the second stage mapper
                     ;; or else a compiled perfect-hash-based mapper. Either way, punt.
-                    (funcall old symbol)
-                    (let* ((new (make-second-stage-slot-mapper vector))
+                    (funcall (the function old) symbol)
+                    (let* ((new (lambda (symbol)
+                                  (sb-pcl::search-struct-slot-name-vector vector symbol)))
                            (actual-old
                             (%layout-slot-cas layout (get-dsd-index layout slot-mapper) me new)))
                       (when (eq actual-old me)
-                        (install-hash-based-slot-mapper
-                         layout pairs unique-hashes `(slot-mapper ,(dd-name dd))))
+                        (install-hash-based-slot-mapper layout pairs unique-hashes name))
                       (funcall new symbol))))))
       (setf (layout-slot-mapper layout) me))))
 
diff --git a/tests/arena.impure.lisp b/tests/arena.impure.lisp
index b88097da9..6b87ea20b 100644
--- a/tests/arena.impure.lisp
+++ b/tests/arena.impure.lisp
@@ -727,3 +727,23 @@
            (sb-thread:join-thread thread)
            (assert (heap-allocated-p (sb-thread:thread-name thread))))
       (destroy-arena arena))))
+
+(defstruct fleemazoid a b c d e f g)
+(defun get-a-slot (inst sym) (slot-value (the fleemazoid inst) sym))
+;; Just in case we decide that this file can run in --evaluator-mode interpret
+;; (which it currently can't) ensure that slot-value uses the layout slot mapper.
+(compile 'get-a-slot)
+(test-util:with-test (:name :slot-mapper-not-in-arena)
+  (let ((a (sb-vm:new-arena 65536)))
+    (sb-vm:with-arena (a)
+      (get-a-slot (make-fleemazoid :c "hi-c") 'c))
+    (destroy-arena a)
+    ;; There's no way to know when the background compile is done, we can't really
+    ;; do any better than to wait a little. Deciding based on whether the finalizer's
+    ;; work queue is empty constitutes a data race- it grabs an item and then compiles,
+    ;; so you don't know when COMPILE is actually done.
+    (sleep .1)
+    (let ((fun (sb-kernel::layout-slot-mapper (sb-kernel:find-layout 'fleemazoid))))
+      (assert (sb-kernel:simple-fun-p fun))
+      (let ((name (sb-kernel:%simple-fun-name fun)))
+        (assert (sb-ext:heap-allocated-p name))))))

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


hooks/post-receive
-- 
SBCL