master: Remove mappings from float-regs to offsets
stassats via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via fc1d28224a241b69d9e271bc8845dbdce8464243 (commit)
from c3bb5b870018b1d2b0458eebbb215e796830e283 (commit)
- Log -----------------------------------------------------------------
commit fc1d28224a241b69d9e271bc8845dbdce8464243
Author: Stas Boukarev <[email protected]>
Date: Thu Aug 20 11:18:07 2026 +0300
Remove mappings from float-regs to offsets
They are just sequential integers.
---
src/assembly/x86-64/alloc.lisp | 22 +++----
src/assembly/x86-64/array.lisp | 2 +-
src/assembly/x86-64/assem-rtns.lisp | 2 +-
src/cold/exports.lisp | 1 -
src/compiler/arm64/vm.lisp | 11 ++--
src/compiler/generic/utils.lisp | 12 ++--
src/compiler/x86-64/c-call.lisp | 24 ++++----
src/compiler/x86-64/target-avx2-insts.lisp | 5 +-
src/compiler/x86-64/vm.lisp | 96 ++++++------------------------
src/compiler/x86/vm.lisp | 1 -
tests/assembler.pure.lisp | 9 +--
11 files changed, 61 insertions(+), 124 deletions(-)
diff --git a/src/assembly/x86-64/alloc.lisp b/src/assembly/x86-64/alloc.lisp
index f9af2092a..c4716b0cf 100644
--- a/src/assembly/x86-64/alloc.lisp
+++ b/src/assembly/x86-64/alloc.lisp
@@ -26,12 +26,14 @@
;;;; +BIGNUM-TO-Rxx : choose a 1, 2, or 3-digit bignum given [high:low] on stack,
;;;; ensuring that if the sign bit of the high word is on, the third digit
;;;; is zeroized to ensure that the result is a positive bignum.
-;#+sb-assembling
+#+sb-assembling
(make-defs ((($avx512 $suffix)
(t -avx512)
(nil ||)))
(macrolet
- ((alloc-other (&rest rest)
+ ((float0-tn ()
+ (make-random-tn (sc-or-lose 'single-reg) 0))
+ (alloc-other (&rest rest)
`(emit-alloc-other nil thread-tn ,@rest :avx512 $avx512))
(signed (reg)
`(define-assembly-routine (,(symbolicate "ALLOC-SIGNED-BIGNUM-IN-" reg '$suffix))
@@ -63,13 +65,13 @@
(inst test :byte result result) ; is-two-digit flag
(inst jmp :z one-word-bignum)
(alloc-other bignum-widetag (+ bignum-digits-offset 2) result)
- (inst movdqu float0-tn (ea 8 rsp-tn))
- (inst movdqu (object-slot-ea result 1 other-pointer-lowtag) float0-tn)
+ (inst movdqu (float0-tn) (ea 8 rsp-tn))
+ (inst movdqu (object-slot-ea result 1 other-pointer-lowtag) (float0-tn))
(inst ret 16) ; pop args
ONE-WORD-BIGNUM
(alloc-other bignum-widetag (+ bignum-digits-offset 1) result)
- (inst movq float0-tn (ea 8 rsp-tn))
- (inst movq (object-slot-ea result 1 other-pointer-lowtag) float0-tn)
+ (inst movq (float0-tn) (ea 8 rsp-tn))
+ (inst movq (object-slot-ea result 1 other-pointer-lowtag) (float0-tn))
(inst ret 16)))
;; "from unsigned" might need to allocate 3 digits, but it receives only high:low
;; because the highest digit if needed must be all 0.
@@ -85,8 +87,8 @@
;; Since 2 digits and 3 digits consume the same number of bytes
;; due to padding, they can share the allocation request.
(alloc-other bignum-widetag (+ bignum-digits-offset 3) result)
- (inst movdqu float0-tn (ea 8 rsp-tn))
- (inst movdqu (object-slot-ea result 1 other-pointer-lowtag) float0-tn)
+ (inst movdqu (float0-tn) (ea 8 rsp-tn))
+ (inst movdqu (object-slot-ea result 1 other-pointer-lowtag) (float0-tn))
;; don't assume prezeroed unboxed pages. (zeroize word even if 2-digit result)
(inst mov :qword (object-slot-ea result 3 other-pointer-lowtag) 0)
;; Test sign bit of digit index 1
@@ -99,8 +101,8 @@
(inst ret 16) ; pop args
ONE-WORD-BIGNUM
(alloc-other bignum-widetag (+ bignum-digits-offset 1) result)
- (inst movq float0-tn (ea 8 rsp-tn))
- (inst movq (object-slot-ea result 1 other-pointer-lowtag) float0-tn)
+ (inst movq (float0-tn) (ea 8 rsp-tn))
+ (inst movq (object-slot-ea result 1 other-pointer-lowtag) (float0-tn))
(inst ret 16)))
;; The high bit is in the carry flag.
(two-word-bignum (reg)
diff --git a/src/assembly/x86-64/array.lisp b/src/assembly/x86-64/array.lisp
index be18d36a2..9ceb3e208 100644
--- a/src/assembly/x86-64/array.lisp
+++ b/src/assembly/x86-64/array.lisp
@@ -28,7 +28,7 @@
(:temp end-card-index 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 float0-offset))
+ (:temp wordpair double-reg 0))
(progn end-card-index)
(move res vector) ; to "use" res
diff --git a/src/assembly/x86-64/assem-rtns.lisp b/src/assembly/x86-64/assem-rtns.lisp
index 433cff6d4..346278e7a 100644
--- a/src/assembly/x86-64/assem-rtns.lisp
+++ b/src/assembly/x86-64/assem-rtns.lisp
@@ -301,7 +301,7 @@
(:temp symbol unsigned-reg r9-offset)
(:temp value unsigned-reg r10-offset)
(:temp bsp-temp unsigned-reg r11-offset)
- (:temp zero complex-double-reg float0-offset))
+ (:temp zero complex-double-reg 0))
AGAIN
(inst test block block) ; check for NULL pointer
diff --git a/src/cold/exports.lisp b/src/cold/exports.lisp
index 98202996c..f47fd4766 100644
--- a/src/cold/exports.lisp
+++ b/src/cold/exports.lisp
@@ -3270,7 +3270,6 @@ structure representations")
"SIMD-PACK-256-WIDETAG")
#+sb-simd-pack-512
(:export
- "+MASK-REGISTER-NAMES+"
"SIMD-PACK-512-TAG-SLOT"
"SIMD-PACK-512-P0-SLOT"
"SIMD-PACK-512-P1-SLOT"
diff --git a/src/compiler/arm64/vm.lisp b/src/compiler/arm64/vm.lisp
index b55201bcc..7067eff56 100644
--- a/src/compiler/arm64/vm.lisp
+++ b/src/compiler/arm64/vm.lisp
@@ -88,7 +88,8 @@
(defconstant-eqx register-arg-names '(r0 r1 r2 r3) #'equal)
(defregset *descriptor-args* r0 r1 r2 r3 r4 r5 r6 r7 #-(or darwin win32) r8 r9 r10)
(defregset *non-descriptor-args* nl0 nl1 nl2 nl3 nl4 nl5 nl6 nl7 nl8)
- (defglobal *float-regs* (loop for i below 32 collect i)))
+
+ (defconstant float-reg-count 32))
;;;; SB and SC definition:
@@ -215,23 +216,23 @@
;; temporary only
#+sb-simd-pack
(neon-reg float-registers
- :locations #.*float-regs*)
+ :locations #.(loop for i to 31 collect i))
;; regular values
#+sb-simd-pack
(int-neon-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 31 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (int-neon-stack))
#+sb-simd-pack
(double-neon-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 31 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (double-neon-stack))
#+sb-simd-pack
(single-neon-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 31 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (single-neon-stack))
diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp
index 762396717..f2f2fba7b 100644
--- a/src/compiler/generic/utils.lisp
+++ b/src/compiler/generic/utils.lisp
@@ -166,7 +166,6 @@
#-(or arm64 x86-64) (defvar *descriptor-args*)
#-(or arm64 c-stack-is-control-stack) (defvar *non-descriptor-args*)
-#-(or x86 arm64 x86-64) (defvar *float-regs*)
(defun fixed-call-arg-location (type state)
(let* ((primtype (if (typep type 'primitive-type)
@@ -182,12 +181,11 @@
(elt *descriptor-args* index))
(make-wired-tn primtype control-stack-sc-number (+ register-arg-count (- index max-regs)))))))
(case (primitive-type-name primtype)
+ #+(or arm64 x86-64)
((double-float single-float)
(let ((n (incf (fixed-call-args-state-float state))))
- (if (< n (length *float-regs*))
- (make-wired-tn primtype
- sc
- (elt *float-regs* n))
+ (if (< n float-reg-count)
+ (make-wired-tn primtype sc n)
(descriptor))))
((system-area-pointer unsigned-byte-64 signed-byte-64)
(let ((n (incf (#-c-stack-is-control-stack fixed-call-args-state-non-descriptors
@@ -196,9 +194,7 @@
(regs #-c-stack-is-control-stack *non-descriptor-args*
#+c-stack-is-control-stack *descriptor-args*))
(if (< n (length regs))
- (make-wired-tn primtype
- sc
- (elt regs n))
+ (make-wired-tn primtype sc (elt regs n))
(descriptor))))
(t
(descriptor))))))
diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp
index a10e4be9d..163355fd9 100644
--- a/src/compiler/x86-64/c-call.lisp
+++ b/src/compiler/x86-64/c-call.lisp
@@ -56,8 +56,7 @@
#+win32 (arg-state-register-args state))))
(cond ((< xmm-args max-xmm-args)
(setf (arg-state-xmm-args state) (1+ xmm-args))
- (make-wired-tn* prim-type reg-sc
- (nth xmm-args *float-regs*)))
+ (make-wired-tn* prim-type reg-sc xmm-args))
(t
(let ((frame-size (arg-state-stack-frame-size state)))
(setf (arg-state-stack-frame-size state) (1+ frame-size))
@@ -893,9 +892,8 @@ Floats are passed in integer registers."
;; 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 <=8 bytes: returned in RAX
- (labels ((make-tn-maker (sc-name)
- (lambda (offset)
- (make-random-tn (sc-or-lose sc-name) offset)))
+ (labels ((make-tn (sc-name offset)
+ (make-random-tn (sc-or-lose sc-name) offset))
(argument-byte-size (type)
"Return the number of bytes this argument occupies in the callback vector."
(ceiling (sb-alien::alien-type-bits type) n-byte-bits))
@@ -918,9 +916,9 @@ Floats are passed in integer registers."
(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)
+ (xmm0 (make-tn 'double-reg 0))
#-win32
- (xmm1 float1-tn)
+ (xmm1 (make-tn 'double-reg 1))
([rsp] (ea rsp))
;; Calculate total argument vector size in bytes
(total-arg-bytes
@@ -935,14 +933,16 @@ Floats are passed in integer registers."
;; 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*)))
+ (gprs (let ((all-gprs (mapcar (lambda (offset)
+ (make-tn 'any-reg offset))
+ *c-call-register-arg-offsets*)))
(if large-struct-return-p
(rest all-gprs) ; Skip RCX (win32) or RDI (SysV)
all-gprs)))
- (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))))
+ (fprs (let ((all-fprs ;; Only 8 first XMM registers are used for
+ ;; passing arguments
+ (loop for i to (+ 7 #+win32 -4)
+ collect (make-tn 'double-reg i))))
;; 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.
diff --git a/src/compiler/x86-64/target-avx2-insts.lisp b/src/compiler/x86-64/target-avx2-insts.lisp
index 2da6c31df..2f8d1e568 100644
--- a/src/compiler/x86-64/target-avx2-insts.lisp
+++ b/src/compiler/x86-64/target-avx2-insts.lisp
@@ -88,6 +88,5 @@
#+sb-simd-pack-512
(defun print-opmask-register (value stream dstate)
(declare (ignore dstate))
- (let ((name (svref +mask-register-names+ (logand value 7))))
- (if stream
- (write-string name stream))))
+ (if stream
+ (format stream "K~d" (logand value 7))))
diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp
index 2a9136e1d..4ff0c444e 100644
--- a/src/compiler/x86-64/vm.lisp
+++ b/src/compiler/x86-64/vm.lisp
@@ -166,64 +166,6 @@
"R8B" "R9B" "R10B" "R11B" "R12B" "R13B" "R14B" "R15B"
"AH" "CH" "DH" "BH"))
- ;; floating point registers
- (defreg float0 0 :float)
- (defreg float1 1 :float)
- (defreg float2 2 :float)
- (defreg float3 3 :float)
- (defreg float4 4 :float)
- (defreg float5 5 :float)
- (defreg float6 6 :float)
- (defreg float7 7 :float)
- (defreg float8 8 :float)
- (defreg float9 9 :float)
- (defreg float10 10 :float)
- (defreg float11 11 :float)
- (defreg float12 12 :float)
- (defreg float13 13 :float)
- (defreg float14 14 :float)
- (defreg float15 15 :float)
- (defreg float16 16 :float)
- (defreg float17 17 :float)
- (defreg float18 18 :float)
- (defreg float19 19 :float)
- (defreg float20 20 :float)
- (defreg float21 21 :float)
- (defreg float22 22 :float)
- (defreg float23 23 :float)
- (defreg float24 24 :float)
- (defreg float25 25 :float)
- (defreg float26 26 :float)
- (defreg float27 27 :float)
- (defreg float28 28 :float)
- (defreg float29 29 :float)
- (defreg float30 30 :float)
- (defreg float31 31 :float)
- (defregset *float-regs* float0 float1 float2 float3 float4 float5 float6 float7
- float8 float9 float10 float11 float12 float13 float14 float15)
- #+sb-simd-pack-512
- (progn
- ;; ZMM16-31 are only accessible via EVEX encoding
- (defregset *zmm-regs* float0 float1 float2 float3 float4 float5 float6 float7
- float8 float9 float10 float11 float12 float13 float14 float15
- float16 float17 float18 float19 float20 float21 float22 float23
- float24 float25 float26 float27 float28 float29 float30 float31)
- ;; mask registers for use with avx512
- (defreg k0 0 :qword)
- (defreg k1 1 :qword)
- (defreg k2 2 :qword)
- (defreg k3 3 :qword)
- (defreg k4 4 :qword)
- (defreg k5 5 :qword)
- (defreg k6 6 :qword)
- (defreg k7 7 :qword)
- ;; k0 is special meaning "no masking", so we can't schedule those regs for
- ;; normal ops. I am not sure how to best model it, this is the simplest try
- (defregset *mask-regs* k1 k2 k3 k4 k5 k6 k7)
- (defconstant-eqx +mask-register-names+
- #("K0" "K1" "K2" "K3" "K4" "K5" "K6" "K7")
- #'equalp))
-
;; registers used to pass arguments
;;
;; the number of arguments/return values passed in registers
@@ -235,7 +177,8 @@
(defregset *c-call-register-arg-offsets* rdi rsi rdx rcx r8 r9)
#+win32
(defregset *c-call-register-arg-offsets* rcx rdx r8 r9)
- (defregset *descriptor-args* rdx rdi rsi rbx rcx r8 r9 r10 r14))
+ (defregset *descriptor-args* rdx rdi rsi rbx rcx r8 r9 r10 r14)
+ (defconstant float-reg-count 16))
;;;; SB definitions
@@ -348,26 +291,26 @@
;; non-descriptor SINGLE-FLOATs
(single-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 15 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (single-stack))
;; non-descriptor DOUBLE-FLOATs
(double-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 15 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (double-stack))
(complex-single-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 15 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (complex-single-stack))
(complex-double-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 15 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (complex-double-stack))
@@ -375,66 +318,66 @@
;; temporary only
#+sb-simd-pack
(sse-reg float-registers
- :locations #.*float-regs*)
+ :locations #.(loop for i to 15 collect i))
;; regular values
#+sb-simd-pack
(int-sse-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 15 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (int-sse-stack))
#+sb-simd-pack
(double-sse-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 15 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (double-sse-stack))
#+sb-simd-pack
(single-sse-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 15 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (single-sse-stack))
#+sb-simd-pack-256
(int-avx2-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 15 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (int-avx2-stack))
#+sb-simd-pack-256
(double-avx2-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 15 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (double-avx2-stack))
#+sb-simd-pack-256
(single-avx2-reg float-registers
- :locations #.*float-regs*
+ :locations #.(loop for i to 15 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (single-avx2-stack))
;; ZMM SCs use all 32 registers (16-31 require EVEX encoding)
#+sb-simd-pack-512
(int-avx512-reg float-registers
- :locations #.*zmm-regs*
+ :locations #.(loop for i to 31 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (int-avx512-stack))
#+sb-simd-pack-512
(double-avx512-reg float-registers
- :locations #.*zmm-regs*
+ :locations #.(loop for i to 31 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (double-avx512-stack))
#+sb-simd-pack-512
(single-avx512-reg float-registers
- :locations #.*zmm-regs*
+ :locations #.(loop for i to 31 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (single-avx512-stack))
#+sb-simd-pack-512
(mask-reg mask-registers
- :locations #.*mask-regs*
+ :locations #.(loop for i to 7 collect i)
:constant-scs (fp-immediate)
:save-p t
:alternate-scs (kmask-stack))
@@ -513,10 +456,7 @@
;; Because there is no :OFFSET, unanticipated use will be caught.
(defconstant-eqx rip-tn
(make-random-tn (sc-or-lose 'unsigned-reg) nil)
- #'constantly-t)
- (def-fpr-tns single-reg
- float0 float1 float2 float3 float4 float5 float6 float7
- float8 float9 float10 float11 float12 float13 float14 float15))
+ #'constantly-t))
;;; Return true if THING is a general-purpose register TN.
(defun gpr-tn-p (thing)
diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp
index f65ae45d0..8f04f2e0a 100644
--- a/src/compiler/x86/vm.lisp
+++ b/src/compiler/x86/vm.lisp
@@ -77,7 +77,6 @@
(defreg fr5 5 :float)
(defreg fr6 6 :float)
(defreg fr7 7 :float)
- (defregset *float-regs* fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
;; registers used to pass arguments
;;
diff --git a/tests/assembler.pure.lisp b/tests/assembler.pure.lisp
index d73e496af..9cabc30fd 100644
--- a/tests/assembler.pure.lisp
+++ b/tests/assembler.pure.lisp
@@ -265,10 +265,11 @@
"40C0C602 ROL SIL, 2")
(test-assemble `(test :byte ,rsi-tn 15)
"40F6C60F TEST SIL, 15")
- (test-assemble `(movd ,float0-tn ,rax-tn)
- "660F6EC0 MOVD XMM0, EAX")
- (test-assemble `(movq ,float0-tn ,eax)
- "66480F6EC0 MOVQ XMM0, RAX"))
+ (let ((float0 (sb-c:make-random-tn (sb-c:sc-or-lose 'double-reg) 0)))
+ (test-assemble `(movd ,float0 ,rax-tn)
+ "660F6EC0 MOVD XMM0, EAX")
+ (test-assemble `(movq ,float0 ,eax)
+ "66480F6EC0 MOVQ XMM0, RAX")))
(test-util:with-test (:name :assemble-high-byte-regs :skipped-on (not :x86-64))
(test-assemble `(cmp (,rdx-tn . :high-byte) 1)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL