Re: [PATCH] Struct-by-value support for x86-64 and ARM64
Jesse Bouwman via Sbcl-devel <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.devel |
|---|---|
| Message-ID | <[email protected]> |
Here is a win32 version of struct-by-value that passes tests, let me know if you see anything that needs work. The same commit is open as a pull request against the github mirror. Stack allocation of return values forthcoming. Cheers, Jesse > On Jan 14, 2026, at 7:43 PM, Stas Boukarev <[email protected]> wrote: > > If that can be made to work, sure. Normally, WITH-ALIEN directs stack > allocation. > > On Thu, Jan 15, 2026 at 6:40 AM Jesse Bouwman > <[email protected]> wrote: >> >> Agreed. Do you think it would make sense to use a dynamic-extent declaration to mark a return value for stack allocation? >> >>> On Jan 14, 2026, at 6:27 PM, Stas Boukarev <[email protected]> wrote: >>> >>> The return values seem to be allocated using malloc and no way to put >>> them on the stack. That doesn't appear to be ideal. >>> >>> On Thu, Jan 15, 2026 at 4:11 AM Stas Boukarev <[email protected]> wrote: >>>> >>>> About a week before the end of the month. But changes to new code can come in late. >>>> On Thu, Jan 15, 2026 at 03:47 Jesse Bouwman <[email protected]> wrote: >>>>> >>>>> I looked at win32, the struct classification is simpler than sysv, and other aspects look similar -- when does this release cycle close? >>>>> >>>>>> On Jan 14, 2026, at 9:20 AM, Stas Boukarev <[email protected]> wrote: >>>>>> >>>>>> Ok, I fixed that. >>>>>> >>>>>> On Wed, Jan 14, 2026 at 7:24 PM Stas Boukarev <[email protected]> wrote: >>>>>>> >>>>>>> It just segfaults. >>>>>>> >>>>>>> On Wed, Jan 14, 2026 at 7:14 PM Jesse Bouwman >>>>>>> <[email protected]> wrote: >>>>>>>> >>>>>>>> Thank you for cleaning up the tests. I will take a look at win32. >>>>>>>> >>>>>>>> What result did you see from callback-struct-return-large? I reenabled it locally and it passed. Machine info: >>>>>>>> >>>>>>>> Linux wren 6.12.44 #1-NixOS SMP PREEMPT_DYNAMIC Thu Aug 28 14:31:16 UTC 2025 x86_64 GNU/Linux >>>>>>>> >>>>>>>> On Jan 13, 2026, at 11:14 PM, Stas Boukarev <[email protected]> wrote: >>>>>>>> >>>>>>>> I merged this, but haven't reviewed it much. (I had to change it to >>>>>>>> compile on unsupported targets). >>>>>>>> And the callback-struct-return-large test fails on x86-64. >>>>>>>> How hard would it be to add win32 support during this release cycle? >>>>>>>> >>>>>>>> >>>>>>>> On Wed, Jan 14, 2026 at 2:58 AM Jesse Bouwman via Sbcl-devel >>>>>>>> <[email protected]> wrote: >>>>>>>> >>>>>>>> >>>>>>>> Hi, >>>>>>>> >>>>>>>> here is a patch that adds support for passing and returning structs by value on unix-like x86-64 and ARM64. >>>>>>>> >>>>>>>> Briefly, src/code/c-call.lisp dispatches to architecture-specific struct classifiers; classifiers determine whether a struct should be passed in registers or memory, per ABI rules: For x86-64, structs less than 16 bytes are classified into "eightbytes" that map to int or SSE register classes. Larger structs are passed via hidden pointer in RDI, and returned in RAX. ARM64 supports HFA: structs of up to 4 same-type floats are passed/returned in floating-point registers. Non-HFA structs less than 16 bytes use x0/x1; larger structs use a hidden pointer in x8. The alien-funcall IR1 transform handles both small struct returns (unpacking register to heap) and large struct returns (hidden pointer as synthetic first argument). >>>>>>>> >>>>>>>> There are no changes to the FFI interface. >>>>>>>> >>>>>>>> Other notes: >>>>>>>> >>>>>>>> Implementation owes a lot to the work done a year ago by Rongcui Dong and reviewers, documented on the launchpad thread at https://bugs.launchpad.net/sbcl/+bug/313202 >>>>>>>> >>>>>>>> What I would deem pretty thorough testing is included: variously sized structs, nested structs, structs containing arrays, unions, etc. I've been debugging this with a binding to libclang, this has shaken out some serioous bugs, and I think it's now usable. I would welcome feedback about any aspects, especially relating to bad assumptions, missing functionality, or non-sbcl-idiomatic code. >>>>>>>> >>>>>>>> The branch is at: https://github.com/jbouwman/sbcl/tree/struct-by-value-final >>>>>>>> >>>>>>>> As the code is a result of bouncing between arm/darwin and x86/linux to try to get reasonably clean abstractions, it was squashed into a few big commits, but can be retroactively broken up in order to get something a little more bisectable for future debugging ergonomics. >>>>>>>> >>>>>>>> Windows is blocked by a non-SysV ABI which is not familiar to me, but looks pretty easy. Famous last words! >>>>>>>> >>>>>>>> Cheers, >>>>>>>> Jesse >>>>>>>> >>>>>>>> >>>>>>>> _______________________________________________ >>>>>>>> Sbcl-devel mailing list >>>>>>>> [email protected] >>>>>>>> https://lists.sourceforge.net/lists/listinfo/sbcl-devel >>>>>>>> >>>>>>>> >>>>> >>>>> >> >> _______________________________________________ Sbcl-devel mailing list [email protected] https://lists.sourceforge.net/lists/listinfo/sbcl-devel
0001-win32-ABI-struct-return-by-value.patch
(application/octet-stream, 26.2 KB)
From ac534268041120e793b431f9472c7bee74973526 Mon Sep 17 00:00:00 2001 From: Jesse Bouwman <[email protected]> Date: Wed, 14 Jan 2026 10:25:43 -0800 Subject: [PATCH] win32 ABI struct-return-by-value - win32 struct classification - win32 versions of record-result-tn and record-arg-tn - update alien-callback-assembler-wrapper - remove abi suffixes from classify-struct --- src/code/c-call.lisp | 13 +- src/compiler/arm64/c-call.lisp | 12 +- src/compiler/x86-64/c-call.lisp | 265 +++++++++++++++++------- tests/alien-struct-by-value.impure.lisp | 2 +- 4 files changed, 196 insertions(+), 96 deletions(-) diff --git a/src/code/c-call.lisp b/src/code/c-call.lisp index d4f6b8ccb..2d343d1ac 100644 --- a/src/code/c-call.lisp +++ b/src/code/c-call.lisp @@ -177,20 +177,11 @@ "Classify how a struct should be returned according to platform ABI. Returns (values in-registers-p register-slots size) or (values nil nil nil) for non-structs." (declare (ignorable alien-type)) - #+(and arm64 (not sb-xc-host)) + #+(and (or arm64 x86-64) (not sb-xc-host)) (progn (unless (alien-record-type-p alien-type) (return-from struct-return-info (values nil nil nil))) - (let ((classification (sb-vm::classify-struct-aapcs64 alien-type))) - (when classification - (values (not (struct-classification-memory-p classification)) - (struct-classification-register-slots classification) - (struct-classification-size classification))))) - #+(and x86-64 (not sb-xc-host)) - (progn - (unless (alien-record-type-p alien-type) - (return-from struct-return-info (values nil nil nil))) - (let ((classification (sb-vm::classify-struct-sysv-amd64 alien-type))) + (let ((classification (sb-vm::classify-struct alien-type))) (when classification (values (not (struct-classification-memory-p classification)) (struct-classification-register-slots classification) diff --git a/src/compiler/arm64/c-call.lisp b/src/compiler/arm64/c-call.lisp index 0e3d35a7c..425ba00a4 100644 --- a/src/compiler/arm64/c-call.lisp +++ b/src/compiler/arm64/c-call.lisp @@ -249,7 +249,7 @@ (values base-type count)))) ;;; Main classification function for ARM64 AAPCS64. -(defun classify-struct-aapcs64 (record-type) +(defun classify-struct (record-type) "Classify struct for ARM64 AAPCS64 return." (let* ((bits (sb-alien::alien-type-bits record-type)) (byte-size (ceiling bits 8)) @@ -283,7 +283,7 @@ ;;; Called from src/code/c-call.lisp (defun record-result-tn (type state) "Handle struct return values." - (let ((classification (classify-struct-aapcs64 type))) + (let ((classification (classify-struct type))) (if (sb-alien::struct-classification-memory-p classification) ;; Large struct: return via hidden pointer in x8 ;; The caller allocates space and passes pointer in x8 @@ -323,7 +323,7 @@ "Handle struct arguments. For large structs (>16 bytes), returns a SAP TN for pointer passing. For small structs, returns a function that emits load VOPs." - (let ((classification (classify-struct-aapcs64 type))) + (let ((classification (classify-struct type))) (if (sb-alien::struct-classification-memory-p classification) ;; Large struct: pass by pointer (int-arg state 'system-area-pointer sap-reg-sc-number sap-stack-sc-number) @@ -394,7 +394,7 @@ ;; We just return a flag indicating this is a large struct return (large-struct-return-p (when (sb-alien::alien-record-type-p result-type) - (let ((classification (classify-struct-aapcs64 result-type))) + (let ((classification (classify-struct result-type))) (sb-alien::struct-classification-memory-p classification))))) (values (make-normal-tn *fixnum-primitive-type*) stack-frame-size @@ -568,7 +568,7 @@ ;; Check for struct return type and classify it (let* ((result-classification (when (alien-record-type-p result-type) - (classify-struct-aapcs64 result-type))) + (classify-struct result-type))) (large-struct-return-p (and result-classification (sb-alien::struct-classification-memory-p result-classification)))) @@ -678,7 +678,7 @@ ((sb-alien::alien-record-type-p type) (let* ((struct-bytes (argument-byte-size type)) (struct-bytes-aligned (round-up-to-word struct-bytes)) - (classification (classify-struct-aapcs64 type)) + (classification (classify-struct type)) ;; Use r11 as additional temp for struct pointer (ptr-tn (make-tn 11))) (cond diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp index 962d46600..975656a0e 100644 --- a/src/compiler/x86-64/c-call.lisp +++ b/src/compiler/x86-64/c-call.lisp @@ -125,9 +125,9 @@ ;;;; Struct Return-by-Value Support (System V AMD64 ABI) -;;; Classify a single field -(defun classify-field-x86-64 (type) - "Classify a single field type for x86-64 ABI. +#-win32 +(defun classify-field-sysv-amd64 (type) + "Classify a single field type for SysV AMD64 ABI. Returns :INTEGER, :DOUBLE, or :MEMORY." (cond ;; Check specific types first, before general type checks @@ -138,10 +138,10 @@ ;; 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-x86-64 element-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-sysv-amd64 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 @@ -154,6 +154,7 @@ (t :memory))) ;;; Merge two classes within an eightbyte per ABI rules +#-win32 (defun merge-classes (class1 class2) "Merge two classes within an eightbyte per ABI rules. INTEGER dominates SSE; MEMORY dominates everything." @@ -166,7 +167,8 @@ (t :double))) ;;; Main classification function for x86-64 System V AMD64 ABI -(defun classify-struct-sysv-amd64 (record-type) +#-win32 +(defun classify-struct (record-type) "Classify struct for x86-64 System V ABI return. Returns STRUCT-CLASSIFICATION." (let* ((bits (sb-alien::alien-type-bits record-type)) @@ -174,7 +176,7 @@ (alignment (sb-alien::alien-type-alignment record-type))) ;; Rule: Structs > 16 bytes always use memory (hidden pointer) (when (> byte-size 16) - (return-from classify-struct-sysv-amd64 + (return-from classify-struct (sb-alien::make-struct-classification :register-slots '(:memory) :size byte-size @@ -191,7 +193,7 @@ (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-x86-64 field-type))) + (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) @@ -215,26 +217,52 @@ :alignment alignment :memory-p (member :memory eightbytes))))) +#+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)) + (byte-size (ceiling bits 8)) + (alignment (sb-alien::alien-type-alignment record-type))) + (if (> byte-size 8) + ;; 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)))) + ;;; Result TN generation for record types ;;; Called from src/code/c-call.lisp + +;;; Windows verison: large struct uses pointer in RAX, otherwise value in RAX + +#+win32 +(defun record-result-tn (type state) + "Handle struct return values." + (let ((classification (or *cached-struct-classification* + (classify-struct type)))) + (setf (result-state-num-results state) 1) + (if (sb-alien::struct-classification-memory-p classification) + (make-wired-tn* 'system-area-pointer sap-reg-sc-number rax-offset) + (make-wired-tn* 'unsigned-byte-64 unsigned-reg-sc-number rax-offset)))) + +#-win32 (defun record-result-tn (type state) "Handle struct return values." - ;; Windows x64 uses Microsoft calling convention, not System V AMD64. - ;; To add Windows support: - ;; 1. Implement classify-struct-win64: structs of 1/2/4/8 bytes return in RAX, - ;; larger structs use hidden pointer in RCX (not RDI) - ;; 2. Adapt this function to use the Windows classification - ;; 3. Update make-call-out-tns to reserve RCX instead of RDI for sret pointer - #+win32 (error "Struct-by-value return not implemented for Windows x64 ABI") (let ((classification (or *cached-struct-classification* - (classify-struct-sysv-amd64 type)))) + (classify-struct type)))) (if (sb-alien::struct-classification-memory-p classification) - ;; Large struct: return via hidden pointer - ;; Caller passes pointer in RDI, callee returns it in RAX (progn (setf (result-state-num-results state) 1) (make-wired-tn* 'system-area-pointer sap-reg-sc-number rax-offset)) - ;; Small struct: return in registers (let ((result-tns nil) (int-results 0) (sse-results 0)) @@ -300,20 +328,53 @@ (inst mov :qword temp (ea src-offset sap)) (inst mov :qword (ea dst-offset nsp) temp))) +;;; VOP to move SAP value to integer register (for Windows struct-by-pointer) +(define-vop (load-sap-int-arg) + (:args (sap :scs (sap-reg))) + (:results (target :scs (unsigned-reg))) + (:generator 1 + (move target sap))) + ;;; Arg TN generation for record types ;;; Called from src/code/c-call.lisp + +;;; Windows: structs >8 bytes passed by pointer, <=8 bytes in +;;; integer register. +#+win32 +(defun record-arg-tn (type state) + "Handle struct arguments." + (let ((classification (classify-struct type)) + (arg-tn (int-arg state 'unsigned-byte-64 + unsigned-reg-sc-number unsigned-stack-sc-number))) + (if (sb-alien::struct-classification-memory-p classification) + (lambda (arg call block nsp) + (declare (ignore nsp)) + (let ((sap-tn (sb-c::lvar-tn call block arg))) + (sb-c::emit-and-insert-vop + call block + (sb-c::template-or-lose 'load-sap-int-arg) + (sb-c::reference-tn sap-tn nil) + (sb-c::reference-tn arg-tn t) + nil + nil))) + (lambda (arg call block nsp) + (declare (ignore nsp)) + (sb-c::emit-and-insert-vop + call block + (sb-c::template-or-lose 'load-struct-int-arg) + (sb-c::reference-tn (sb-c::lvar-tn call block arg) nil) + (sb-c::reference-tn arg-tn t) + nil + (list 0)))))) + +;;; System V: structs >16 bytes copied to stack, <=16 bytes in up to 2 +;;; registers. +#-win32 (defun record-arg-tn (type state) "Handle struct arguments. For large structs (>16 bytes), copies to stack per System V AMD64 ABI. For small structs, returns a function that emits load VOPs into registers." - ;; Windows x64 uses Microsoft calling convention, not System V AMD64. - ;; To add Windows support: - ;; 1. Implement classify-struct-win64: structs >8 bytes are passed by pointer - ;; (caller allocates, passes address in integer register) - ;; 2. Structs of 1/2/4/8 bytes are passed in a single integer register - ;; 3. Adapt this function to handle both cases - #+win32 (error "Struct-by-value arguments not implemented for Windows x64 ABI") - (let ((classification (classify-struct-sysv-amd64 type))) + (let ((classification (classify-struct type))) (if (sb-alien::struct-classification-memory-p classification) ;; Large struct: copy to stack (System V AMD64 ABI) ;; The struct is passed by value on the stack, not by pointer @@ -362,26 +423,26 @@ (let ((sap-tn (sb-c::lvar-tn call block arg))) (loop for target-tn in arg-tns for (off . class) in offsets - do (ecase class - (:integer - (sb-c::emit-and-insert-vop - call block - (sb-c::template-or-lose 'load-struct-int-arg) - (sb-c::reference-tn sap-tn nil) - (sb-c::reference-tn target-tn t) - nil ; insert at end - (list off))) - (:double - (sb-c::emit-and-insert-vop - call block - (sb-c::template-or-lose 'load-struct-sse-arg) - (sb-c::reference-tn sap-tn nil) - (sb-c::reference-tn target-tn t) - nil - (list off))))))))))) - -;;; VOP to set up RDI: large structs (>16 bytes) are returned via a hidden pointer. -;;; The caller allocates memory and passes the address in RDI (first arg register) + do (let ((vop (ecase class + (:integer 'load-struct-int-arg) + (:double 'load-struct-sse-arg)))) + (sb-c::emit-and-insert-vop + call block + (sb-c::template-or-lose vop) + (sb-c::reference-tn sap-tn nil) + (sb-c::reference-tn target-tn t) + nil + (list off)))))))))) + +;;; VOP to set up hidden struct return pointer in first arg register. +#+win32 +(define-vop (set-struct-return-pointer) + (:args (sap :scs (sap-reg) :target rcx)) + (:temporary (:sc sap-reg :offset rcx-offset) rcx) + (:generator 1 + (move rcx sap))) + +#-win32 (define-vop (set-struct-return-pointer) (:args (sap :scs (sap-reg) :target rdi)) (:temporary (:sc sap-reg :offset rdi-offset :from (:argument 0)) rdi) ; RDI is the first arg register @@ -391,16 +452,17 @@ (defun make-call-out-tns (type) (let ((arg-state (make-arg-state)) (result-type (alien-fun-type-result-type type))) - ;; Check for large struct return FIRST - we need to reserve RDI for sret pointer + ;; Check for large struct return and reserve first arg register + ;; for sret pointer ;; Cache the classification to avoid recomputing it in record-result-tn (let* ((result-classification (when (alien-record-type-p result-type) - (classify-struct-sysv-amd64 result-type))) + (classify-struct result-type))) (large-struct-return-p (and result-classification (sb-alien::struct-classification-memory-p result-classification)))) - ;; For large struct returns, consume RDI (first int arg register) - ;; so regular arguments start from RSI + ;; For large struct returns, consume first int arg register + ;; so regular arguments start from the second register (when large-struct-return-p (setf (arg-state-register-args arg-state) 1)) (collect ((arg-tns)) @@ -765,16 +827,11 @@ #-sb-xc-host (defun alien-callback-assembler-wrapper (index result-type argument-types) - ;; Windows x64 uses Microsoft calling convention, not System V AMD64. - ;; To add Windows struct-by-value callback support: - ;; 1. Struct arguments >8 bytes: caller passes pointer, not value - ;; 2. Struct arguments 1/2/4/8 bytes: passed in integer register as if integer + ;; Windows x64 struct-by-value callback rules: + ;; 1. Struct arguments >8 bytes: caller passes pointer in register + ;; 2. Struct arguments <=8 bytes: passed in integer register as value ;; 3. Struct returns >8 bytes: hidden pointer in RCX (first arg register) - ;; 4. Struct returns 1/2/4/8 bytes: returned in RAX - #+win32 - (when (or (alien-record-type-p result-type) - (some #'sb-alien::alien-record-type-p argument-types)) - (error "Struct-by-value callbacks not implemented for Windows x64 ABI")) + ;; 4. Struct returns <=8 bytes: returned in RAX (labels ((make-tn-maker (sc-name) (lambda (offset) (make-random-tn (sc-or-lose sc-name) offset))) @@ -786,7 +843,7 @@ ;; Check for struct return type and classify it (let* ((result-classification (when (alien-record-type-p result-type) - (classify-struct-sysv-amd64 result-type))) + (classify-struct result-type))) (large-struct-return-p (and result-classification (sb-alien::struct-classification-memory-p result-classification))) @@ -799,6 +856,7 @@ (rbp rbp-tn) (rsp rsp-tn) #+(and win32 sb-thread) (r8 r8-tn) + #+win32 (r11 r11-tn) ; scratch register for struct copy (not an arg register) (xmm0 float0-tn) #-win32 (xmm1 float1-tn) @@ -813,16 +871,26 @@ (arg-offset 0) ;; Count of 8-byte slots consumed (for stack offset calculation) (arg-slot-count (ceiling total-arg-bytes n-word-bytes)) - ;; For large struct returns, RDI contains the hidden pointer, not an argument - ;; Skip it in the GPR list so arguments start at RSI + ;; For large struct returns, the hidden pointer is in the first arg register + ;; (RCX on Windows, RDI on SysV). Skip it in the GPR list. + ;; On Windows, this also consumes argument slot 0, so skip XMM0 too. (gprs (let ((all-gprs (mapcar (make-tn-maker 'any-reg) *c-call-register-arg-offsets*))) (if large-struct-return-p - (rest all-gprs) ; Skip RDI + (rest all-gprs) ; Skip RCX (win32) or RDI (SysV) all-gprs))) - (fprs (mapcar (make-tn-maker 'double-reg) - ;; Only 8 first XMM registers are used for - ;; passing arguments - (subseq *float-regs* 0 #-win32 8 #+win32 4))) + (fprs (let ((all-fprs (mapcar (make-tn-maker 'double-reg) + ;; Only 8 first XMM registers are used for + ;; passing arguments + (subseq *float-regs* 0 #-win32 8 #+win32 4)))) + ;; On Windows, when there's a hidden return pointer in RCX (slot 0), + ;; the float arguments shift: XMM0 is "consumed" by slot 0, so + ;; actual float args start at XMM1. + #+win32 + (if large-struct-return-p + (rest all-fprs) + all-fprs) + #-win32 + all-fprs)) ;; Calculate return value slot count (in 8-byte words) ;; For large struct returns, we need enough space for the entire struct ;; For small structs and primitives, 2 slots (16 bytes) is enough @@ -834,16 +902,16 @@ (return-slot-count-aligned (if (evenp (+ arg-slot-count return-slot-count (if large-struct-return-p - 1 ;; rdi saved on the stack + 1 ;; hidden pointer register saved on the stack 0))) return-slot-count (1+ return-slot-count)))) (assemble (segment 'nil) - ;; For large struct returns, save the hidden pointer (in RDI) - ;; before we use RDI for anything else - #-win32 + ;; For large struct returns, save the hidden pointer before using it + ;; Windows: RCX (first arg register), SysV: RDI (first arg register) (when large-struct-return-p - (inst push rdi)) + #+win32 (inst push rcx) + #-win32 (inst push rdi)) ;; Make room on the stack for argument vector. (when (plusp total-arg-bytes) (inst sub rsp total-arg-bytes)) @@ -860,7 +928,37 @@ (cond ;; Struct types ((sb-alien::alien-record-type-p type) - (let* ((classification (classify-struct-sysv-amd64 type)) + #+win32 + (let* ((classification (classify-struct type)) + (memory-p (sb-alien::struct-classification-memory-p classification)) + (struct-size (sb-alien::struct-classification-size classification))) + (cond + ;; Large struct: pointer passed in register + (memory-p + (let ((gpr (pop gprs))) + (pop fprs) ; Windows: consume paired FPR slot + (unless gpr + (incf stack-argument-count) + (setf gpr rax) + (inst mov gpr stack-arg-tn)) + ;; gpr now contains pointer to struct; copy struct data to arg vector + ;; Use r11 as scratch (not an arg register) to avoid clobbering other args + (let ((num-words (ceiling struct-size n-word-bytes))) + (loop for i from 0 below num-words + for dst-off from arg-offset by n-word-bytes + do (inst mov r11 (ea (* i n-word-bytes) gpr)) + (inst mov (ea dst-off rsp) r11))))) + ;; Small struct: single integer register + (t + (let ((gpr (pop gprs))) + (pop fprs) + (unless gpr + (incf stack-argument-count) + (setf gpr rax) + (inst mov gpr stack-arg-tn)) + (inst mov (ea arg-offset rsp) gpr))))) + #-win32 + (let* ((classification (classify-struct type)) (memory-p (sb-alien::struct-classification-memory-p classification)) (slots (sb-alien::struct-classification-register-slots classification)) (struct-size (sb-alien::struct-classification-size classification))) @@ -885,7 +983,6 @@ do (ecase class (:integer (let ((gpr (pop gprs))) - #+win32 (pop fprs) (unless gpr (incf stack-argument-count) (setf gpr rax) @@ -894,7 +991,6 @@ (inst mov (ea slot-offset rsp) gpr))) (:double (let ((fpr (pop fprs))) - #+win32 (pop gprs) (cond (fpr (inst movq (ea slot-offset rsp) fpr)) (t @@ -1001,17 +1097,30 @@ ((alien-void-type-p result-type)) ;; Struct return types ((alien-record-type-p result-type) - #-win32 + #+win32 + ;; Windows: large structs via hidden pointer (from RCX), small structs in RAX (cond ;; Large struct: copy result to hidden pointer location, return pointer (large-struct-return-p (let ((struct-size (sb-alien::struct-classification-size result-classification))) - ;; Return the hidden pointer in RAX + ;; Retrieve saved hidden pointer (was pushed at start from RCX) (inst mov rax (ea (* (+ arg-slot-count return-slot-count-aligned) n-word-bytes) rsp)) ;; Copy struct data from stack to hidden pointer destination (loop for off from 0 below struct-size by 8 do (inst mov rdx (ea off rsp)) (inst mov (ea off rax) rdx)))) + ;; Small struct (<=8 bytes): just load into RAX + (t + (inst mov rax [rsp]))) + #-win32 + ;; SysV: large structs via hidden pointer (from RDI), small structs in RAX/RDX/XMM0/XMM1 + (cond + (large-struct-return-p + (let ((struct-size (sb-alien::struct-classification-size result-classification))) + (inst mov rax (ea (* (+ arg-slot-count return-slot-count-aligned) n-word-bytes) rsp)) + (loop for off from 0 below struct-size by 8 + do (inst mov rdx (ea off rsp)) + (inst mov (ea off rax) rdx)))) ;; Small struct: copy to registers based on classification (t (let ((slots (sb-alien::struct-classification-register-slots result-classification)) diff --git a/tests/alien-struct-by-value.impure.lisp b/tests/alien-struct-by-value.impure.lisp index bde30c4fc..8799a611a 100644 --- a/tests/alien-struct-by-value.impure.lisp +++ b/tests/alien-struct-by-value.impure.lisp @@ -12,7 +12,7 @@ ;;;; absolutely no warranty. See the COPYING and CREDITS files for ;;;; more information. -#-(or (and x86-64 (not win32)) arm64) (invoke-restart 'run-tests::skip-file) +#-(or x86-64 arm64) (invoke-restart 'run-tests::skip-file) ;;; Compile and load shared library -- 2.50.1 (Apple Git-155)