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

Remove unsigned-word-find-first-bit

Browse source
This commit is contained in:
Stas Boukarev 2025-12-10 18:50:37 +03:00
parent 2c3722ef6c
commit a317e17646
9 changed files with 18 additions and 54 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
doc/manual/efficiency.texinfo
View file

@ -335,7 +335,7 @@ features.
(declare (type (unsigned-byte 64) n))
(integer-length (ldb (byte 64 0) (1- (logand n (- n))))))
@end lisp
is turned into hardware instructions on arm64 and x86-64. It returns 64 when @code{n} is 0.
is turned into hardware instructions on arm64 and x86-64. It returns 64 when @code{n} is 0.
@code{n} can also be @code{(signed-byte 64)} or @code{fixnum}.
@node Global and Always-Bound variables

12
src/code/bit-bash.lisp
View file

@ -717,14 +717,10 @@
(end-mask (compute-end-mask end)))
(declare (index last-word first-word))
(flet ((#+little-endian start-bit #+big-endian end-bit (x)
(declare (word x))
#+(or x86-64 x86)
(truly-the (mod #.n-word-bits)
(%primitive unsigned-word-find-first-bit x))
#-(or x86-64 x86)
(- #+big-endian n-word-bits
(integer-length (logand x (- x)))
#+little-endian 1))
#+big-endian
(- n-word-bits (integer-length (logand x (- x))))
#+little-endian
(integer-length (ldb (byte sb-vm:n-word-bits 0) (1- (logand x (- x))))))
(#+little-endian end-bit #+big-endian start-bit (x)
(declare (word x))
(- #+big-endian n-word-bits

13
src/code/early-extensions.lisp
View file

@ -1510,19 +1510,16 @@ NOTE: This interface is experimental and subject to change."
(cons nil)
(t t)))
(declaim (inline first-bit-set))
(defun first-bit-set (x)
#+(and x86-64 (not sb-xc-host))
(truly-the (values (mod #.sb-vm:n-word-bits) &optional)
(%primitive sb-vm::unsigned-word-find-first-bit (the word x)))
#-(and x86-64 (not sb-xc-host))
(1- (integer-length (logand x (- x)))))
#+sb-xc-host (declaim (inline count-trailing-zeros))
(defun count-trailing-zeros (integer)
(let ((integer (ldb (byte sb-vm:n-word-bits 0) integer)))
(integer-length (ldb (byte sb-vm:n-word-bits 0) (1- (logand integer (- integer)))))))
(defun integer-float-p (float)
(and (floatp float)
(multiple-value-bind (significand exponent) (integer-decode-float float)
(or (plusp exponent)
(<= (- exponent) (first-bit-set significand))))))
(<= (- exponent) (count-trailing-zeros significand))))))
(defvar *top-level-form-p* nil)

2
src/code/float.lisp
View file

@ -798,7 +798,7 @@
;; find the first set bit of the numerator and shift accordingly,
;; as the denominator is a power of two.
(let* ((pexp (- exp))
(set (first-bit-set bits)))
(set (count-trailing-zeros bits)))
(if (> pexp set)
(%make-ratio (ash int (- set))
(let ((shift (- pexp set)))

4
src/compiler/generic/utils.lisp
View file

@ -299,9 +299,9 @@
(let ((set-bit (logand lowtag-mask (logandc2 lowtag set)))
(clear-bit (logandc2 lowtag-mask (logior lowtag clear))))
(cond ((plusp set-bit)
(values (sb-kernel::first-bit-set set-bit) 1))
(values (count-trailing-zeros set-bit) 1))
((plusp clear-bit)
(values (sb-kernel::first-bit-set clear-bit) 0))))))))
(values (count-trailing-zeros clear-bit) 0))))))))
(defun fun-or-other-pointer-tn-ref-p (tn-ref &optional permit-nil)
(and (sc-is (tn-ref-tn tn-ref) descriptor-reg)

4
src/compiler/pack.lisp
View file

@ -374,9 +374,7 @@
(unless (zerop ,bitmap)
(loop named #:noname
do
(let ((.index. (truly-the
(integer 0 (,sb-vm:n-word-bits))
(%primitive sb-vm::unsigned-word-find-first-bit ,bitmap))))
(let ((.index. (count-trailing-zeros ,bitmap)))
;; BIAS is the bit index in the original LOCATIONS map
;; which is at index 0 in BITMAP
(let ((,location (truly-the sb-vm:finite-sc-offset (+ .index. ,bias))))

7
src/compiler/srctran.lisp
View file

@ -4629,9 +4629,10 @@
v2 v3))
(logand mod x2)))
(defun count-trailing-zeros (integer)
(let ((integer (ldb (byte 64 0) integer)))
(integer-length (ldb (byte 64 0) (1- (logand integer (- integer)))))))
(unless-vop-existsp (:translate count-trailing-zeros)
(define-source-transform count-trailing-zeros (integer)
`(let ((integer (ldb (byte sb-vm:n-word-bits 0) integer)))
(integer-length (ldb (byte sb-vm:n-word-bits 0) (1- (logand integer (- integer))))))))
;;; Return an expression to calculate the integer quotient of X and
;;; constant Y, using multiplication, shift and add/sub instead of

14
src/compiler/x86-64/arith.lisp
View file

@ -2916,20 +2916,6 @@
(:generator 5
(inst mov res 64)
(inst tzcnt res arg)))
;; The code on which this was based existed in no less than three varieties,
;; differing in response to 0 input: produce NIL, -1, or signal an error.
;; To avoid a thorny issue of proper semantics, this VOP is used only by
;; %BIT-POSITION which happens to declare zero safety, but always pre-checks
;; for zero. (the ltn-policy of :fast is actually irrelevant)
(define-vop (unsigned-word-find-first-bit)
(:policy :fast)
(:args (arg :scs (unsigned-reg)))
(:arg-types unsigned-num)
(:results (res :scs (unsigned-reg)))
(:result-types unsigned-num)
(:generator 1
(inst bsf res arg)))
;;;; binary conditional VOPs

14
src/compiler/x86/arith.lisp
View file

@ -1089,20 +1089,6 @@
(inst xor res res)
DONE))
;; The code on which this was based existed in no less than three varieties,
;; differing in response to 0 input: produce NIL, -1, or signal an error.
;; To avoid a thorny issue of proper semantics, this VOP is used only by
;; %BIT-POSITION which happens to declare zero safety, but always pre-checks
;; for zero. (the ltn-policy of :fast is actually irrelevant)
(define-vop (unsigned-word-find-first-bit)
(:policy :fast)
(:args (arg :scs (unsigned-reg)))
(:arg-types unsigned-num)
(:results (res :scs (unsigned-reg)))
(:result-types unsigned-num)
(:generator 1
(inst bsf res arg)))
(define-vop (unsigned-byte-32-count)
(:translate logcount)
(:note "inline (unsigned-byte 32) logcount")