master: Improve DO-CONSET-ELEMENTS a little more
snuglas via Sbcl-commits <[email protected]> Fri, 17 Jul 2026 17:38:38 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via e4cd2e2548718c3e4598769b2945f1b2c89bc6d8 (commit)
from 13527b1f60bf8b0f643790846051fad597390f5f (commit)
- Log -----------------------------------------------------------------
commit e4cd2e2548718c3e4598769b2945f1b2c89bc6d8
Author: Douglas Katzman <[email protected]>
Date: Fri Jul 17 13:35:29 2026 -0400
Improve DO-CONSET-ELEMENTS a little more
---
src/compiler/constraint.lisp | 32 ++++++++++++++++++++------------
1 file changed, 20 insertions(+), 12 deletions(-)
diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index 47de67f93..517b0013a 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -510,14 +510,13 @@
(maxword '#:max))
(declare (ignorable word minword maxword))
`(let ((,conset-vector (conset-vector ,conset))
- ;; WITH-VECTOR-DATA on the universe and treating it as simple-vector
- ;; henceforth could be a further optimization.
- (,universe *constraint-universe*))
+ (,universe
+ #-sb-xc-host (the simple-vector (sb-kernel:%array-data *constraint-universe*))
+ #+sb-xc-host *constraint-universe*))
(declare (optimize speed))
- ;; Notice that in the algorithm based on CTZ we don't actually have to restrict the scan
- ;; strictly between CONSET-MIN and CONSET-MAX, because those are just hints where to find
- ;; nonzero bits.
- #+(and (not sb-xc-host) (or arm64 x86-64)) ; ctz is not implemented everywhere
+ #-sb-xc-host
+ ;; Aligning to word boundaries is valid because MIN and MAX are merely hints about where
+ ;; nonzero bits exist.
(let ((,minword (floor (conset-min ,conset) sb-vm:n-word-bits))
(,maxword (floor (1- (conset-max ,conset)) sb-vm:n-word-bits)))
(aver (< (1- (conset-max ,conset)) (length ,universe)))
@@ -527,12 +526,21 @@
(do-anonymous () ((= ,word 0)) ; no NIL block, so RETURN in body gets totally out
(let ((,constraint
(locally (declare (optimize (insert-array-bounds-checks 0)))
- (aref ,universe (+ (* ,index sb-vm:n-word-bits) (count-trailing-zeros ,word))))))
- ,@body)
- ;; Clear the lowest 1 bit via the Brian Kernighan technique (allegedly)
- (setq ,word (logand ,word (sb-vm::+-mod64 ,word -1)))))
+ (aref ,universe
+ ;; COUNT-TRAILING-ZEROS produces slightly better code than
+ ;; INTEGER-LENGTH. Either iteration direction is ok.
+ (logior (sb-c::if-vop-existsp (:translate count-trailing-zeros)
+ (prog1 (count-trailing-zeros ,word)
+ ;; Clear the lowest 1 bit via the Brian Kernighan
+ ;; technique (allegedly)
+ (setq ,word (logand ,word (sb-vm::+-mod64 ,word -1))))
+ (let ((bit (1- (integer-length ,word))))
+ (setq ,word (logxor ,word (ash 1 bit)))
+ bit))
+ (* ,index sb-vm:n-word-bits))))))
+ ,@body)))
finally (return ,result)))
- #+(or sb-xc-host (not (or arm64 x86-64)))
+ #+sb-xc-host
(loop for ,index from (conset-min ,conset) below (conset-max ,conset)
do (when (plusp (sbit ,conset-vector ,index))
(let ((,constraint (aref ,universe ,index)))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL