master: Change SSET to not use tombstones
snuglas via Sbcl-commits <[email protected]> Fri, 10 Jul 2026 01:17:39 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 1ce38f9567389d2ee8700bdbaa29cffd750c3b9b (commit)
from 81229e243f106a5e8405079315b902ea09e21c4d (commit)
- Log -----------------------------------------------------------------
commit 1ce38f9567389d2ee8700bdbaa29cffd750c3b9b
Author: Douglas Katzman <[email protected]>
Date: Fri Jul 10 01:05:52 2026 +0000
Change SSET to not use tombstones
Avoids 1 comparison and branch in the probe loop
---
doc/internals-notes/sset.txt | 82 +++++++++++++++++++++++++++++
src/cold/exports.lisp | 2 +-
src/compiler/copyprop.lisp | 9 +++-
src/compiler/sset.lisp | 120 +++++++++++++++++++++----------------------
tests/sset.pure.lisp | 112 ++++++++++++++++++++++++++++++++++++++++
5 files changed, 262 insertions(+), 63 deletions(-)
diff --git a/doc/internals-notes/sset.txt b/doc/internals-notes/sset.txt
new file mode 100644
index 000000000..71a9765ef
--- /dev/null
+++ b/doc/internals-notes/sset.txt
@@ -0,0 +1,82 @@
+from Gemini -
+
+This large dataset provides a highly reliable profile of SSET usage in real-world compilation workloads.
+Based on this data, we compare the current Double Hashing with Tombstones design against the proposed
+Linear Probing with Knuth Deletion (New SSET) design.
+
+Aggregated Metrics Summary
+Metric Value
+Total Files Analyzed 1,492
+Total SSETs Allocated 23,689,952
+Total SSET API Calls 232,174,147
+Average Allocated Vector Size 6.75
+Average Active Element Count 3.22
+Max Allocated Vector Size 16,384 (1 occurrence)
+Max Active Element Count 1,772
+
+SSET API Operation Breakdown
+Adjoin (Insert): 116,764,137 (50.29%)
+Member (Lookup): 77,723,416 (33.48%)
+Delete: 22,734,716 (9.79%)
+Set Operations (Union/Intersection/Diff):
+ 14,951,878 (6.44%)
+
+Key Findings & Analysis
+1. SSETs are Extremely Small
+The size distribution of the SSET hash vectors is heavily skewed towards tiny sizes:
+
+=== Global Vector Size Distribution ===
+ Size 0 (Empty): 12,082,756 (51.00%) [Cumulative: 51.00%]
+ Size 2 : 3,096,767 (13.07%) [Cumulative: 64.08%]
+ Size 4 : 2,783,510 (11.75%) [Cumulative: 75.83%]
+ Size 8 : 2,186,659 ( 9.23%) [Cumulative: 85.06%]
+ Size 16 : 1,878,172 ( 7.93%) [Cumulative: 92.98%]
+ Size 32 : 1,078,565 ( 4.55%) [Cumulative: 97.54%]
+ Size 64 : 424,278 ( 1.79%) [Cumulative: 99.33%]
+ -------------------------------------------------------------
+ Size >= 128 : 158,945 ( 0.67%) [Cumulative: 100.00%]
+92.98% of all SSETs have a vector size of 16 or less.
+97.54% have a vector size of 32 or less.
+The average active element count is only 3.22.
+
+NOTE
+On modern 64-bit systems, a cache line is 64 bytes, which holds exactly 8 pointers.
+A simple-vector of size 2, 4, or 8 (along with its header) fits entirely within a single cache line.
+Even a vector of size 16 fits in just two cache lines.
+
+2. Linear Probing Cache Win
+Because SSETs are tiny, Linear Probing is highly optimal:
+
+* A linear scan of a size 2–16 vector will almost always result in zero cache misses
+ after the first element is accessed.
+* Double Hashing requires computing two separate hash values (calling sset-hash2)
+ and probing non-sequential slots, which increases instruction count and can cause
+ additional cache line lookups for larger vectors.
+
+3. Negligible Knuth Deletion Cost
+The primary drawback of the new SSET is that sset-delete using the Knuth shifting algorithm is
+O(N) because it needs to shift elements to fill deleted slots, whereas the old tombstone
+deletion is O(1).
+
+* Our data shows the Delete ratio (Delete / (Adjoin + Member)) is only 11.69%.
+ Since 93% of SSETs have size <= 16 the maximum number of elements that ever need to be shifted
+ during a delete is bounded by a very small constant (typically <= 3)
+ Shifting 3 pointers in cache-resident memory takes only a few CPU instructions.
+
+* The O(N) worst-case cost of Knuth deletion is practically non-existent in this workload.
+
+4. Better Lookup Paths (No Tombstone Bloat)
+In the old SSET, deleted elements are marked with a tombstone (-1). Over time, if a set
+undergoes many adjoins and deletes, the table fills up with tombstones. This increases the
+probe sequence length for subsequent lookups (Member), as they must scan past tombstones.
+
+The new SSET completely eliminates tombstones, ensuring lookup paths are always bounded by
+the actual active elements currently in the set.
+
+Recommendation
+We should proceed with the new-sset (Linear Probing with Knuth deletion).
+
+The data shows that SSETs are too small to benefit from double-hashing's collision distribution
+properties. Instead, they are the perfect size to benefit from linear probing's cache locality
+and low overhead. The cost of Knuth deletion is entirely mitigated by the small table sizes
+and low deletion frequency.
diff --git a/src/cold/exports.lisp b/src/cold/exports.lisp
index 1892d97ac..d8d47ed2a 100644
--- a/src/cold/exports.lisp
+++ b/src/cold/exports.lisp
@@ -513,7 +513,7 @@ possibly temporarily, because it might be used internally.")
"MAKE-SSET"
"SSET" "SSET-ELEMENT"
"SSET-ADJOIN" "SSET-DELETE" "SSET-EMPTY" "SSET-COUNT"
- "SSET-MEMBER"
+ "SSET-MEMBER" "SSET-DIFFERENCE"
;; key-only hash lookup which saves space over a hash-table
"MAKE-HASHSET" "HASHSET-INSERT" "HASHSET-REMOVE" "HASHSET-FIND"
diff --git a/src/compiler/copyprop.lisp b/src/compiler/copyprop.lisp
index 6a631d4a8..6b7b8e9cf 100644
--- a/src/compiler/copyprop.lisp
+++ b/src/compiler/copyprop.lisp
@@ -252,8 +252,13 @@
;; Kill any elements in IN that are copies of a TN we are clobbering.
(do ((res-ref (vop-results vop) (tn-ref-across res-ref)))
((null res-ref))
- (do-sset-elements (tn in)
- (when (eq (tn-is-copy-of tn) (tn-ref-tn res-ref))
+ ;; DO-SSET-ELEMENTS no longer allows deleting the item you're looking at,
+ ;; because SSET-DELETE rearranges items instead of depositing tombstones.
+ (let ((to-delete nil))
+ (do-sset-elements (tn in)
+ (when (eq (tn-is-copy-of tn) (tn-ref-tn res-ref))
+ (push tn to-delete)))
+ (dolist (tn to-delete)
(sset-delete tn in))))
;; If this VOP is a copy, add the copy TN to IN.
(when this-copy (sset-adjoin this-copy in)))))
diff --git a/src/compiler/sset.lisp b/src/compiler/sset.lisp
index d78e91d55..d5726d410 100644
--- a/src/compiler/sset.lisp
+++ b/src/compiler/sset.lisp
@@ -30,8 +30,7 @@
(defstruct (sset (:copier nil)
(:constructor %make-sset (vector free count)))
;; Vector containing the set values. 0 is used for empty (since
- ;; initializing a vector with 0 is cheaper than with NIL), -1
- ;; is a tombstone left in place of a deleted element.
+ ;; initializing a vector with 0 is cheaper than with NIL).
(vector #() :type simple-vector)
;; How many elements can be inserted before rehashing.
;; This is not the actual amount of free elements, but a ratio
@@ -55,17 +54,14 @@
,@body)
finally (return ,result)))
-;;; Primary hash.
-(declaim (inline sset-hash1))
-(defun sset-hash1 (element) (mix (sset-element-number element) 0))
-
-;;; Secondary hash (for double hash probing). Needs to return an odd
-;;; number.
-(declaim (inline sset-hash2))
-(defun sset-hash2 (element)
- (let ((number (sset-element-number element)))
- (declare (fixnum number))
- (logior 1 number)))
+;;; There is no "Primary" or "Secondary" hash now. Just the hash.
+;;; We use Linear Probing (step size = 1) with Knuth's Backward Shift Deletion
+;;; algorithm instead of leaving tombstones. And we rely on MIX to produce
+;;; a sufficiently good hash that linear probing is a reasonable strategy.
+;;; (Any probing strategy other than linear does not so readily admit a
+;;; deletion technique which shifts other elements on top of the deleted one.)
+(declaim (inline sset-hash))
+(defun sset-hash (element) (mix (sset-element-number element) 0))
;;; Rehash the sset when the proportion of free cells in the set is
;;; lower than this, the value is a reciprocal.
@@ -99,22 +95,15 @@
(when (= (sset-free set) 0)
(sset-grow set))
(loop with vector = (sset-vector set)
- with mask of-type fixnum = (1- (length vector))
- with secondary-hash = (sset-hash2 element)
- with deleted-index
- for hash of-type index = (logand mask (sset-hash1 element)) then
- (logand mask (+ hash secondary-hash))
+ with mask of-type index = (1- (length vector))
+ for hash of-type index = (logand mask (sset-hash element)) then
+ (logand mask (1+ hash))
for current = (aref vector hash)
do (cond ((eql current 0)
(incf (sset-count set))
- (cond (deleted-index
- (setf (aref vector deleted-index) element))
- (t
- (decf (sset-free set))
- (setf (aref vector hash) element)))
+ (decf (sset-free set))
+ (setf (aref vector hash) element)
(return t))
- ((eql current -1)
- (unless deleted-index (setf deleted-index hash)))
((eq current element)
(return nil)))))
@@ -122,20 +111,34 @@
;;; then return true, otherwise return false.
(declaim (ftype (sfunction (sset-element sset) boolean) sset-delete))
(defun sset-delete (element set)
- (when (zerop (length (sset-vector set)))
- (return-from sset-delete nil))
- (loop with vector = (sset-vector set)
- with mask fixnum = (1- (length vector))
- with secondary-hash = (sset-hash2 element)
- for hash of-type index = (logand mask (sset-hash1 element)) then
- (logand mask (+ hash secondary-hash))
- for current = (aref vector hash)
- do (cond ((eql current 0)
- (return nil))
- ((eq current element)
- (decf (sset-count set))
- (setf (aref vector hash) -1)
- (return t)))))
+ (let ((vector (sset-vector set)))
+ (when (zerop (length vector))
+ (return-from sset-delete nil))
+ (loop with mask of-type index = (1- (length vector))
+ for hash of-type index = (logand mask (sset-hash element)) then
+ (logand mask (1+ hash))
+ for current = (aref vector hash)
+ do (cond ((eql current 0)
+ (return nil))
+ ((eq current element)
+ (decf (sset-count set))
+ (incf (sset-free set))
+ (loop with i of-type index = hash
+ do (loop for j of-type index = (logand mask (1+ i)) then
+ (logand mask (1+ j))
+ for candidate = (aref vector j)
+ do (cond ((eql candidate 0)
+ (setf (aref vector i) 0)
+ (return-from sset-delete t))
+ ((>= (the fixnum
+ (logand mask
+ (- j (logand mask (sset-hash candidate)))))
+ (the fixnum
+ (logand mask (- j i))))
+ (setf (aref vector i) candidate
+ i j)
+ (return)))))
+ (return t))))))
;;; Return true if ELEMENT is in SET, false otherwise.
(declaim (ftype (sfunction (sset-element sset) boolean) sset-member))
@@ -144,9 +147,8 @@
(return-from sset-member nil))
(loop with vector = (sset-vector set)
with mask fixnum = (1- (length vector))
- with secondary-hash = (sset-hash2 element)
- for hash of-type index = (logand mask (sset-hash1 element)) then
- (logand mask (+ hash secondary-hash))
+ for hash of-type index = (logand mask (sset-hash element)) then
+ (logand mask (1+ hash))
for current = (aref vector hash)
do (cond ((eq current element) (return t))
((eql current 0) (return nil)))))
@@ -183,26 +185,24 @@
(when (sset-adjoin element set1)
(setf modified t)))
finally (return modified)))
+
(defun sset-intersection (set1 set2)
- (loop with modified = nil
- for element across (sset-vector set1)
- for index of-type index from 0
- do (unless (fixnump element)
- (unless (sset-member element set2)
- (decf (sset-count set1))
- (setf (aref (sset-vector set1) index) -1
- modified t)))
- finally (return modified)))
+ (let ((to-delete nil))
+ (do-sset-elements (element set1)
+ (unless (sset-member element set2)
+ (push element to-delete)))
+ (when to-delete
+ (dolist (element to-delete t)
+ (sset-delete element set1)))))
+
(defun sset-difference (set1 set2)
- (loop with modified = nil
- for element across (sset-vector set1)
- for index of-type index from 0
- do (unless (fixnump element)
- (when (sset-member element set2)
- (decf (sset-count set1))
- (setf (aref (sset-vector set1) index) -1
- modified t)))
- finally (return modified)))
+ (let ((to-delete nil))
+ (do-sset-elements (element set1)
+ (when (sset-member element set2)
+ (push element to-delete)))
+ (when to-delete
+ (dolist (element to-delete t)
+ (sset-delete element set1)))))
;;; Destructively modify SET1 to include its union with the difference
;;; of SET2 and SET3. We return true if SET1 was modified, false
diff --git a/tests/sset.pure.lisp b/tests/sset.pure.lisp
new file mode 100644
index 000000000..1c2890579
--- /dev/null
+++ b/tests/sset.pure.lisp
@@ -0,0 +1,112 @@
+(import sb-c::'(make-sset sset-adjoin sset-delete copy-sset
+ sset-union sset-intersection sset-difference
+ sset-member sset-empty
+ sset-vector sset-count))
+
+(defstruct (dummy-test-element (:include sb-c::sset-element)
+ (:constructor make-dummy-test-element (number))))
+
+(with-test (:name :new-sset-basic-operations)
+ (let ((set (make-sset))
+ (e1 (make-dummy-test-element 10))
+ (e2 (make-dummy-test-element 20))
+ (e3 (make-dummy-test-element 30))
+ (e4 (make-dummy-test-element 40)))
+ (assert (sset-empty set))
+ (assert (not (sset-member e1 set)))
+
+ ;; Adjoin
+ (assert (sset-adjoin e1 set))
+ (assert (not (sset-adjoin e1 set))) ; already present
+ (assert (sset-adjoin e2 set))
+ (assert (sset-adjoin e3 set))
+ (assert (= (sset-count set) 3))
+ (assert (sset-member e1 set))
+ (assert (sset-member e2 set))
+ (assert (sset-member e3 set))
+ (assert (not (sset-member e4 set)))
+
+ ;; Check no tombstones (-1) exist in vector
+ (loop for x across (sset-vector set)
+ do (assert (not (eql x -1))))
+
+ ;; Delete
+ (assert (sset-delete e2 set))
+ (assert (not (sset-delete e2 set))) ; already deleted
+ (assert (= (sset-count set) 2))
+ (assert (sset-member e1 set))
+ (assert (not (sset-member e2 set)))
+ (assert (sset-member e3 set))
+
+ ;; Check no tombstones (-1) exist in vector after delete
+ (loop for x across (sset-vector set)
+ do (assert (not (eql x -1))))
+
+ (assert (sset-delete e1 set))
+ (assert (sset-delete e3 set))
+ (assert (sset-empty set))
+ (loop for x across (sset-vector set)
+ do (assert (not (eql x -1))))))
+
+(with-test (:name :new-sset-shift-deletion-stress)
+ (let ((set (make-sset))
+ (elems (loop for i from 1 to 100 collect (make-dummy-test-element i))))
+ (dolist (e elems)
+ (sset-adjoin e set))
+ (assert (= (sset-count set) 100))
+ ;; Delete every second element
+ (loop for e in elems by #'cddr
+ do (assert (sset-delete e set)))
+ (assert (= (sset-count set) 50))
+ (loop for x across (sset-vector set)
+ do (assert (not (eql x -1))))
+ (loop for e in elems
+ for i from 0
+ do (if (evenp i)
+ (assert (not (sset-member e set)))
+ (assert (sset-member e set))))
+ (loop for e in (cdr elems) by #'cddr
+ do (assert (sset-delete e set)))
+ (assert (sset-empty set))
+ (loop for x across (sset-vector set)
+ do (assert (not (eql x -1))))))
+
+(with-test (:name :new-sset-set-operations)
+ (let ((s1 (make-sset))
+ (s2 (make-sset))
+ (e1 (make-dummy-test-element 1))
+ (e2 (make-dummy-test-element 2))
+ (e3 (make-dummy-test-element 3))
+ (e4 (make-dummy-test-element 4)))
+ (sset-adjoin e1 s1)
+ (sset-adjoin e2 s1)
+ (sset-adjoin e3 s1)
+
+ (sset-adjoin e2 s2)
+ (sset-adjoin e3 s2)
+ (sset-adjoin e4 s2)
+
+ ;; Union
+ (let ((u (copy-sset s1)))
+ (sset-union u s2)
+ (assert (= (sset-count u) 4))
+ (assert (sset-member e4 u))
+ (loop for x across (sset-vector u) do (assert (not (eql x -1)))))
+
+ ;; Intersection
+ (let ((i (copy-sset s1)))
+ (sset-intersection i s2)
+ (assert (= (sset-count i) 2))
+ (assert (not (sset-member e1 i)))
+ (assert (sset-member e2 i))
+ (assert (sset-member e3 i))
+ (loop for x across (sset-vector i) do (assert (not (eql x -1)))))
+
+ ;; Difference
+ (let ((d (copy-sset s1)))
+ (sset-difference d s2)
+ (assert (= (sset-count d) 1))
+ (assert (sset-member e1 d))
+ (assert (not (sset-member e2 d)))
+ (assert (not (sset-member e3 d)))
+ (loop for x across (sset-vector d) do (assert (not (eql x -1)))))))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits