From ce99730828c5835a7eb66fd60c9104e1fe40c8e5 Mon Sep 17 00:00:00 2001 From: Stas Boukarev Date: Tue, 1 Sep 2026 23:51:07 +0300 Subject: [PATCH] x86-64: fix passing packed structs by value Reported by Andrew Wolven. --- src/code/alieneval.lisp | 4 +- src/compiler/x86-64/c-call.lisp | 85 +++++++++++++------------ tests/alien-struct-by-value.c | 48 ++++++++++++++ tests/alien-struct-by-value.impure.lisp | 76 ++++++++++++++++++++++ 4 files changed, 169 insertions(+), 44 deletions(-) diff --git a/src/code/alieneval.lisp b/src/code/alieneval.lisp index 3bb132ce0..ea53bc012 100644 --- a/src/code/alieneval.lisp +++ b/src/code/alieneval.lisp @@ -1158,10 +1158,10 @@ (ecase kind (:union (load-time-value - (!make-alien-record-type :kind :union))) + (!make-alien-record-type :kind :union :bits 0 :alignment 1))) (:struct (load-time-value - (!make-alien-record-type :kind :struct)))))))) + (!make-alien-record-type :kind :struct :bits 0 :alignment 1)))))))) (define-alien-type-translator union (name &rest fields &environment env) (parse-alien-record-type :union name fields env)) (define-alien-type-translator struct (name &rest fields &environment env) diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp index 4b1dd7b9f..4b4fcac6e 100644 --- a/src/compiler/x86-64/c-call.lisp +++ b/src/compiler/x86-64/c-call.lisp @@ -158,9 +158,9 @@ 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)) + (let* ((bits (alien-type-bits record-type)) (byte-size (ceiling bits 8)) - (alignment (sb-alien::alien-type-alignment record-type))) + (alignment (alien-type-alignment record-type))) ;; Rule: Structs > 16 bytes always use memory (hidden pointer) (when (> byte-size 16) (return-from classify-struct @@ -170,72 +170,73 @@ :alignment alignment :memory-p t))) - (let* ((num-eightbytes (max 1 (ceiling byte-size 8))) + (let* ((num-eightbytes (ceiling byte-size 8)) (eightbytes (make-list num-eightbytes :initial-element :no-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)))) + (labels ((merge-leaf (offset-bytes size-bytes class align-bytes) + (if (and (> align-bytes 0) + (plusp (mod offset-bytes align-bytes))) + ;; Unaligned fields go to memory + (setf (first eightbytes) :memory) + (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) + ((alien-record-type-p type) + (dolist (field (alien-record-type-fields type)) + (walk (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))) + (floor (alien-record-field-offset field) 8))))) + ((alien-array-type-p type) + (let* ((elt (alien-array-type-element-type type)) + (elt-bytes (ceiling (alien-type-bits elt) 8)) + (n (or (first (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)))))) + (ceiling (alien-type-bits type) 8) + (classify-field-sysv-amd64 type) + (floor (alien-type-alignment type) 8)))))) (walk record-type 0)) - - ;; Post-merge cleanup per ABI: if second eightbyte is MEMORY, first must be too - (when (and (> num-eightbytes 1) - (eq (second eightbytes) :memory)) - (setf (first eightbytes) :memory)) - - ;; Convert remaining :no-class to :integer (padding bytes are treated as integer) - (setf eightbytes - (mapcar (lambda (c) (if (eq c :no-class) :integer c)) eightbytes)) - + (if (member :memory eightbytes) + ;; If anything goes to memory then everything goes too + (setf eightbytes '(:memory)) + ;; Convert remaining :no-class to :integer (padding bytes are treated as integer) + (setf eightbytes + (mapcar (lambda (c) (if (eq c :no-class) :integer c)) eightbytes))) (sb-alien::make-struct-classification :register-slots eightbytes :size byte-size :alignment alignment - :memory-p (member :memory eightbytes))))) + :memory-p (and (member :memory eightbytes) t))))) #+win32 (defun classify-struct (record-type) "Classify struct for Windows AMD64 ABI. Size-based only: <=8 bytes in single integer register, >8 bytes via pointer. Floats are passed in integer registers." - (let* ((bits (sb-alien::alien-type-bits record-type)) + (let* ((bits (alien-type-bits record-type)) (byte-size (ceiling bits 8)) - (alignment (sb-alien::alien-type-alignment record-type))) - (if (> byte-size 8) + (alignment (alien-type-alignment record-type))) + (if (member byte-size '(1 2 4 8)) + ;; Small aligned struct: single integer + (sb-alien::make-struct-classification + :register-slots '(:integer) + :size byte-size + :alignment alignment + :memory-p nil) ;; Large struct: hidden pointer (sb-alien::make-struct-classification :register-slots '(:memory) :size byte-size :alignment alignment - :memory-p t) - ;; Small struct: single integer - (sb-alien::make-struct-classification - :register-slots '(:integer) - :size byte-size - :alignment alignment - :memory-p nil)))) + :memory-p t)))) ;;; Result TN generation for record types ;;; Called from src/code/c-call.lisp diff --git a/tests/alien-struct-by-value.c b/tests/alien-struct-by-value.c index 28f4de700..9618a1864 100644 --- a/tests/alien-struct-by-value.c +++ b/tests/alien-struct-by-value.c @@ -442,3 +442,51 @@ struct three_u64 three_u64_from_u128(__uint128_t x) { s.c = s.a ^ s.b; return s; } + +#include + +typedef struct __attribute__((packed)) { + uint8_t a; + uint16_t b; +} Struct3B; + +uint32_t sum_struct_3b(Struct3B s) { + return (uint32_t)s.a + (uint32_t)s.b; +} + +typedef struct __attribute__((packed)) { + uint64_t first; + uint8_t tag; + uint16_t unaligned; +} StructUnalignedSecond; + +uint64_t sum_unaligned_second(StructUnalignedSecond s) { + return s.first + s.tag + s.unaligned; +} + +typedef struct {} StructEmpty; + +int32_t check_empty_struct(StructEmpty s, int32_t val) { + (void)s; + return val * 2; +} + +typedef struct __attribute__((packed)) { + uint8_t pad; + uint16_t unaligned; + uint64_t b; +} StructMemFirst; + +uint64_t sum_mem_first(StructMemFirst s) { + return (uint64_t)s.pad + (uint64_t)s.unaligned + s.b; +} + +typedef struct { + unsigned __int128 val; +} StructInt128; + +StructInt128 make_int128(uint64_t low, uint64_t high) { + StructInt128 s; + s.val = ((unsigned __int128)high << 64) | low; + return s; +} diff --git a/tests/alien-struct-by-value.impure.lisp b/tests/alien-struct-by-value.impure.lisp index fb8dc23f8..1fe166c98 100644 --- a/tests/alien-struct-by-value.impure.lisp +++ b/tests/alien-struct-by-value.impure.lisp @@ -806,3 +806,79 @@ (assert (= (slot s 'a) low)) (assert (= (slot s 'b) high)) (assert (= (slot s 'c) (logxor low high))))) + + +(sb-alien:define-alien-type struct-3b + (sb-alien:struct nil + (a (sb-alien:unsigned 8)) + (b (sb-alien:unsigned 16) :offset 8 :alignment 8))) + +(sb-alien:define-alien-routine ("sum_struct_3b" sum-struct-3b) (sb-alien:unsigned 32) + (s struct-3b)) + +(with-test (:name :unaligned-3byte-struct) + (sb-alien:with-alien ((s3 struct-3b)) + (setf (sb-alien:slot s3 'a) 5 + (sb-alien:slot s3 'b) 300) + (assert (= (sum-struct-3b s3) 305)))) + +(sb-alien:define-alien-type struct-unaligned-second + (sb-alien:struct nil + (first (sb-alien:unsigned 64) :offset 0) + (tag (sb-alien:unsigned 8) :offset 64) + (unaligned (sb-alien:unsigned 16) :offset 72))) + +(sb-alien:define-alien-routine ("sum_unaligned_second" sum-unaligned-second) + (sb-alien:unsigned 64) + (s struct-unaligned-second)) + +(with-test (:name :unaligned-second-eightbyte-in-memory) + (sb-alien:with-alien ((s struct-unaligned-second)) + (setf (sb-alien:slot s 'first) 1000 + (sb-alien:slot s 'tag) 5 + (sb-alien:slot s 'unaligned) 400) + (assert (= (sum-unaligned-second s) 1405)))) + +(sb-alien:define-alien-type struct-empty + (sb-alien:struct nil)) + +(sb-alien:define-alien-routine ("check_empty_struct" check-empty-struct) + (sb-alien:signed 32) + (s struct-empty) + (val (sb-alien:signed 32))) + +(with-test (:name :empty-struct-consumes-no-registers) + (sb-alien:with-alien ((s struct-empty)) + (assert (= (check-empty-struct s 21) 42)))) + +(sb-alien:define-alien-type struct-mem-first + (sb-alien:struct nil + (pad (sb-alien:unsigned 8) :offset 0) + (unaligned (sb-alien:unsigned 16) :offset 8) + (b (sb-alien:unsigned 64) :offset 24))) + +(sb-alien:define-alien-routine ("sum_mem_first" sum-mem-first) + (sb-alien:unsigned 64) + (s struct-mem-first)) + +(with-test (:name :memory-first-eightbyte-propagation) + (sb-alien:with-alien ((s struct-mem-first)) + (setf (sb-alien:slot s 'pad) 7 + (sb-alien:slot s 'unaligned) 300 + (sb-alien:slot s 'b) 5000) + (assert (= (sum-mem-first s) 5307)))) + +;; (sb-alien:define-alien-type struct-int128 +;; (sb-alien:struct nil +;; (val (sb-alien:unsigned 128)))) + +;; (sb-alien:define-alien-routine ("make_int128" make-int128) +;; struct-int128 +;; (low (sb-alien:unsigned 64)) +;; (high (sb-alien:unsigned 64))) + +;; (with-test (:name :leaf-spanning-two-eightbytes) +;; (let* ((res (make-int128 #x1122334455667788 #xAABBCCDDEEFF0011)) +;; (val (sb-alien:slot res 'val)) +;; (expected (+ (ash #xAABBCCDDEEFF0011 64) #x1122334455667788))) +;; (assert (= val expected))))