master: Rename DSD-READER to DSD-PRIMITIVES

The branch "master" has been updated in SBCL:
       via  c247cda09e87e2d27869aae57cb70e084ec94149 (commit)
      from  cce821a3c73151cd969dcfbd371eaa80470a51a1 (commit)

- Log -----------------------------------------------------------------
commit c247cda09e87e2d27869aae57cb70e084ec94149
Author: Douglas Katzman <[email protected]>
Date:   Mon Apr 6 01:13:54 2026 -0400

    Rename DSD-READER to DSD-PRIMITIVES
    
    it returns 2 values. And take the DD rather than a boolean for the 2nd arg.
---
 src/code/defstruct.lisp       | 21 +++++++++++----------
 src/code/inspect.lisp         |  2 +-
 src/cold/exports.lisp         |  2 +-
 src/pcl/braid.lisp            |  6 +++---
 src/pcl/compiler-support.lisp |  2 +-
 5 files changed, 17 insertions(+), 16 deletions(-)

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index b9fd23f87..5d3d90fb9 100644
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -209,10 +209,11 @@
   (acond ((dsd-raw-slot-data dsd) (raw-slot-data-raw-type it))
          (t)))
 
-(defun dsd-reader (dsd funinstancep)
+(defun dsd-primitives (dsd dd) ; return low-level (reader, writer) for this slot
+  (declare (type defstruct-slot-description dsd) (type defstruct-description dd))
   (acond ((dsd-raw-slot-data dsd)
           (values (raw-slot-data-reader-name it) (raw-slot-data-writer-name it)))
-         (funinstancep
+         ((eq (dd-type dd) 'funcallable-structure)
           (values '%funcallable-instance-info '%set-funcallable-instance-info))
          (t
           (values '%instance-ref '%instance-set))))
@@ -289,7 +290,7 @@
           (binding* ((key (cons dd dsd))
                      (name (string (dsd-name dsd))) ; anonymize by stringification
                      ;; reader and writer are the primitive operations
-                     ((reader writer) (dsd-reader dsd (neq (dd-type dd) 'structure)))
+                     ((reader writer) (dsd-primitives dsd dd))
                      ;; accessor is the global defun
                      (accessor (dsd-accessor-name dsd)))
             (declare (dynamic-extent key))
@@ -450,8 +451,8 @@
   ;; that compare more than one word at a time.
   (collect ((group1) (group2) (group3))
     (mapc (lambda (dsd comparator)
-            (let ((x `(truly-the ,(dsd-type dsd) (,(dsd-reader dsd nil) a ,(dsd-index dsd))))
-                  (y `(truly-the ,(dsd-type dsd) (,(dsd-reader dsd nil) b ,(dsd-index dsd)))))
+            (let ((x `(truly-the ,(dsd-type dsd) (,(dsd-primitives dsd dd) a ,(dsd-index dsd))))
+                  (y `(truly-the ,(dsd-type dsd) (,(dsd-primitives dsd dd) b ,(dsd-index dsd)))))
               (cond ((member comparator '(= char-equal))
                      (group1 `(,comparator ,x ,y))) ; bounded amount of testing
                     ((member comparator '(bit-vector-=)) ; TODO: strings
@@ -1268,7 +1269,7 @@ unless :NAMED is also specified.")))
                                 (external-unbound-handling nil))
   (binding* ((dd (car slot-key))
              (dsd (cdr slot-key))
-             ((reader writer) (dsd-reader dsd (neq (dd-type dd) 'structure)))
+             ((reader writer) (dsd-primitives dsd dd))
              (type-spec (dsd-type dsd))
              (index (dsd-index dsd)))
     (ecase operation
@@ -2365,18 +2366,18 @@ or they must be declared locally notinline at each call site.~@:>"
                                                 environment)
   (declare (ignore environment))
   (if (typep object 'structure-object)
-      (let ((type (type-of object)))
+      (let ((dd (layout-dd (%instance-layout object))))
         (collect ((inits))
-          (dolist (dsd (dd-slots (layout-dd (%instance-layout object))))
+          (dolist (dsd (dd-slots dd))
             (declare (type defstruct-slot-description dsd))
             (let ((slot-name (dsd-name dsd)))
               (when (or (memq slot-name slot-names)
                         (not slot-names-p))
-                (let* ((accessor (dsd-reader dsd nil))
+                (let* ((accessor (dsd-primitives dsd dd))
                        (index (dsd-index dsd))
                        (value (funcall accessor object index)))
                   (inits `(setf (,accessor ,object ,index) ',value))))))
-          (values `(allocate-struct ',(the symbol type)) ;; no anonymous defstructs
+          (values `(allocate-struct ',(dd-name dd)) ;; no anonymous defstructs
                   `(progn ,@(inits)))))
       #-sb-xc-host
       (let ((class (class-of object)))
diff --git a/src/code/inspect.lisp b/src/code/inspect.lisp
index 14612782a..dcf72f22d 100644
--- a/src/code/inspect.lisp
+++ b/src/code/inspect.lisp
@@ -170,7 +170,7 @@ evaluated expressions.
         (info (layout-info (sb-kernel:layout-of object))))
     (when (sb-kernel::defstruct-description-p info)
       (dolist (dd-slot (dd-slots info) (nreverse parts-list))
-        (let* ((reader (dsd-reader dd-slot (neq (dd-type info) 'structure)))
+        (let* ((reader (dsd-primitives dd-slot info))
                (index (dsd-index dd-slot))
                (value (funcall reader object index)))
           (push (cons (dsd-name dd-slot) value) parts-list))))))
diff --git a/src/cold/exports.lisp b/src/cold/exports.lisp
index 540fd5b83..5efd4381a 100644
--- a/src/cold/exports.lisp
+++ b/src/cold/exports.lisp
@@ -1742,7 +1742,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries.")
            "DOUBLE-FLOAT-HIGH-BITS" "DOUBLE-FLOAT-INT-EXPONENT"
            "DOUBLE-FLOAT-LOW-BITS" "DOUBLE-FLOAT-SIGNIFICAND"
            "DSD-ACCESSOR-NAME" "DSD-ALWAYS-BOUNDP" "DSD-DEFAULT" "DSD-INDEX"
-           "DSD-NAME" "DSD-RAW-TYPE" "DSD-READ-ONLY" "DSD-READER" "DSD-TYPE"
+           "DSD-NAME" "DSD-RAW-TYPE" "DSD-READ-ONLY" "DSD-PRIMITIVES" "DSD-TYPE"
            "DYNAMIC-SPACE-OBJ-P"
            "DYNBIND"
            "FLOAT-WAIT" "DYNAMIC-SPACE-FREE-POINTER" "DYNAMIC-USAGE"
diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index 7d931bd4a..d8d3ddf36 100644
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -116,8 +116,8 @@
              ;; This is nuts! any DEFAULT might need its lexical environment,
              ;; yet we EVAL in the null environment.
              :initfunction ,(eval-form (dsd-default slotd)))))
-       (accessor-closures (dsd)
-         (multiple-value-bind (reader-fn writer-fn) (sb-kernel::dsd-reader dsd nil)
+       (accessor-closures (dsd dd)
+         (multiple-value-bind (reader-fn writer-fn) (dsd-primitives dsd dd)
            ;; This is for a structure class that exists only in its compile-time representation.
            ;; I don't see how these would get called, since you can't make an instance
            ;; of the structure.
@@ -136,7 +136,7 @@
                            (delete it sb-kernel::*struct-access-fragments-delayed*)))
                     (t
                      (dolist (dsd (dd-slots dd))
-                       (push (cons dsd (accessor-closures dsd)) extra-data)))))
+                       (push (cons dsd (accessor-closures dsd dd)) extra-data)))))
            (multiple-value-bind (super slot-overrides)
                (if (consp include)
                    (values (car include) (mapcar #'car (cdr include)))
diff --git a/src/pcl/compiler-support.lisp b/src/pcl/compiler-support.lisp
index 742222d84..9ac81f2f8 100644
--- a/src/pcl/compiler-support.lisp
+++ b/src/pcl/compiler-support.lisp
@@ -107,7 +107,7 @@
                  ;; I blindly copied this expansion from that of a typical DEFSTRUCT's
                  ;; accessor. I don't claim to understand the use of THE*.
                  `(the* (,(dsd-type dsd1) :derive-type-only t)
-                        (,(dsd-reader dsd1 nil) object ,i)))
+                        (,(dsd-primitives dsd1 dd1) object ,i)))
                ;; slots differ in physical representation and/or lisp type
                `(if ,test
                     (,(dsd-accessor-name then) object)

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


hooks/post-receive
-- 
SBCL