master: x86[-64]: Invent syntactic convenience in define-assembly-routine
snuglas via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 5ca456d7fef38c4e75a1b8a3d29807981873ac9d (commit)
from f5e063c351a102bda16b9d8d250bec26af00f05f (commit)
- Log -----------------------------------------------------------------
commit 5ca456d7fef38c4e75a1b8a3d29807981873ac9d
Author: Douglas Katzman <[email protected]>
Date: Wed Aug 19 16:26:09 2026 -0400
x86[-64]: Invent syntactic convenience in define-assembly-routine
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.
---
src/assembly/assemfile.lisp | 6 +++++-
src/assembly/x86-64/arith.lisp | 24 ++++++++++++------------
src/assembly/x86-64/array.lisp | 36 ++++++++++++++++++------------------
src/assembly/x86-64/assem-rtns.lisp | 10 +++++-----
src/assembly/x86/arith.lisp | 22 +++++++++++-----------
src/assembly/x86/assem-rtns.lisp | 2 +-
6 files changed, 52 insertions(+), 48 deletions(-)
diff --git a/src/assembly/assemfile.lisp b/src/assembly/assemfile.lisp
index 3a794a59f..0802522cf 100644
--- a/src/assembly/assemfile.lisp
+++ b/src/assembly/assemfile.lisp
@@ -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)
diff --git a/src/assembly/x86-64/arith.lisp b/src/assembly/x86-64/arith.lisp
index 16934dea4..045749ff6 100644
--- a/src/assembly/x86-64/arith.lisp
+++ b/src/assembly/x86-64/arith.lisp
@@ -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)
diff --git a/src/assembly/x86-64/array.lisp b/src/assembly/x86-64/array.lisp
index 58b9b2074..be18d36a2 100644
--- a/src/assembly/x86-64/array.lisp
+++ b/src/assembly/x86-64/array.lisp
@@ -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 ()
diff --git a/src/assembly/x86-64/assem-rtns.lisp b/src/assembly/x86-64/assem-rtns.lisp
index abcf39a4b..433cff6d4 100644
--- a/src/assembly/x86-64/assem-rtns.lisp
+++ b/src/assembly/x86-64/assem-rtns.lisp
@@ -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)))
diff --git a/src/assembly/x86/arith.lisp b/src/assembly/x86/arith.lisp
index a842ca94c..1ad06ecc2 100644
--- a/src/assembly/x86/arith.lisp
+++ b/src/assembly/x86/arith.lisp
@@ -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)
diff --git a/src/assembly/x86/assem-rtns.lisp b/src/assembly/x86/assem-rtns.lisp
index 86275713c..b17e26609 100644
--- a/src/assembly/x86/assem-rtns.lisp
+++ b/src/assembly/x86/assem-rtns.lisp
@@ -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))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL