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]: Invent syntactic convenience in define-assembly-routine

Browse source 
I want to permute the 3 lisp arg-passing registers to match the machine ABI
and this change makes it less ugly to do so. (Some DEFINE-ALIEN-ROUTINEs
in user code and SBCL itself could potentially emit fewer moves by matching
the ABI but we also will want to tackle a problem of needless spill/restore
of register args by eliminating dead stores)

Other backends don't strictly benefit from this syntax because register
names such as A0,A1 already express exactly what they mean to, whereas x86
register names are alphabet soup in comparison.
This commit is contained in:
Douglas Katzman 2026-08-19 16:26:09 -04:00
parent f5e063c351
commit 5ca456d7fe
6 changed files with 52 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
src/assembly/assemfile.lisp
View file

@ -105,7 +105,11 @@
(car (reg-spec-scs spec))))
(defun parse-reg-spec (kind name sc offset)
(let ((reg (make-reg-spec :kind kind :name name :scs sc :offset offset)))
(let* ((actual-offset
(cond ((and (consp offset) (eq (car offset) :lisp-reg))
(nth (cadr offset) sb-vm::*register-arg-offsets*))
(t offset)))
(reg (make-reg-spec :kind kind :name name :scs sc :offset actual-offset)))
(ecase kind
(:temp)
((:arg :res)

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

@ -45,10 +45,10 @@
(:translate ,fun)
(:policy :safe)
(:save-p t))
((:arg x (descriptor-reg any-reg) rdx-offset)
(:arg y (descriptor-reg any-reg) rdi-offset)
((:arg x (descriptor-reg any-reg) (:lisp-reg 0))
(:arg y (descriptor-reg any-reg) (:lisp-reg 1))
(:res res (descriptor-reg any-reg) rdx-offset)
(:res res (descriptor-reg any-reg) (:lisp-reg 0))
;; + and - can make do with only 1 temp.
;; RCX is always needed for lisp call.
@ -126,8 +126,8 @@
(:policy :safe)
(:translate %negate)
(:save-p t))
((:arg x (descriptor-reg any-reg) rdx-offset)
(:res res (descriptor-reg any-reg) rdx-offset))
((:arg x (descriptor-reg any-reg) (:lisp-reg 0))
(:res res (descriptor-reg any-reg) (:lisp-reg 0)))
(inst test :byte x fixnum-tag-mask)
(inst jmp :nz GENERIC)
(move res x)
@ -154,8 +154,8 @@
(:save-p t)
(:conditional ,test)
(:cost 10))
((:arg x (descriptor-reg any-reg) rdx-offset)
(:arg y (descriptor-reg any-reg) rdi-offset)
((:arg x (descriptor-reg any-reg) (:lisp-reg 0))
(:arg y (descriptor-reg any-reg) (:lisp-reg 1))
(:temp rcx unsigned-reg rcx-offset))
@ -182,8 +182,8 @@
(:save-p t)
(:conditional :e)
(:cost 10))
((:arg x (descriptor-reg any-reg) rdx-offset)
(:arg y (descriptor-reg any-reg) rdi-offset)
((:arg x (descriptor-reg any-reg) (:lisp-reg 0))
(:arg y (descriptor-reg any-reg) (:lisp-reg 1))
(:temp rcx unsigned-reg rcx-offset))
(both-fixnum-p rcx x y)
@ -200,7 +200,7 @@
#+sb-assembling
(define-assembly-routine (logcount)
((:arg arg (descriptor-reg any-reg) rdx-offset)
((:arg arg (descriptor-reg any-reg) (:lisp-reg 0))
(:temp mask unsigned-reg rcx-offset)
(:temp temp unsigned-reg rax-offset))
(inst push temp)
@ -503,8 +503,8 @@
(:conditional :e)
(:cost 10)
(:arg-types (:or integer bignum) *))
((:arg x (descriptor-reg) rdx-offset)
(:arg y (descriptor-reg any-reg) rdi-offset)
((:arg x (descriptor-reg) (:lisp-reg 0))
(:arg y (descriptor-reg any-reg) (:lisp-reg 1))
(:temp rcx unsigned-reg rcx-offset)
(:temp rax unsigned-reg rax-offset))
(inst cmp x y)

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

@ -19,11 +19,11 @@
(define-assembly-routine (vector-fill/t ; <-- this could work on raw bits too
(:translate vector-fill/t)
(:policy :fast-safe))
((:arg vector (descriptor-reg) rdx-offset)
((:arg vector (descriptor-reg) (:lisp-reg 0))
(:arg item (any-reg descriptor-reg) rax-offset)
(:arg start (any-reg descriptor-reg) rdi-offset)
(:arg end (any-reg descriptor-reg) rsi-offset)
(:res res (descriptor-reg) rdx-offset)
(:arg start (any-reg descriptor-reg) (:lisp-reg 1))
(:arg end (any-reg descriptor-reg) (:lisp-reg 2))
(:res res (descriptor-reg) (:lisp-reg 0))
(:temp count unsigned-reg rcx-offset)
(:temp end-card-index unsigned-reg rbx-offset)
;; storage class doesn't matter since all float regs
@ -135,11 +135,11 @@
(:policy :fast-safe)
(:arg-types t positive-fixnum)
(:result-types t positive-fixnum))
((:arg array descriptor-reg rdx-offset)
(:arg index any-reg rdi-offset)
((:arg array descriptor-reg (:lisp-reg 0))
(:arg index any-reg (:lisp-reg 1))
(:temp temp unsigned-reg rcx-offset)
(:res result descriptor-reg rdx-offset)
(:res offset any-reg rdi-offset))
(:res result descriptor-reg (:lisp-reg 0))
(:res offset any-reg (:lisp-reg 1)))
(declare (ignore result offset))
LOOP
(inst mov :byte temp (ea (- other-pointer-lowtag) array))
@ -162,11 +162,11 @@
(:arg-types t positive-fixnum)
(:result-types t positive-fixnum)
(:save-p :compute-only))
((:arg array descriptor-reg rdx-offset)
(:arg index any-reg rdi-offset)
((:arg array descriptor-reg (:lisp-reg 0))
(:arg index any-reg (:lisp-reg 1))
(:temp temp any-reg rcx-offset)
(:res result descriptor-reg rdx-offset)
(:res offset any-reg rdi-offset))
(:res result descriptor-reg (:lisp-reg 0))
(:res offset any-reg (:lisp-reg 1)))
(declare (ignore result offset))
(let ((error (generate-error-code nil 'invalid-array-index-error array temp index)))
(assemble ()
@ -205,10 +205,10 @@
(:result-types t positive-fixnum)
(:save-p :compute-only)
(:check-type t))
((:arg array descriptor-reg rdx-offset)
((:arg array descriptor-reg (:lisp-reg 0))
(:temp temp any-reg rcx-offset)
(:res result descriptor-reg rdx-offset)
(:res offset any-reg rdi-offset))
(:res result descriptor-reg (:lisp-reg 0))
(:res offset any-reg (:lisp-reg 1)))
(declare (ignore result))
(let ((error (generate-error-code nil 'fill-pointer-error array)))
(assemble ()
@ -243,10 +243,10 @@
(:result-types t t)
(:save-p :compute-only)
(:check-type t))
((:arg array descriptor-reg rdx-offset)
((:arg array descriptor-reg (:lisp-reg 0))
(:temp temp any-reg rcx-offset)
(:res result descriptor-reg rdx-offset)
(:res offset descriptor-reg rdi-offset))
(:res result descriptor-reg (:lisp-reg 0))
(:res offset descriptor-reg (:lisp-reg 1)))
(declare (ignore result))
(let ((error (generate-error-code nil 'fill-pointer-error array)))
(assemble ()

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

@ -257,7 +257,7 @@
(define-assembly-routine (throw
(:return-style :full-call-no-return)
(:save-p :compute-only))
((:arg target (descriptor-reg any-reg) rdx-offset)
((:arg target (descriptor-reg any-reg) (:lisp-reg 0))
(:arg start any-reg rbx-offset)
(:arg count any-reg rcx-offset)
(:temp bsp-temp any-reg r11-offset)
@ -365,8 +365,8 @@
(:policy :fast-safe)
(:translate update-object-layout)
(:return-style :raw))
((:arg x (descriptor-reg) rdx-offset)
(:res r (descriptor-reg) rdx-offset))
((:arg x (descriptor-reg) (:lisp-reg 0))
(:res r (descriptor-reg) (:lisp-reg 0)))
(progn x r)
(with-registers-preserved (lisp :except rdx)
(call-lisp-fun 'update-object-layout 1 nil)))
@ -375,8 +375,8 @@
(:policy :fast-safe)
(:translate sb-impl:install-hash-table-lock)
(:return-style :raw))
((:arg x (descriptor-reg) rdx-offset)
(:res r (descriptor-reg) rdx-offset))
((:arg x (descriptor-reg) (:lisp-reg 0))
(:res r (descriptor-reg) (:lisp-reg 0)))
(progn x r)
(with-registers-preserved (lisp :except rdx)
(call-lisp-fun 'sb-impl:install-hash-table-lock 1)))

22
src/assembly/x86/arith.lisp
View file

@ -20,10 +20,10 @@
(:translate ,fun)
(:policy :safe)
(:save-p t))
((:arg x (descriptor-reg any-reg) edx-offset)
(:arg y (descriptor-reg any-reg) edi-offset)
((:arg x (descriptor-reg any-reg) (:lisp-reg 0))
(:arg y (descriptor-reg any-reg) (:lisp-reg 1))
(:res res (descriptor-reg any-reg) edx-offset)
(:res res (descriptor-reg any-reg) (:lisp-reg 0))
,@(if (eq fun '*)
'((:temp eax unsigned-reg eax-offset)))
@ -123,8 +123,8 @@
(:policy :safe)
(:translate %negate)
(:save-p t))
((:arg x (descriptor-reg any-reg) edx-offset)
(:res res (descriptor-reg any-reg) edx-offset)
((:arg x (descriptor-reg any-reg) (:lisp-reg 0))
(:res res (descriptor-reg any-reg) (:lisp-reg 0))
(:temp ecx unsigned-reg ecx-offset))
(inst test x fixnum-tag-mask)
(inst jmp :z FIXNUM)
@ -159,8 +159,8 @@
(:save-p t)
(:conditional ,test)
(:cost 10))
((:arg x (descriptor-reg any-reg) edx-offset)
(:arg y (descriptor-reg any-reg) edi-offset)
((:arg x (descriptor-reg any-reg) (:lisp-reg 0))
(:arg y (descriptor-reg any-reg) (:lisp-reg 1))
(:temp ecx unsigned-reg ecx-offset))
@ -207,8 +207,8 @@
(:save-p t)
(:conditional :e)
(:cost 10))
((:arg x (descriptor-reg any-reg) edx-offset)
(:arg y (descriptor-reg any-reg) edi-offset)
((:arg x (descriptor-reg any-reg) (:lisp-reg 0))
(:arg y (descriptor-reg any-reg) (:lisp-reg 1))
(:temp ecx unsigned-reg ecx-offset))
(inst mov ecx x)
@ -254,8 +254,8 @@
(:save-p t)
(:conditional :e)
(:cost 10))
((:arg x (descriptor-reg any-reg) edx-offset)
(:arg y (descriptor-reg any-reg) edi-offset)
((:arg x (descriptor-reg any-reg) (:lisp-reg 0))
(:arg y (descriptor-reg any-reg) (:lisp-reg 1))
(:temp ecx unsigned-reg ecx-offset))
(inst mov ecx x)

2
src/assembly/x86/assem-rtns.lisp
View file

@ -221,7 +221,7 @@
(define-assembly-routine (throw
(:return-style :full-call-no-return)
(:save-p :compute-only))
((:arg target (descriptor-reg any-reg) edx-offset)
((:arg target (descriptor-reg any-reg) (:lisp-reg 0))
(:arg start any-reg ebx-offset)
(:arg count any-reg ecx-offset)
(:temp catch any-reg eax-offset))