common-lisp/sbcl.sbcl
1
0
Fork 0
mirror of git://git.code.sf.net/p/sbcl/sbcl synced 2026-09-10 07:26:40 -04:00
Code Issues Actions 8 Packages Projects Releases Wiki Activity

x86-64: Permute Lisp arg-passing registers

Browse source 
Lisp and C are new identical for #+unix though not #+win32

Co-authored by Gemini
This commit is contained in:
Douglas Katzman 2026-08-22 12:33:44 -04:00
parent bd76fc4481
commit 0383982d88
11 changed files with 91 additions and 93 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
src/assembly/x86-64/arith.lisp
View file

@ -102,12 +102,12 @@
(inst clc) (inst ret)
BIGNUM
(inst shrd rax x n-fixnum-tag-bits) ; high bits from edx
(inst sar x n-fixnum-tag-bits) ; now shift edx too
(inst shrd rax rdx-tn n-fixnum-tag-bits) ; high bits from edx
(inst sar rdx-tn n-fixnum-tag-bits) ; now shift edx too
(move rcx x) ; save high bits from cqo
(move rcx rdx-tn) ; save high bits from cqo
(inst cqo) ; edx:eax <- sign-extend of eax
(inst cmp x rcx)
(inst cmp rdx-tn rcx)
(inst jmp :e SINGLE-WORD-BIGNUM)
(emit-alloc-other nil thread-tn bignum-widetag (+ bignum-digits-offset 2) res)

5
src/assembly/x86-64/array.lisp
View file

@ -30,7 +30,7 @@
(:arg start (any-reg descriptor-reg) (:lisp-reg 1))
(:arg end (any-reg descriptor-reg) rcx-offset)
(:res res (descriptor-reg) (:lisp-reg 0))
(:temp scratch unsigned-reg rsi-offset)
(:temp scratch unsigned-reg rbx-offset)
;; storage class doesn't matter since all float regs
;; and sse regs map to the same storage base.
(:temp wordpair double-reg 0))
@ -100,8 +100,11 @@
(inst jmp unroll)
(inst shr count n-fixnum-tag-bits)
(move scratch vector) ; save it for the return value
(move rdi-tn start) ; implicit operand to STOS
(inst rep)
(inst stos :qword)
(move rdi-tn scratch) ; restore the return value
DONE
(inst ret)
UNROLL

91
src/assembly/x86-64/assem-rtns.lisp
View file

@ -27,8 +27,9 @@
;; These we need as temporaries.
(:temp rax unsigned-reg rax-offset)
(:temp rbx unsigned-reg rbx-offset)
(:temp rdx unsigned-reg rdx-offset)
(:temp rdi unsigned-reg rdi-offset)
(:temp a0 unsigned-reg (:lisp-reg 0))
(:temp a1 unsigned-reg (:lisp-reg 1))
(:temp a2 unsigned-reg (:lisp-reg 2))
(:temp temp unsigned-reg r8-offset)
(:temp loop-index unsigned-reg r9-offset))
@ -46,7 +47,7 @@
;; Save the count, the return address and restore the frame pointer,
;; because the loop is going to destroy them.
(inst mov rdx rcx)
(inst mov a2 rcx)
(inst mov rax (ea (frame-byte-offset return-pc-save-offset) rbp-tn))
(inst mov rbp-tn (ea (frame-byte-offset ocfp-save-offset) rbp-tn))
;; Blit the values down the stack. Note: there might be overlap, so
@ -60,16 +61,16 @@
(inst mov temp (ea rsi loop-index))
(inst mov (ea rbx loop-index) temp)
(inst sub rdx (fixnumize 1))
(inst sub a2 (fixnumize 1))
(inst jmp :nz LOOP)
;; Set the stack top to the last result.
(inst lea rsp-tn (ea rbx loop-index))
;; Load the register args.
(loadw rdx rbx -1)
(loadw rdi rbx -2)
(loadw rsi rbx -3)
(loadw a0 rbx -1)
(loadw a1 rbx -2)
(loadw a2 rbx -3)
;; And back we go.
(emit-mv-return rax t)
@ -77,9 +78,9 @@
;; Handle the register arg cases.
ZERO-VALUES
(inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn))
(inst mov rdx null-tn)
(inst mov rdi null-tn)
(inst mov rsi null-tn)
(inst mov a0 null-tn)
(inst mov a1 null-tn)
(inst mov a2 null-tn)
(inst stc)
(inst leave)
(inst ret)
@ -87,25 +88,25 @@
;; Note: we can get this, because the return-multiple vop doesn't
;; check for this case when size > speed.
ONE-VALUE
(loadw rdx rsi -1)
(loadw a0 rsi -1)
(inst clc)
(inst leave)
(inst ret)
TWO-VALUES
(inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn))
(loadw rdx rsi -1)
(loadw rdi rsi -2)
(inst mov rsi null-tn)
(loadw a0 rsi -1)
(inst mov a2 null-tn)
(loadw a1 rsi -2)
(inst stc)
(inst leave)
(inst ret)
THREE-VALUES
(inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn))
(loadw rdx rsi -1)
(loadw rdi rsi -2)
(loadw rsi rsi -3)
(loadw a0 rsi -1)
(loadw a2 rsi -3)
(loadw a1 rsi -2)
(inst stc)
(inst leave)
(inst ret))
@ -123,12 +124,12 @@
;;; we actually called. We also have to compute RCX from the difference
;;; between RSI and the stack top.
#-sb-assembling ; avoid "Redefinition" warning (this file is processed twice)
(defun prepare-for-tail-call-variable (fun temp nargs rdx rdi rsi
(defun prepare-for-tail-call-variable (fun temp nargs a0 a1 a2
r8 r9 r10
&optional jump-to-the-end)
(assemble ()
;; Calculate NARGS (as a fixnum)
(move nargs rsi)
(move nargs rsi-tn)
(inst sub nargs rsp-tn)
(inst shr nargs (- word-shift n-fixnum-tag-bits))
@ -136,12 +137,12 @@
(inst cmp nargs (fixnumize register-arg-count))
(inst jmp :le REGISTER-ARGS)
(inst mov r8 rsi)
(inst mov r8 rsi-tn)
;; Register args
(loadw rdx rsi -1)
(loadw rdi rsi -2)
(loadw rsi rsi -3)
(loadw a0 r8 -1)
(loadw a1 r8 -2)
(loadw a2 r8 -3)
;; Do the blit. Because we are coping from smaller addresses to
;; larger addresses, we have to start at the largest pair and work
@ -169,9 +170,9 @@
;; All the arguments fit in registers, so load them.
REGISTER-ARGS
(loadw rdx rsi -1)
(loadw rdi rsi -2)
(loadw rsi rsi -3)
(loadw a0 rsi-tn -1)
(loadw a2 rsi-tn -3)
(loadw a1 rsi-tn -2)
;; Clear most of the stack.
(inst lea rsp-tn (ea (* (- sp->fp-offset 3) n-word-bytes) rbp-tn))
@ -187,13 +188,13 @@
((:temp fun unsigned-reg rax-offset)
(:temp temp unsigned-reg rbx-offset)
(:temp nargs unsigned-reg rcx-offset)
(:temp rdx unsigned-reg rdx-offset)
(:temp rdi unsigned-reg rdi-offset)
(:temp rsi unsigned-reg rsi-offset)
(:temp a0 unsigned-reg (:lisp-reg 0))
(:temp a1 unsigned-reg (:lisp-reg 1))
(:temp a2 unsigned-reg (:lisp-reg 2))
(:temp r8 unsigned-reg r8-offset)
(:temp r9 unsigned-reg r9-offset)
(:temp r10 unsigned-reg r10-offset))
(prepare-for-tail-call-variable fun temp nargs rdx rdi rsi r8 r9 r10)
(prepare-for-tail-call-variable fun temp nargs a0 a1 a2 r8 r9 r10)
(inst jmp (object-slot-ea fun closure-fun-slot fun-pointer-lowtag)))
@ -204,13 +205,13 @@
((:temp fun unsigned-reg rax-offset)
(:temp temp unsigned-reg rbx-offset)
(:temp nargs unsigned-reg rcx-offset)
(:temp rdx unsigned-reg rdx-offset)
(:temp rdi unsigned-reg rdi-offset)
(:temp rsi unsigned-reg rsi-offset)
(:temp a0 unsigned-reg (:lisp-reg 0))
(:temp a1 unsigned-reg (:lisp-reg 1))
(:temp a2 unsigned-reg (:lisp-reg 2))
(:temp r8 unsigned-reg r8-offset)
(:temp r9 unsigned-reg r9-offset)
(:temp r10 unsigned-reg r10-offset))
(prepare-for-tail-call-variable fun temp nargs rdx rdi rsi r8 r9 r10 t)
(prepare-for-tail-call-variable fun temp nargs a0 a1 a2 r8 r9 r10 t)
(%lea-for-lowtag-test rbx-tn fun fun-pointer-lowtag)
(inst test :byte rbx-tn lowtag-mask)
@ -368,7 +369,7 @@
((:arg x (descriptor-reg) (:lisp-reg 0))
(:res r (descriptor-reg) (:lisp-reg 0)))
(progn x r)
(with-registers-preserved (lisp :except rdx)
(with-registers-preserved (lisp :except #.(first register-arg-names))
(call-lisp-fun 'update-object-layout 1 nil)))
(define-assembly-routine (sb-impl:install-hash-table-lock
@ -378,7 +379,7 @@
((:arg x (descriptor-reg) (:lisp-reg 0))
(:res r (descriptor-reg) (:lisp-reg 0)))
(progn x r)
(with-registers-preserved (lisp :except rdx)
(with-registers-preserved (lisp :except #.(first register-arg-names))
(call-lisp-fun 'sb-impl:install-hash-table-lock 1)))
(define-assembly-routine
@ -386,9 +387,9 @@
((:arg list descriptor-reg rax-offset)
(:temp rbx unsigned-reg rbx-offset)
(:temp rdx unsigned-reg rdx-offset)
(:temp rdi unsigned-reg rdi-offset)
(:temp rsi unsigned-reg rsi-offset)
(:temp a0 unsigned-reg (:lisp-reg 0))
(:temp a1 unsigned-reg (:lisp-reg 1))
(:temp a2 unsigned-reg (:lisp-reg 2))
(:temp count unsigned-reg rcx-offset)
(:temp temp unsigned-reg r9-offset)
(:temp return unsigned-reg r10-offset))
@ -404,7 +405,7 @@
(inst cmp list null)
(inst jmp :e ZERO-VALUES)
(loadw rdx list cons-car-slot list-pointer-lowtag)
(loadw a0 list cons-car-slot list-pointer-lowtag)
(loadw list list cons-cdr-slot list-pointer-lowtag)
(inst cmp list null)
(inst jmp :ne CONTINUE)
@ -417,14 +418,14 @@
(check ONE-VALUE)
(inst mov count (fixnumize 2))
(loadw rdi list cons-car-slot list-pointer-lowtag)
(loadw a1 list cons-car-slot list-pointer-lowtag)
(loadw list list cons-cdr-slot list-pointer-lowtag)
(inst cmp list null)
(inst jmp :e TWO-VALUES)
(check TWO-VALUES)
(inst mov count (fixnumize 3))
(loadw rsi list cons-car-slot list-pointer-lowtag)
(loadw a2 list cons-car-slot list-pointer-lowtag)
(loadw list list cons-cdr-slot list-pointer-lowtag)
(inst cmp list null)
(inst jmp :e THREE-VALUES)
@ -453,11 +454,11 @@
(cerror-call nil 'bogus-arg-to-values-list-error list)
ZERO-VALUES
(zeroize count)
(inst mov rdx null)
(inst mov rdi null)
(inst mov a0 null)
(inst mov a1 null)
TWO-VALUES
(inst mov rsi null)
(inst mov a2 null)
THREE-VALUES
(inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn))

36
src/assembly/x86-64/tramps.lisp
View file

@ -79,10 +79,9 @@
(do-fprs push :xmm)
(inst ret)
HAVE-YMM
;; Although most of the time RDX can be clobbered, some of the time it can't.
;; If WITH-REGISTERS-PRESERVED wraps a lisp function to make it appear to preserve
;; all registers, we obviously need to return its primary value in RDX.
;; RAX need not be saved though.
;; This routine preserves RDX because when calling from Lisp into C on #+win32
;; where the 2nd ABI-specified arg-passing register is RDX, it might be an outgoing
;; argument that we have not stashed away safely yet.
(inst push rdx-tn)
(zeroize rdx-tn)
;; After PUSH the save area is at RSP+16 with the return-PC at [RSP+8]
@ -99,19 +98,16 @@
(do-fprs pop :xmm)
(inst ret)
HAVE-YMM
(inst push rdx-tn)
(inst mov rax-tn 7) ; OK to clobber RAX
;; We can freely clobber RDX and RAX because the surrounding code - namely that
;; which invoked FPR-RESTORE - will restore all GPRs upon return from this.
(inst mov rax-tn 7)
(zeroize rdx-tn)
(inst xrstor (ea 16 rsp-tn))
(inst pop rdx-tn)))
(inst xrstor (ea 8 rsp-tn))))
;; Caller will have allocated xsave-avx512-area-size bytes above the stack-pointer
;; prior to the CALL. Use that as the save area.
;; Similar considerations pertain to the use of RAX and RDX as in FPR-SAVE.
(define-assembly-routine (fpr-save-avx512) ()
;; Although most of the time RDX can be clobbered, some of the time it can't.
;; If WITH-REGISTERS-PRESERVED wraps a lisp function to make it appear to preserve
;; all registers, we obviously need to return its primary value in RDX.
;; RAX need not be saved though.
(inst push rdx-tn)
(zeroize rdx-tn)
;; After PUSH the save area is at RSP+16 with the return-PC at [RSP+8]
@ -126,11 +122,9 @@
(inst pop rdx-tn))
(define-assembly-routine (fpr-restore-avx512) ()
(inst push rdx-tn)
(inst mov rax-tn #xE7) ; OK to clobber RAX
(inst mov rax-tn #xE7) ; OK to clobber RAX and RDX
(zeroize rdx-tn)
(inst xrstor (ea 16 rsp-tn))
(inst pop rdx-tn))
(inst xrstor (ea 8 rsp-tn)))
(define-assembly-routine (switch-to-arena (:return-style :raw)) ()
;; RSI and RDI are vop temps, so don't bother preserving them
@ -149,9 +143,9 @@
(let ((save (list rbx-tn r12-tn r13-tn r14-tn r15-tn)))
(dolist (reg save) (inst push reg))
;; count of bytes or elements (always at RBP+16) into 2nd arg
(inst mov rdi-tn (ea 16 rbp-tn))
(inst mov (second *register-arg-tns*) (ea 16 rbp-tn))
(call-lisp-fun 'handle-arena-request 2)
(inst mov rax-tn rdx-tn) ; Lisp result reg into C result reg
(inst mov rax-tn (first *register-arg-tns*)) ; Lisp result reg into C result reg
(dolist (reg (reverse save)) (inst pop reg)))
(emit-begin-pseudo-atomic))
@ -174,9 +168,9 @@
`(progn (inst test rax-tn rax-tn)
(inst jmp :nz SUCCESS)
,(ecase units
(:list-elts '(zeroize rdx-tn))
(:bytes-non-list '(inst mov rdx-tn (fixnumize 1)))
(:bytes-list '(inst mov rdx-tn (fixnumize 2))))
(:list-elts `(zeroize ,(first *register-arg-tns*)))
(:bytes-non-list `(inst mov ,(first *register-arg-tns*) (fixnumize 1)))
(:bytes-list `(inst mov ,(first *register-arg-tns*) (fixnumize 2))))
(inst call (make-fixup 'handle-arena-request :assembly-routine))
;; if an oversized object which the predicate determined should be allocated
;; then it was in fact already allocated, and its address is in rax.

6
src/compiler/x86-64/c-call.lisp
View file

@ -1111,13 +1111,13 @@ Floats are passed in integer registers."
#-sb-thread
(progn
;; arg0 to ENTER-ALIEN-CALLBACK (trampoline index)
(inst mov rdx (fixnumize index))
(inst mov rdi (fixnumize index))
;; arg1 to ENTER-ALIEN-CALLBACK (pointer to argument vector)
(inst mov rdi rsp)
(inst mov rsi rsp)
;; add room on stack for return value
(inst sub rsp (* return-slot-count-aligned n-word-bytes))
;; arg2 to ENTER-ALIEN-CALLBACK (pointer to return value)
(inst mov rsi rsp)
(inst mov rdx rsp)
;; Make new frame
(inst push rbp)

4
src/compiler/x86-64/nlx.lisp
View file

@ -143,7 +143,7 @@
(inst cmp count (fixnumize i))
(inst jmp :le default-lab)
(when first-stack-arg-p
(storew rdx-tn rbx-tn -1))
(storew (first *register-arg-tns*) rbx-tn -1))
(sc-case tn
((descriptor-reg any-reg)
(loadw tn start (frame-word-offset (+ sp->fp-offset i))))
@ -157,7 +157,7 @@
(dolist (default (defaults))
(emit-label (car default))
(when (cddr default)
(inst push rdx-tn))
(inst push (first *register-arg-tns*)))
(inst mov (second default) null-tn))
(inst jmp defaulting-done))))))
(inst mov rsp-tn sp)))

4
src/compiler/x86-64/vm.lisp
View file

@ -171,8 +171,8 @@
;; the number of arguments/return values passed in registers
(defconstant register-arg-count 3)
;; names and offsets for registers used to pass arguments
(defconstant-eqx register-arg-names '(rdx rdi rsi) #'equal)
(defregset *register-arg-offsets* rdx rdi rsi)
(defconstant-eqx register-arg-names '(rdi rsi rdx) #'equal)
(defregset *register-arg-offsets* rdi rsi rdx)
#-win32
(defregset *c-call-register-arg-offsets* rdi rsi rdx rcx r8 r9)
#+win32

4
src/runtime/thread.c
View file

@ -783,7 +783,7 @@ static void detach_os_thread(init_thread_data *scribble)
}
#if defined(LISP_FEATURE_X86_64) && !defined(LISP_FEATURE_WIN32)
extern void funcall_alien_callback(lispobj arg1, lispobj arg2, lispobj arg0,
extern void funcall_alien_callback(lispobj arg0, lispobj arg1, lispobj arg2,
struct thread* thread)
__attribute__((sysv_abi));
#endif
@ -814,7 +814,7 @@ callback_wrapper_trampoline(lispobj arg0, lispobj arg1, lispobj arg2)
WITH_GC_AT_SAFEPOINTS_ONLY()
{
#if defined(LISP_FEATURE_X86_64) && !defined(LISP_FEATURE_WIN32)
funcall_alien_callback(arg1, arg2, arg0, th);
funcall_alien_callback(arg0, arg1, arg2, th);
#else
funcall3(StaticSymbolFunction(ENTER_ALIEN_CALLBACK), arg0,arg1,arg2);
#endif

6
src/runtime/x86-64-arch.c
View file

@ -73,11 +73,11 @@ static void xgetbv(unsigned *eax, unsigned *edx)
}
#define VECTOR_FILL_T "VECTOR-FILL/T"
static const int vector_fill_offset_to_check = 0x59;
static const int vector_fill_offset_to_poke = 0x60;
static const int vector_fill_offset_to_check = 0x58;
static const int vector_fill_offset_to_poke = 0x5F;
static const unsigned char vector_fill_expect_bytes[] = {
0x48, 0x81, 0xF9, 0xBC, 0x02, 0x00, 0x00,
0xEB, 0x07
0xEB, 0x10
};
// Poke in a byte that changes an opcode to enable faster vector fill.

18
src/runtime/x86-64-assem.S
View file

@ -188,9 +188,9 @@ Lstack:
cmp $1,%rcx
je Lone
jl Lzero
mov 16(%rbx),%rsi # arg2
Ltwo: mov 8(%rbx),%rdi # arg1
Lone: mov 0(%rbx),%rdx # arg0
mov 16(%rbx),%rdx # arg2
Ltwo: mov 8(%rbx),%rsi # arg1
Lone: mov 0(%rbx),%rdi # arg0
Lzero:
shl $(N_FIXNUM_TAG_BITS),%rcx # (fixnumize num-args)
@ -230,7 +230,7 @@ LsingleValue:
/* FIXME Restore the NPX state. */
mov %rdx,%rax # c-val
mov %rdi,%rax # c-val
#ifdef SUPPORT_FOMIT_FRAME_POINTER
mov %r15,%rbp # orig rbp
pop %r15 # orig r15
@ -247,9 +247,9 @@ LsingleValue:
.align align_16byte,0x90
GNAME(funcall_alien_callback):
/* Specialized call_into_lisp for callbacks
rdi arg1
rsi arg2
rdx arg0
rdi arg0
rsi arg1
rdx arg2
rcx thread #+sb-thread
*/
@ -308,8 +308,8 @@ GNAME(fun_end_breakpoint_guts):
mov %rsp,%rbx # Setup ebx - the ofp.
sub $8,%rsp # Allocate one stack slot for the return value
mov $(1 << N_FIXNUM_TAG_BITS),%rcx # Setup ecx for one return value.
mov reg_NULL,%rdi # default second value
mov reg_NULL,%rsi # default third value
mov reg_NULL,%rsi # default second value
mov reg_NULL,%rdx # default third value
multiple_value_return:
.globl GNAME(fun_end_breakpoint_trap)

2
tests/x86-64-codegen.impure.lisp
View file

@ -589,7 +589,7 @@
(with-test (:name :char-code-is-single-shr)
(assert-thereis-line '(lambda (x) (char-code (truly-the character x)))
"SHR EDX, 7"))
"SHR EDI, 7"))
(import '(sb-x86-64-asm::get-gpr sb-x86-64-asm::machine-ea))
;; to make this pass on different configurations we'd have to add