master: x86-64: remove fp-...-zero-scs
stassats via Sbcl-commits <[email protected]> Sun, 28 Jun 2026 13:03:18 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via b81fef15a67dd19e7fe9f1d1822330c86a3a5671 (commit)
from 8fbf3824e4614e2dc38e432ffb495cf7e2844092 (commit)
- Log -----------------------------------------------------------------
commit b81fef15a67dd19e7fe9f1d1822330c86a3a5671
Author: Stas Boukarev <[email protected]>
Date: Fri Jun 26 18:06:29 2026 +0300
x86-64: remove fp-...-zero-scs
No different from fp-immedaite-scs, frees up four SC numbers.
---
src/cold/exports.lisp | 1 -
src/compiler/pack.lisp | 14 +++++---
src/compiler/x86-64/array.lisp | 9 ++---
src/compiler/x86-64/cell.lisp | 6 ++--
src/compiler/x86-64/float.lisp | 80 +++++++++++++++++++-----------------------
src/compiler/x86-64/vm.lisp | 25 +++++--------
tests/type.before-xc.lisp | 7 ----
7 files changed, 62 insertions(+), 80 deletions(-)
diff --git a/src/cold/exports.lisp b/src/cold/exports.lisp
index 34770006b..356f9665c 100644
--- a/src/cold/exports.lisp
+++ b/src/cold/exports.lisp
@@ -2990,7 +2990,6 @@ structure representations")
"FLOAT-STICKY-BITS"
"FLOAT-TRAPS-BYTE"
"FP-CONSTANT-SC-NUMBER"
- "FP-DOUBLE-ZERO-SC-NUMBER" "FP-SINGLE-ZERO-SC-NUMBER"
"FUNCALLABLE-INSTANCE-TRAMPOLINE-SLOT"
"FUNCALLABLE-INSTANCE-WIDETAG"
"FUNCALLABLE-INSTANCE-INFO-OFFSET"
diff --git a/src/compiler/pack.lisp b/src/compiler/pack.lisp
index 813b599d7..89f09fde8 100644
--- a/src/compiler/pack.lisp
+++ b/src/compiler/pack.lisp
@@ -1315,11 +1315,15 @@
(load-scs (svref (car scs)
(sc-number
(tn-sc (or load-tn tn))))))
- (if load-tn
- (aver (eq load-scs t))
- (unless (eq load-scs t)
- (setf (tn-ref-load-tn op)
- (pack-load-tn load-scs op))))))))
+ (cond (load-tn
+ (aver (eq load-scs t)))
+ (t
+ ;; conditional sc
+ (when (functionp load-scs)
+ (setf load-scs (funcall load-scs tn)))
+ (unless (eq load-scs t)
+ (setf (tn-ref-load-tn op)
+ (pack-load-tn load-scs op)))))))))
(do ((scs scs (cdr scs))
(op ops (tn-ref-across op)))
diff --git a/src/compiler/x86-64/array.lisp b/src/compiler/x86-64/array.lisp
index 0a02f8890..6a6d45d25 100644
--- a/src/compiler/x86-64/array.lisp
+++ b/src/compiler/x86-64/array.lisp
@@ -783,7 +783,7 @@
(define-vop (data-vector-set-with-offset/simple-array-single-float-c dvset)
(:args (object :scs (descriptor-reg))
- (value :scs (single-reg fp-single-zero fp-single-immediate)))
+ (value :scs (single-reg fp-single-immediate)))
(:info index addend)
(:arg-types simple-array-single-float (:constant low-index)
(:constant (constant-displacement other-pointer-lowtag
@@ -791,7 +791,7 @@
single-float)
(:generator 4
(unpoison-element object (+ index addend))
- (if (sc-is value fp-single-zero fp-single-immediate)
+ (if (sc-is value fp-single-immediate)
(inst mov :dword (float-ref-ea object index addend 4)
(single-float-bits (tn-value value)))
(inst movss (float-ref-ea object index addend 4) value))))
@@ -834,7 +834,8 @@
(define-vop (data-vector-set-with-offset/simple-array-double-float-c dvset)
(:args (object :scs (descriptor-reg))
- (value :scs (double-reg fp-double-zero)))
+ (value :scs (double-reg (fp-double-immediate
+ (eql (tn-value tn) 0d0)))))
(:info index addend)
(:arg-types simple-array-double-float (:constant low-index)
(:constant (constant-displacement other-pointer-lowtag
@@ -842,7 +843,7 @@
double-float)
(:generator 19
(unpoison-element object (+ index addend))
- (if (sc-is value fp-double-zero)
+ (if (sc-is value fp-double-immediate)
(inst mov :qword (float-ref-ea object index addend 8) 0)
(inst movsd (float-ref-ea object index addend 8) value))))
diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp
index c7a4dedf3..6f6f1d48f 100644
--- a/src/compiler/x86-64/cell.lisp
+++ b/src/compiler/x86-64/cell.lisp
@@ -685,11 +685,11 @@
(index :scs (any-reg immediate))
(value :scs (,result-sc ,@(case result-sc
(single-reg
- '(fp-single-immediate fp-single-zero))
+ '(fp-single-immediate))
(double-reg
- '(fp-double-zero))
+ '((fp-double-immediate (eql (tn-value tn) 0d0))))
(complex-single-reg
- '(fp-complex-single-zero))
+ '((fp-complex-single-immediate (eql (tn-value tn) #c(0f0 0f0)))))
((unsigned-reg signed-reg)
'((immediate (plausible-signed-imm32-operand-p (tn-value tn)))))))))
(:arg-types * tagged-num ,result-type)
diff --git a/src/compiler/x86-64/float.lisp b/src/compiler/x86-64/float.lisp
index 7a9101251..18c4a3a9d 100644
--- a/src/compiler/x86-64/float.lisp
+++ b/src/compiler/x86-64/float.lisp
@@ -73,27 +73,21 @@
;;; X is source, Y is destination.
-(define-move-fun (load-fp-zero 1) (vop x y)
- ((fp-single-zero) (single-reg)
- (fp-double-zero) (double-reg)
- (fp-complex-single-zero) (complex-single-reg)
- (fp-complex-double-zero) (complex-double-reg))
- (identity x)
- (sc-case y
- ((single-reg complex-single-reg) (inst xorps y y))
- ((double-reg complex-double-reg) (inst xorpd y y))))
-
(define-move-fun (load-fp-immediate 1) (vop x y)
((fp-single-immediate) (single-reg)
(fp-double-immediate) (double-reg)
(fp-complex-single-immediate) (complex-single-reg)
(fp-complex-double-immediate) (complex-double-reg))
- (let ((x (register-inline-constant (tn-value x))))
- (sc-case y
- (single-reg (inst movss y x))
- (double-reg (inst movsd y x))
- (complex-single-reg (inst movq y x))
- (complex-double-reg (inst movapd y x)))))
+ (if (member (tn-value x) '(0f0 0d0 #c(0d0 0d0) #c(0f0 0f0)))
+ (sc-case y
+ ((single-reg complex-single-reg) (inst xorps y y))
+ ((double-reg complex-double-reg) (inst xorpd y y)))
+ (let ((x (register-inline-constant (tn-value x))))
+ (sc-case y
+ (single-reg (inst movss y x))
+ (double-reg (inst movsd y x))
+ (complex-single-reg (inst movq y x))
+ (complex-double-reg (inst movapd y x))))))
(define-move-fun (load-single 2) (vop x y)
((single-stack) (single-reg))
@@ -712,13 +706,13 @@
(define-vop (//complex-real-single-float float-op)
(:translate /)
- (:args (x :scs (complex-single-reg fp-complex-single-immediate fp-complex-single-zero)
+ (:args (x :scs (complex-single-reg fp-complex-single-immediate)
:to (:result 0)
:target r
- :load-if (not (sc-is x fp-complex-single-immediate fp-complex-single-zero)))
- (y :scs (single-reg fp-single-immediate fp-single-zero)
+ :load-if (not (sc-is x fp-complex-single-immediate)))
+ (y :scs (single-reg fp-single-immediate)
:target dup
- :load-if (not (sc-is y fp-single-immediate fp-single-zero))))
+ :load-if (not (sc-is y fp-single-immediate))))
(:arg-types complex-single-float single-float)
(:temporary (:sc complex-single-reg :from (:argument 1)) dup)
(:results (r :scs (complex-single-reg)))
@@ -735,18 +729,18 @@
(register-inline-constant :oword (logior (ash word 64) word)))))
(sc-case y
(fp-single-immediate
- (setf dup (duplicate (complex (setf second-value (tn-value y))
- (tn-value y)))))
- (fp-single-zero
- (inst xorps dup dup))
+ (if (eql (tn-value y) 0f0)
+ (inst xorps dup dup)
+ (setf dup (duplicate (complex (setf second-value (tn-value y))
+ (tn-value y))))))
(t (move dup y)
(setf second-value y)
(inst shufps dup dup #b00000000)))
(sc-case x
(fp-complex-single-immediate
- (inst movaps r (duplicate (setf first-value (tn-value x)))))
- (fp-complex-single-zero
- (inst xorps r r))
+ (if (eql (tn-value x) #c(0f0 0f0))
+ (inst xorps r r)
+ (inst movaps r (duplicate (setf first-value (tn-value x))))))
(t
(move r x)
(setf first-value x)
@@ -1405,52 +1399,52 @@
(define-vop (make-complex-single-float)
(:translate complex)
- (:args (real :scs (single-reg fp-single-zero)
- :target r
- :load-if (not (sc-is real fp-single-zero)))
- (imag :scs (single-reg fp-single-zero)
- :load-if (not (sc-is imag fp-single-zero))))
+ (:args (real :scs (single-reg (fp-single-immediate
+ (eql (tn-value tn) 0f0)))
+ :target r)
+ (imag :scs (single-reg (fp-single-immediate
+ (eql (tn-value tn) 0f0)))))
(:arg-types single-float single-float)
(:results (r :scs (complex-single-reg) :from (:argument 0)))
(:result-types complex-single-float)
(:note "inline complex single-float creation")
(:policy :fast-safe)
(:generator 5
- (cond ((sc-is real fp-single-zero)
+ (cond ((sc-is real fp-single-immediate)
(inst xorps r r)
- (unless (sc-is imag fp-single-zero)
+ (unless (sc-is imag fp-single-immediate)
(inst unpcklps r imag)))
((location= real imag)
(move r real)
(inst unpcklps r r))
(t
(move r real)
- (unless (sc-is imag fp-single-zero)
+ (unless (sc-is imag fp-single-immediate)
(inst unpcklps r imag))))))
(define-vop (make-complex-double-float)
(:translate complex)
- (:args (real :scs (double-reg fp-double-zero)
- :target r
- :load-if (not (sc-is real fp-double-zero)))
- (imag :scs (double-reg fp-double-zero)
- :load-if (not (sc-is imag fp-double-zero))))
+ (:args (real :scs (double-reg (fp-double-immediate
+ (eql (tn-value tn) 0d0)))
+ :target r)
+ (imag :scs (double-reg (fp-double-immediate
+ (eql (tn-value tn) 0d0)))))
(:arg-types double-float double-float)
(:results (r :scs (complex-double-reg) :from (:argument 0)))
(:result-types complex-double-float)
(:note "inline complex double-float creation")
(:policy :fast-safe)
(:generator 5
- (cond ((sc-is real fp-double-zero)
+ (cond ((sc-is real fp-double-immediate)
(inst xorpd r r)
- (unless (sc-is imag fp-double-zero)
+ (unless (sc-is imag fp-double-immediate)
(inst unpcklpd r imag)))
((location= real imag)
(move r real)
(inst unpcklpd r r))
(t
(move r real)
- (unless (sc-is imag fp-double-zero)
+ (unless (sc-is imag fp-double-immediate)
(inst unpcklpd r imag))))))
(define-vop (complex-float-value)
diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp
index 583388409..951199d5d 100644
--- a/src/compiler/x86-64/vm.lisp
+++ b/src/compiler/x86-64/vm.lisp
@@ -218,11 +218,6 @@
;; non-immediate constants in the constant pool
(constant constant)
- (fp-single-zero immediate-constant)
- (fp-double-zero immediate-constant)
- (fp-complex-single-zero immediate-constant)
- (fp-complex-double-zero immediate-constant)
-
(fp-single-immediate immediate-constant)
(fp-double-immediate immediate-constant)
(fp-complex-single-immediate immediate-constant)
@@ -318,26 +313,26 @@
;; non-descriptor SINGLE-FLOATs
(single-reg float-registers
:locations #.*float-regs*
- :constant-scs (fp-single-zero fp-single-immediate)
+ :constant-scs (fp-single-immediate)
:save-p t
:alternate-scs (single-stack))
;; non-descriptor DOUBLE-FLOATs
(double-reg float-registers
:locations #.*float-regs*
- :constant-scs (fp-double-zero fp-double-immediate)
+ :constant-scs (fp-double-immediate)
:save-p t
:alternate-scs (double-stack))
(complex-single-reg float-registers
:locations #.*float-regs*
- :constant-scs (fp-complex-single-zero fp-complex-single-immediate)
+ :constant-scs (fp-complex-single-immediate)
:save-p t
:alternate-scs (complex-single-stack))
(complex-double-reg float-registers
:locations #.*float-regs*
- :constant-scs (fp-complex-double-zero fp-complex-double-immediate)
+ :constant-scs (fp-complex-double-immediate)
:save-p t
:alternate-scs (complex-double-stack))
@@ -500,17 +495,13 @@
immediate-sc-number))
#+compact-instance-header (layout immediate-sc-number)
(single-float
- (if (eql value 0f0) fp-single-zero-sc-number fp-single-immediate-sc-number))
+ fp-single-immediate-sc-number)
(double-float
- (if (eql value 0d0) fp-double-zero-sc-number fp-double-immediate-sc-number))
+ fp-double-immediate-sc-number)
((complex single-float)
- (if (eql value #c(0f0 0f0))
- fp-complex-single-zero-sc-number
- fp-complex-single-immediate-sc-number))
+ fp-complex-single-immediate-sc-number)
((complex double-float)
- (if (eql value #c(0d0 0d0))
- fp-complex-double-zero-sc-number
- fp-complex-double-immediate-sc-number))
+ fp-complex-double-immediate-sc-number)
;; This case has to follow the numeric cases because proxy floating-point numbers
;; are host structs. Or we could implement and use something like SB-XC:TYPECASE
(structure-object
diff --git a/tests/type.before-xc.lisp b/tests/type.before-xc.lisp
index 913136c6a..d5fd70bff 100644
--- a/tests/type.before-xc.lisp
+++ b/tests/type.before-xc.lisp
@@ -423,13 +423,6 @@
;; but it should also be EQ to (MEMBER NIL T)
(assert (eq (specifier-type '(member nil t)) (specifier-type 'boolean)))
-#+x86-64
-(progn
- (assert (= (sb-vm::immediate-constant-sc #c(0.0f0 0.0f0))
- sb-vm::fp-complex-single-zero-sc-number))
- (assert (= (sb-vm::immediate-constant-sc #c(0.0d0 0.0d0))
- sb-vm::fp-complex-double-zero-sc-number)))
-
;;; Unparse a union of (up to) 3 things depending on :sb-unicode as 2 things.
(assert (sb-kernel::brute-force-type-specifier-equalp
(type-specifier (specifier-type '(or string null)))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL