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: remove fp-...-zero-scs

Browse source 
No different from fp-immedaite-scs, frees up four SC numbers.
This commit is contained in:
Stas Boukarev 2026-06-26 18:06:29 +03:00
parent 8fbf3824e4
commit b81fef15a6
7 changed files with 62 additions and 80 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
src/cold/exports.lisp
View file

@ -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"

14
src/compiler/pack.lisp
View file

@ -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)))

9
src/compiler/x86-64/array.lisp
View file

@ -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))))

6
src/compiler/x86-64/cell.lisp
View file

@ -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)

80
src/compiler/x86-64/float.lisp
View file

@ -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)

25
src/compiler/x86-64/vm.lisp
View file

@ -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

7
tests/type.before-xc.lisp
View file

@ -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)))