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) (inst clc) (inst ret)
BIGNUM BIGNUM
(inst shrd rax x n-fixnum-tag-bits) ; high bits from edx (inst shrd rax rdx-tn n-fixnum-tag-bits) ; high bits from edx
(inst sar x n-fixnum-tag-bits) ; now shift edx too (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 cqo) ; edx:eax <- sign-extend of eax
(inst cmp x rcx) (inst cmp rdx-tn rcx)
(inst jmp :e SINGLE-WORD-BIGNUM) (inst jmp :e SINGLE-WORD-BIGNUM)
(emit-alloc-other nil thread-tn bignum-widetag (+ bignum-digits-offset 2) res) (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 start (any-reg descriptor-reg) (:lisp-reg 1))
(:arg end (any-reg descriptor-reg) rcx-offset) (:arg end (any-reg descriptor-reg) rcx-offset)
(:res res (descriptor-reg) (:lisp-reg 0)) (: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 ;; storage class doesn't matter since all float regs
;; and sse regs map to the same storage base. ;; and sse regs map to the same storage base.
(:temp wordpair double-reg 0)) (:temp wordpair double-reg 0))
@ -100,8 +100,11 @@
(inst jmp unroll) (inst jmp unroll)
(inst shr count n-fixnum-tag-bits) (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 rep)
(inst stos :qword) (inst stos :qword)
(move rdi-tn scratch) ; restore the return value
DONE DONE
(inst ret) (inst ret)
UNROLL UNROLL

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

@ -27,8 +27,9 @@
;; These we need as temporaries. ;; These we need as temporaries.
(:temp rax unsigned-reg rax-offset) (:temp rax unsigned-reg rax-offset)
(:temp rbx unsigned-reg rbx-offset) (:temp rbx unsigned-reg rbx-offset)
(:temp rdx unsigned-reg rdx-offset) (:temp a0 unsigned-reg (:lisp-reg 0))
(:temp rdi unsigned-reg rdi-offset) (:temp a1 unsigned-reg (:lisp-reg 1))
(:temp a2 unsigned-reg (:lisp-reg 2))
(:temp temp unsigned-reg r8-offset) (:temp temp unsigned-reg r8-offset)
(:temp loop-index unsigned-reg r9-offset)) (:temp loop-index unsigned-reg r9-offset))
@ -46,7 +47,7 @@
;; Save the count, the return address and restore the frame pointer, ;; Save the count, the return address and restore the frame pointer,
;; because the loop is going to destroy them. ;; 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 rax (ea (frame-byte-offset return-pc-save-offset) rbp-tn))
(inst mov rbp-tn (ea (frame-byte-offset ocfp-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 ;; 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 temp (ea rsi loop-index))
(inst mov (ea rbx loop-index) temp) (inst mov (ea rbx loop-index) temp)
(inst sub rdx (fixnumize 1)) (inst sub a2 (fixnumize 1))
(inst jmp :nz LOOP) (inst jmp :nz LOOP)
;; Set the stack top to the last result. ;; Set the stack top to the last result.
(inst lea rsp-tn (ea rbx loop-index)) (inst lea rsp-tn (ea rbx loop-index))
;; Load the register args. ;; Load the register args.
(loadw rdx rbx -1) (loadw a0 rbx -1)
(loadw rdi rbx -2) (loadw a1 rbx -2)
(loadw rsi rbx -3) (loadw a2 rbx -3)
;; And back we go. ;; And back we go.
(emit-mv-return rax t) (emit-mv-return rax t)
@ -77,9 +78,9 @@
;; Handle the register arg cases. ;; Handle the register arg cases.
ZERO-VALUES ZERO-VALUES
(inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn)) (inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn))
(inst mov rdx null-tn) (inst mov a0 null-tn)
(inst mov rdi null-tn) (inst mov a1 null-tn)
(inst mov rsi null-tn) (inst mov a2 null-tn)
(inst stc) (inst stc)
(inst leave) (inst leave)
(inst ret) (inst ret)
@ -87,25 +88,25 @@
;; Note: we can get this, because the return-multiple vop doesn't ;; Note: we can get this, because the return-multiple vop doesn't
;; check for this case when size > speed. ;; check for this case when size > speed.
ONE-VALUE ONE-VALUE
(loadw rdx rsi -1) (loadw a0 rsi -1)
(inst clc) (inst clc)
(inst leave) (inst leave)
(inst ret) (inst ret)
TWO-VALUES TWO-VALUES
(inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn)) (inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn))
(loadw rdx rsi -1) (loadw a0 rsi -1)
(loadw rdi rsi -2) (inst mov a2 null-tn)
(inst mov rsi null-tn) (loadw a1 rsi -2)
(inst stc) (inst stc)
(inst leave) (inst leave)
(inst ret) (inst ret)
THREE-VALUES THREE-VALUES
(inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn)) (inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn))
(loadw rdx rsi -1) (loadw a0 rsi -1)
(loadw rdi rsi -2) (loadw a2 rsi -3)
(loadw rsi rsi -3) (loadw a1 rsi -2)
(inst stc) (inst stc)
(inst leave) (inst leave)
(inst ret)) (inst ret))
@ -123,12 +124,12 @@
;;; we actually called. We also have to compute RCX from the difference ;;; we actually called. We also have to compute RCX from the difference
;;; between RSI and the stack top. ;;; between RSI and the stack top.
#-sb-assembling ; avoid "Redefinition" warning (this file is processed twice) #-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 r8 r9 r10
&optional jump-to-the-end) &optional jump-to-the-end)
(assemble () (assemble ()
;; Calculate NARGS (as a fixnum) ;; Calculate NARGS (as a fixnum)
(move nargs rsi) (move nargs rsi-tn)
(inst sub nargs rsp-tn) (inst sub nargs rsp-tn)
(inst shr nargs (- word-shift n-fixnum-tag-bits)) (inst shr nargs (- word-shift n-fixnum-tag-bits))
@ -136,12 +137,12 @@
(inst cmp nargs (fixnumize register-arg-count)) (inst cmp nargs (fixnumize register-arg-count))
(inst jmp :le REGISTER-ARGS) (inst jmp :le REGISTER-ARGS)
(inst mov r8 rsi) (inst mov r8 rsi-tn)
;; Register args ;; Register args
(loadw rdx rsi -1) (loadw a0 r8 -1)
(loadw rdi rsi -2) (loadw a1 r8 -2)
(loadw rsi rsi -3) (loadw a2 r8 -3)
;; Do the blit. Because we are coping from smaller addresses to ;; Do the blit. Because we are coping from smaller addresses to
;; larger addresses, we have to start at the largest pair and work ;; 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. ;; All the arguments fit in registers, so load them.
REGISTER-ARGS REGISTER-ARGS
(loadw rdx rsi -1) (loadw a0 rsi-tn -1)
(loadw rdi rsi -2) (loadw a2 rsi-tn -3)
(loadw rsi rsi -3) (loadw a1 rsi-tn -2)
;; Clear most of the stack. ;; Clear most of the stack.
(inst lea rsp-tn (ea (* (- sp->fp-offset 3) n-word-bytes) rbp-tn)) (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 fun unsigned-reg rax-offset)
(:temp temp unsigned-reg rbx-offset) (:temp temp unsigned-reg rbx-offset)
(:temp nargs unsigned-reg rcx-offset) (:temp nargs unsigned-reg rcx-offset)
(:temp rdx unsigned-reg rdx-offset) (:temp a0 unsigned-reg (:lisp-reg 0))
(:temp rdi unsigned-reg rdi-offset) (:temp a1 unsigned-reg (:lisp-reg 1))
(:temp rsi unsigned-reg rsi-offset) (:temp a2 unsigned-reg (:lisp-reg 2))
(:temp r8 unsigned-reg r8-offset) (:temp r8 unsigned-reg r8-offset)
(:temp r9 unsigned-reg r9-offset) (:temp r9 unsigned-reg r9-offset)
(:temp r10 unsigned-reg r10-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))) (inst jmp (object-slot-ea fun closure-fun-slot fun-pointer-lowtag)))
@ -204,13 +205,13 @@
((:temp fun unsigned-reg rax-offset) ((:temp fun unsigned-reg rax-offset)
(:temp temp unsigned-reg rbx-offset) (:temp temp unsigned-reg rbx-offset)
(:temp nargs unsigned-reg rcx-offset) (:temp nargs unsigned-reg rcx-offset)
(:temp rdx unsigned-reg rdx-offset) (:temp a0 unsigned-reg (:lisp-reg 0))
(:temp rdi unsigned-reg rdi-offset) (:temp a1 unsigned-reg (:lisp-reg 1))
(:temp rsi unsigned-reg rsi-offset) (:temp a2 unsigned-reg (:lisp-reg 2))
(:temp r8 unsigned-reg r8-offset) (:temp r8 unsigned-reg r8-offset)
(:temp r9 unsigned-reg r9-offset) (:temp r9 unsigned-reg r9-offset)
(:temp r10 unsigned-reg r10-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) (%lea-for-lowtag-test rbx-tn fun fun-pointer-lowtag)
(inst test :byte rbx-tn lowtag-mask) (inst test :byte rbx-tn lowtag-mask)
@ -368,7 +369,7 @@
((:arg x (descriptor-reg) (:lisp-reg 0)) ((:arg x (descriptor-reg) (:lisp-reg 0))
(:res r (descriptor-reg) (:lisp-reg 0))) (:res r (descriptor-reg) (:lisp-reg 0)))
(progn x r) (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))) (call-lisp-fun 'update-object-layout 1 nil)))
(define-assembly-routine (sb-impl:install-hash-table-lock (define-assembly-routine (sb-impl:install-hash-table-lock
@ -378,7 +379,7 @@
((:arg x (descriptor-reg) (:lisp-reg 0)) ((:arg x (descriptor-reg) (:lisp-reg 0))
(:res r (descriptor-reg) (:lisp-reg 0))) (:res r (descriptor-reg) (:lisp-reg 0)))
(progn x r) (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))) (call-lisp-fun 'sb-impl:install-hash-table-lock 1)))
(define-assembly-routine (define-assembly-routine
@ -386,9 +387,9 @@
((:arg list descriptor-reg rax-offset) ((:arg list descriptor-reg rax-offset)
(:temp rbx unsigned-reg rbx-offset) (:temp rbx unsigned-reg rbx-offset)
(:temp rdx unsigned-reg rdx-offset) (:temp a0 unsigned-reg (:lisp-reg 0))
(:temp rdi unsigned-reg rdi-offset) (:temp a1 unsigned-reg (:lisp-reg 1))
(:temp rsi unsigned-reg rsi-offset) (:temp a2 unsigned-reg (:lisp-reg 2))
(:temp count unsigned-reg rcx-offset) (:temp count unsigned-reg rcx-offset)
(:temp temp unsigned-reg r9-offset) (:temp temp unsigned-reg r9-offset)
(:temp return unsigned-reg r10-offset)) (:temp return unsigned-reg r10-offset))
@ -404,7 +405,7 @@
(inst cmp list null) (inst cmp list null)
(inst jmp :e ZERO-VALUES) (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) (loadw list list cons-cdr-slot list-pointer-lowtag)
(inst cmp list null) (inst cmp list null)
(inst jmp :ne CONTINUE) (inst jmp :ne CONTINUE)
@ -417,14 +418,14 @@
(check ONE-VALUE) (check ONE-VALUE)
(inst mov count (fixnumize 2)) (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) (loadw list list cons-cdr-slot list-pointer-lowtag)
(inst cmp list null) (inst cmp list null)
(inst jmp :e TWO-VALUES) (inst jmp :e TWO-VALUES)
(check TWO-VALUES) (check TWO-VALUES)
(inst mov count (fixnumize 3)) (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) (loadw list list cons-cdr-slot list-pointer-lowtag)
(inst cmp list null) (inst cmp list null)
(inst jmp :e THREE-VALUES) (inst jmp :e THREE-VALUES)
@ -453,11 +454,11 @@
(cerror-call nil 'bogus-arg-to-values-list-error list) (cerror-call nil 'bogus-arg-to-values-list-error list)
ZERO-VALUES ZERO-VALUES
(zeroize count) (zeroize count)
(inst mov rdx null) (inst mov a0 null)
(inst mov rdi null) (inst mov a1 null)
TWO-VALUES TWO-VALUES
(inst mov rsi null) (inst mov a2 null)
THREE-VALUES THREE-VALUES
(inst lea rbx (ea (* sp->fp-offset n-word-bytes) rbp-tn)) (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) (do-fprs push :xmm)
(inst ret) (inst ret)
HAVE-YMM HAVE-YMM
;; Although most of the time RDX can be clobbered, some of the time it can't. ;; This routine preserves RDX because when calling from Lisp into C on #+win32
;; If WITH-REGISTERS-PRESERVED wraps a lisp function to make it appear to preserve ;; where the 2nd ABI-specified arg-passing register is RDX, it might be an outgoing
;; all registers, we obviously need to return its primary value in RDX. ;; argument that we have not stashed away safely yet.
;; RAX need not be saved though.
(inst push rdx-tn) (inst push rdx-tn)
(zeroize rdx-tn) (zeroize rdx-tn)
;; After PUSH the save area is at RSP+16 with the return-PC at [RSP+8] ;; After PUSH the save area is at RSP+16 with the return-PC at [RSP+8]
@ -99,19 +98,16 @@
(do-fprs pop :xmm) (do-fprs pop :xmm)
(inst ret) (inst ret)
HAVE-YMM HAVE-YMM
(inst push rdx-tn) ;; We can freely clobber RDX and RAX because the surrounding code - namely that
(inst mov rax-tn 7) ; OK to clobber RAX ;; which invoked FPR-RESTORE - will restore all GPRs upon return from this.
(inst mov rax-tn 7)
(zeroize rdx-tn) (zeroize rdx-tn)
(inst xrstor (ea 16 rsp-tn)) (inst xrstor (ea 8 rsp-tn))))
(inst pop rdx-tn)))
;; Caller will have allocated xsave-avx512-area-size bytes above the stack-pointer ;; Caller will have allocated xsave-avx512-area-size bytes above the stack-pointer
;; prior to the CALL. Use that as the save area. ;; 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) () (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) (inst push rdx-tn)
(zeroize rdx-tn) (zeroize rdx-tn)
;; After PUSH the save area is at RSP+16 with the return-PC at [RSP+8] ;; After PUSH the save area is at RSP+16 with the return-PC at [RSP+8]
@ -126,11 +122,9 @@
(inst pop rdx-tn)) (inst pop rdx-tn))
(define-assembly-routine (fpr-restore-avx512) () (define-assembly-routine (fpr-restore-avx512) ()
(inst push rdx-tn) (inst mov rax-tn #xE7) ; OK to clobber RAX and RDX
(inst mov rax-tn #xE7) ; OK to clobber RAX
(zeroize rdx-tn) (zeroize rdx-tn)
(inst xrstor (ea 16 rsp-tn)) (inst xrstor (ea 8 rsp-tn)))
(inst pop rdx-tn))
(define-assembly-routine (switch-to-arena (:return-style :raw)) () (define-assembly-routine (switch-to-arena (:return-style :raw)) ()
;; RSI and RDI are vop temps, so don't bother preserving them ;; 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))) (let ((save (list rbx-tn r12-tn r13-tn r14-tn r15-tn)))
(dolist (reg save) (inst push reg)) (dolist (reg save) (inst push reg))
;; count of bytes or elements (always at RBP+16) into 2nd arg ;; 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) (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))) (dolist (reg (reverse save)) (inst pop reg)))
(emit-begin-pseudo-atomic)) (emit-begin-pseudo-atomic))
@ -174,9 +168,9 @@
`(progn (inst test rax-tn rax-tn) `(progn (inst test rax-tn rax-tn)
(inst jmp :nz SUCCESS) (inst jmp :nz SUCCESS)
,(ecase units ,(ecase units
(:list-elts '(zeroize rdx-tn)) (:list-elts `(zeroize ,(first *register-arg-tns*)))
(:bytes-non-list '(inst mov rdx-tn (fixnumize 1))) (:bytes-non-list `(inst mov ,(first *register-arg-tns*) (fixnumize 1)))
(:bytes-list '(inst mov rdx-tn (fixnumize 2)))) (:bytes-list `(inst mov ,(first *register-arg-tns*) (fixnumize 2))))
(inst call (make-fixup 'handle-arena-request :assembly-routine)) (inst call (make-fixup 'handle-arena-request :assembly-routine))
;; if an oversized object which the predicate determined should be allocated ;; if an oversized object which the predicate determined should be allocated
;; then it was in fact already allocated, and its address is in rax. ;; 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 #-sb-thread
(progn (progn
;; arg0 to ENTER-ALIEN-CALLBACK (trampoline index) ;; 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) ;; arg1 to ENTER-ALIEN-CALLBACK (pointer to argument vector)
(inst mov rdi rsp) (inst mov rsi rsp)
;; add room on stack for return value ;; add room on stack for return value
(inst sub rsp (* return-slot-count-aligned n-word-bytes)) (inst sub rsp (* return-slot-count-aligned n-word-bytes))
;; arg2 to ENTER-ALIEN-CALLBACK (pointer to return value) ;; arg2 to ENTER-ALIEN-CALLBACK (pointer to return value)
(inst mov rsi rsp) (inst mov rdx rsp)
;; Make new frame ;; Make new frame
(inst push rbp) (inst push rbp)

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

@ -143,7 +143,7 @@
(inst cmp count (fixnumize i)) (inst cmp count (fixnumize i))
(inst jmp :le default-lab) (inst jmp :le default-lab)
(when first-stack-arg-p (when first-stack-arg-p
(storew rdx-tn rbx-tn -1)) (storew (first *register-arg-tns*) rbx-tn -1))
(sc-case tn (sc-case tn
((descriptor-reg any-reg) ((descriptor-reg any-reg)
(loadw tn start (frame-word-offset (+ sp->fp-offset i)))) (loadw tn start (frame-word-offset (+ sp->fp-offset i))))
@ -157,7 +157,7 @@
(dolist (default (defaults)) (dolist (default (defaults))
(emit-label (car default)) (emit-label (car default))
(when (cddr default) (when (cddr default)
(inst push rdx-tn)) (inst push (first *register-arg-tns*)))
(inst mov (second default) null-tn)) (inst mov (second default) null-tn))
(inst jmp defaulting-done)))))) (inst jmp defaulting-done))))))
(inst mov rsp-tn sp))) (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 ;; the number of arguments/return values passed in registers
(defconstant register-arg-count 3) (defconstant register-arg-count 3)
;; names and offsets for registers used to pass arguments ;; names and offsets for registers used to pass arguments
(defconstant-eqx register-arg-names '(rdx rdi rsi) #'equal) (defconstant-eqx register-arg-names '(rdi rsi rdx) #'equal)
(defregset *register-arg-offsets* rdx rdi rsi) (defregset *register-arg-offsets* rdi rsi rdx)
#-win32 #-win32
(defregset *c-call-register-arg-offsets* rdi rsi rdx rcx r8 r9) (defregset *c-call-register-arg-offsets* rdi rsi rdx rcx r8 r9)
#+win32 #+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) #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) struct thread* thread)
__attribute__((sysv_abi)); __attribute__((sysv_abi));
#endif #endif
@ -814,7 +814,7 @@ callback_wrapper_trampoline(lispobj arg0, lispobj arg1, lispobj arg2)
WITH_GC_AT_SAFEPOINTS_ONLY() WITH_GC_AT_SAFEPOINTS_ONLY()
{ {
#if defined(LISP_FEATURE_X86_64) && !defined(LISP_FEATURE_WIN32) #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 #else
funcall3(StaticSymbolFunction(ENTER_ALIEN_CALLBACK), arg0,arg1,arg2); funcall3(StaticSymbolFunction(ENTER_ALIEN_CALLBACK), arg0,arg1,arg2);
#endif #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" #define VECTOR_FILL_T "VECTOR-FILL/T"
static const int vector_fill_offset_to_check = 0x59; static const int vector_fill_offset_to_check = 0x58;
static const int vector_fill_offset_to_poke = 0x60; static const int vector_fill_offset_to_poke = 0x5F;
static const unsigned char vector_fill_expect_bytes[] = { static const unsigned char vector_fill_expect_bytes[] = {
0x48, 0x81, 0xF9, 0xBC, 0x02, 0x00, 0x00, 0x48, 0x81, 0xF9, 0xBC, 0x02, 0x00, 0x00,
0xEB, 0x07 0xEB, 0x10
}; };
// Poke in a byte that changes an opcode to enable faster vector fill. // 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 cmp $1,%rcx
je Lone je Lone
jl Lzero jl Lzero
mov 16(%rbx),%rsi # arg2 mov 16(%rbx),%rdx # arg2
Ltwo: mov 8(%rbx),%rdi # arg1 Ltwo: mov 8(%rbx),%rsi # arg1
Lone: mov 0(%rbx),%rdx # arg0 Lone: mov 0(%rbx),%rdi # arg0
Lzero: Lzero:
shl $(N_FIXNUM_TAG_BITS),%rcx # (fixnumize num-args) shl $(N_FIXNUM_TAG_BITS),%rcx # (fixnumize num-args)
@ -230,7 +230,7 @@ LsingleValue:
/* FIXME Restore the NPX state. */ /* FIXME Restore the NPX state. */
mov %rdx,%rax # c-val mov %rdi,%rax # c-val
#ifdef SUPPORT_FOMIT_FRAME_POINTER #ifdef SUPPORT_FOMIT_FRAME_POINTER
mov %r15,%rbp # orig rbp mov %r15,%rbp # orig rbp
pop %r15 # orig r15 pop %r15 # orig r15
@ -247,9 +247,9 @@ LsingleValue:
.align align_16byte,0x90 .align align_16byte,0x90
GNAME(funcall_alien_callback): GNAME(funcall_alien_callback):
/* Specialized call_into_lisp for callbacks /* Specialized call_into_lisp for callbacks
rdi arg1 rdi arg0
rsi arg2 rsi arg1
rdx arg0 rdx arg2
rcx thread #+sb-thread rcx thread #+sb-thread
*/ */
@ -308,8 +308,8 @@ GNAME(fun_end_breakpoint_guts):
mov %rsp,%rbx # Setup ebx - the ofp. mov %rsp,%rbx # Setup ebx - the ofp.
sub $8,%rsp # Allocate one stack slot for the return value 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 $(1 << N_FIXNUM_TAG_BITS),%rcx # Setup ecx for one return value.
mov reg_NULL,%rdi # default second value mov reg_NULL,%rsi # default second value
mov reg_NULL,%rsi # default third value mov reg_NULL,%rdx # default third value
multiple_value_return: multiple_value_return:
.globl GNAME(fun_end_breakpoint_trap) .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) (with-test (:name :char-code-is-single-shr)
(assert-thereis-line '(lambda (x) (char-code (truly-the character x))) (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)) (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 ;; to make this pass on different configurations we'd have to add