master: x86-64, struct-by-value: correct ABI classification for nested structs

The branch "master" has been updated in SBCL:
       via  314b572626e177fc9c7625e26ef629cfe2b190c8 (commit)
      from  f484412bc4e3ebbbd2eedf83608a29aed6dc4e9c (commit)

- Log -----------------------------------------------------------------
commit 314b572626e177fc9c7625e26ef629cfe2b190c8
Author: Jesse Bouwman <[email protected]>
Date:   Sun Apr 26 17:25:24 2026 -0700

    x86-64, struct-by-value: correct ABI classification for nested structs
---
 src/compiler/x86-64/c-call.lisp         | 86 +++++++++++++--------------------
 tests/alien-struct-by-value.c           | 13 +++++
 tests/alien-struct-by-value.impure.lisp | 26 ++++++++++
 3 files changed, 73 insertions(+), 52 deletions(-)

diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp
index bd4053c11..7d20f433d 100644
--- a/src/compiler/x86-64/c-call.lisp
+++ b/src/compiler/x86-64/c-call.lisp
@@ -127,29 +127,14 @@
 
 #-win32
 (defun classify-field-sysv-amd64 (type)
-  "Classify a single field type for SysV AMD64 ABI.
-   Returns :INTEGER, :DOUBLE, or :MEMORY."
+  "Classify a leaf scalar field for SysV AMD64 ABI.
+   Returns :INTEGER, :DOUBLE, or :MEMORY.  Aggregates (records and
+   arrays) are flattened by CLASSIFY-STRUCT and never reach here."
   (cond
-    ;; Check specific types first, before general type checks
     ((sb-alien::alien-integer-type-p type) :integer)
     ((sb-alien::alien-pointer-type-p type) :integer)
     ((sb-alien::alien-single-float-type-p type) :double)
     ((sb-alien::alien-double-float-type-p type) :double)
-    ;; Arrays are classified by their element type
-    ((sb-alien::alien-array-type-p type)
-     (let ((element-type (sb-alien::alien-array-type-element-type type)))
-       (classify-field-sysv-amd64 element-type)))
-    ;; Nested struct - recursively classify and inherit eightbyte classes
-    ((sb-alien::alien-record-type-p type)
-     (let ((nested (classify-struct type)))
-       (if (sb-alien::struct-classification-memory-p nested)
-           :memory
-           ;; Merge all slots from nested struct to get dominant class
-           ;; e.g., struct { double d; } should contribute :double, not :integer
-           (reduce #'merge-classes
-                   (sb-alien::struct-classification-register-slots nested)
-                   :initial-value :no-class))))
-    ;; System-area-pointer (must come after array/record checks)
     ((typep type 'sb-alien::alien-system-area-pointer-type) :integer)
     (t :memory)))
 
@@ -170,7 +155,10 @@
 #-win32
 (defun classify-struct (record-type)
   "Classify struct for x86-64 System V ABI return.
-   Returns STRUCT-CLASSIFICATION."
+   Returns STRUCT-CLASSIFICATION.
+
+   Walks fields recursively, descending into nested records and arrays
+   so each leaf scalar contributes to the eightbyte it lands in."
   (let* ((bits (sb-alien::alien-type-bits record-type))
          (byte-size (ceiling bits 8))
          (alignment (sb-alien::alien-type-alignment record-type)))
@@ -183,24 +171,35 @@
          :alignment alignment
          :memory-p t)))
 
-    ;; Classify each eightbyte
     (let* ((num-eightbytes (max 1 (ceiling byte-size 8)))
            (eightbytes (make-list num-eightbytes :initial-element :no-class)))
-      ;; Iterate through fields and classify
-      (dolist (field (sb-alien::alien-record-type-fields record-type))
-        (let* ((field-offset-bits (sb-alien::alien-record-field-offset field))
-               (field-type (sb-alien::alien-record-field-type field))
-               (field-bits (sb-alien::alien-type-bits field-type))
-               (field-offset-bytes (floor field-offset-bits 8))
-               (field-size-bytes (ceiling field-bits 8))
-               (field-class (classify-field-sysv-amd64 field-type)))
-          ;; Apply class to all eightbytes this field spans
-          (loop for byte-offset from field-offset-bytes below (+ field-offset-bytes field-size-bytes) by 8
-                for eightbyte-index = (floor byte-offset 8)
-                when (< eightbyte-index num-eightbytes)
-                do (setf (nth eightbyte-index eightbytes)
-                         (merge-classes (nth eightbyte-index eightbytes)
-                                        field-class)))))
+      (labels ((merge-leaf (offset-bytes size-bytes class)
+                 (loop for byte-offset from offset-bytes
+                       below (+ offset-bytes size-bytes)
+                       by 8
+                       for eb = (floor byte-offset 8)
+                       when (< eb num-eightbytes)
+                       do (setf (nth eb eightbytes)
+                                (merge-classes (nth eb eightbytes) class))))
+               (walk (type offset-bytes)
+                 (cond
+                   ((sb-alien::alien-record-type-p type)
+                    (dolist (field (sb-alien::alien-record-type-fields type))
+                      (walk (sb-alien::alien-record-field-type field)
+                            (+ offset-bytes
+                               (floor (sb-alien::alien-record-field-offset field) 8)))))
+                   ((sb-alien::alien-array-type-p type)
+                    (let* ((elt (sb-alien::alien-array-type-element-type type))
+                           (elt-bytes (ceiling (sb-alien::alien-type-bits elt) 8))
+                           (n (or (first (sb-alien::alien-array-type-dimensions type)) 0)))
+                      (dotimes (i n)
+                        (walk elt (+ offset-bytes (* i elt-bytes))))))
+                   ;; Leaf scalar
+                   (t
+                    (merge-leaf offset-bytes
+                                (ceiling (sb-alien::alien-type-bits type) 8)
+                                (classify-field-sysv-amd64 type))))))
+        (walk record-type 0))
 
       ;; Post-merge cleanup per ABI: if second eightbyte is MEMORY, first must be too
       (when (and (> num-eightbytes 1)
@@ -333,23 +332,6 @@ Floats are passed in integer registers."
       (4 (inst movss target (ea offset sap)))
       (8 (inst movsd target (ea offset sap))))))
 
-;;; VOPs for storing struct result registers to memory
-;;; These VOPs store result register values back to memory for struct-by-value returns
-
-(define-vop (store-struct-int-result)
-  (:args (value :scs (unsigned-reg signed-reg))
-         (sap :scs (sap-reg)))
-  (:info offset)
-  (:generator 5
-    (inst mov :qword (ea offset sap) value)))
-
-(define-vop (store-struct-sse-result)
-  (:args (value :scs (double-reg single-reg))
-         (sap :scs (sap-reg)))
-  (:info offset)
-  (:generator 5
-    (inst movsd (ea offset sap) value)))
-
 ;;; VOP to copy a full or partial qword from struct SAP to the C
 ;;; argument stack Used for passing large structs (>16 bytes) by value
 
diff --git a/tests/alien-struct-by-value.c b/tests/alien-struct-by-value.c
index 9eb00d782..a77cd7136 100644
--- a/tests/alien-struct-by-value.c
+++ b/tests/alien-struct-by-value.c
@@ -414,3 +414,16 @@ long long call_with_small_union(small_union_callback cb, long long val) {
 union small_union call_returning_small_union(small_union_return_callback cb, long long val) {
   return cb(val);
 }
+
+/*
+ * Nested struct classification fixture for call-by-value: The inner
+ * struct of nest_di spans both eightbytes of the outer: the SysV
+ * classifier must walk it field-by-field rather than collapsing it to
+ * a single class.
+ */
+struct inner_di { double d; int i; };
+struct nest_di { struct inner_di inner; };
+struct nest_di nest_di_make(double d, int i) {
+  struct nest_di s; s.inner.d = d; s.inner.i = i; return s;
+}
+double nest_di_sum(struct nest_di s) { return s.inner.d + (double)s.inner.i; }
diff --git a/tests/alien-struct-by-value.impure.lisp b/tests/alien-struct-by-value.impure.lisp
index 8b9bd805b..c845d43e2 100644
--- a/tests/alien-struct-by-value.impure.lisp
+++ b/tests/alien-struct-by-value.impure.lisp
@@ -760,3 +760,29 @@
                  1.5d0 2.5d0)))
     (assert (= (slot result 'd0) 1.5d0))
     (assert (= (slot result 'd1) 2.5d0))))
+
+;;; Test that an outer struct wrapping a nested {double, int} is
+;;; classified correctly and matches SysV ABI expectations.
+;;;
+;;; Without recursive flattening the nested struct collapses to
+;;; :INTEGER, both slots come out :INTEGER, and a double is misrouted
+;;; through a GPR.
+(define-alien-type nil (struct inner-di (d double) (i int)))
+(define-alien-type nil (struct nest-di (inner (struct inner-di))))
+(define-alien-routine nest-di-make (struct nest-di) (d double) (i int))
+(define-alien-routine nest-di-sum double (s (struct nest-di)))
+
+#+(and x86-64 (not win32))
+(with-test (:name :struct-by-value-nested-classifier)
+  (let* ((type (sb-alien::parse-alien-type '(struct nest-di) nil))
+         (cls  (sb-vm::classify-struct type)))
+    (assert (equal (sb-alien::struct-classification-register-slots cls)
+                   '(:double :integer)))
+    (assert (= (sb-alien::struct-classification-size cls) 16))
+    (assert (not (sb-alien::struct-classification-memory-p cls)))))
+
+(with-test (:name :struct-by-value-nested-double-int)
+  (let ((s (nest-di-make 3.5d0 7)))
+    (assert (= (slot (slot s 'inner) 'd) 3.5d0))
+    (assert (= (slot (slot s 'inner) 'i) 7))
+    (assert (= (nest-di-sum s) 10.5d0))))

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


hooks/post-receive
-- 
SBCL