master: Improve SSET capacity tracking and SSET-ADJOIN

The branch "master" has been updated in SBCL:
       via  173185836fb315946fd67df72a224c806a2f89e2 (commit)
      from  eba8865cfdc3cb46e88dc3197668285e84a0cbca (commit)

- Log -----------------------------------------------------------------
commit 173185836fb315946fd67df72a224c806a2f89e2
Author: Douglas Katzman <[email protected]>
Date:   Fri Jul 10 20:43:44 2026 +0000

    Improve SSET capacity tracking and SSET-ADJOIN
    
    * Since tombstones do not exist, there is no reason to separately
      record the available cell count and in-use element count.
    * SSET-ADJOIN need not eagerly grow the SSET except when the vector
      length is 0. Only if it discovers that it must insert and the
      capacity is reached should it call SSET-GROW.
    * SSET-GROW can avoid some conditional branching now that it won't
      be called with a vector length of 0.
    
    Test cases and some assistance by Gemini
---
 src/compiler/sset.lisp | 37 ++++++++++++++-----------------------
 tests/sset.pure.lisp   | 23 +++++++++++++++++++++++
 2 files changed, 37 insertions(+), 23 deletions(-)

diff --git a/src/compiler/sset.lisp b/src/compiler/sset.lisp
index d5726d410..c17fa8942 100644
--- a/src/compiler/sset.lisp
+++ b/src/compiler/sset.lisp
@@ -28,14 +28,12 @@
   (number nil :type (or index null)))
 
 (defstruct (sset (:copier nil)
-                 (:constructor %make-sset (vector free count)))
+                 (:constructor %make-sset (vector limit count)))
   ;; Vector containing the set values. 0 is used for empty (since
   ;; 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
-  ;; calculated from +sset-rehash-threshold+.
-  (free 0 :type index)
+  ;; The threshold count above which we double the vector.
+  (limit 0 :type index)
   ;; How many elements are currently members of the set.
   (count 0 :type index))
 (defun make-sset ()
@@ -70,39 +68,33 @@
 ;;; Double the size of the hash vector of SET.
 (defun sset-grow (set)
   (let* ((vector (sset-vector set))
-         (length (if (zerop (length vector))
-                     2
-                     (* (length vector) 2)))
+         (length (* (length vector) 2))
          (new-vector (make-array length
-                                 :initial-element 0)))
+                                 :initial-element 0))
+         (new-limit (- length (truncate length +sset-rehash-threshold+))))
     (setf (sset-vector set) new-vector
-          ;; SSET-ADJOIN below will decrement this and shouldn't reach zero
-          (sset-free set) length
+          (sset-limit set) new-limit
           (sset-count set) 0)
     (loop for element across vector
           do (unless (fixnump element)
-               (sset-adjoin element set)))
-    ;; Now the real amount of elements which can be inserted before rehashing
-    (setf (sset-free set) (- (sset-free set)
-                             (max 1 (truncate length
-                                              +sset-rehash-threshold+))))))
-
+               (sset-adjoin element set)))))
 
 ;;; Destructively add ELEMENT to SET. If ELEMENT was not in the set,
 ;;; then we return true, otherwise we return false.
 (declaim (ftype (sfunction (sset-element sset) boolean) sset-adjoin))
 (defun sset-adjoin (element set)
-  (when (= (sset-free set) 0)
-    (sset-grow set))
+  (when (zerop (length (sset-vector set)))
+    (setf (sset-vector set) (make-array 2 :initial-element 0)
+          (sset-limit set) 1))
   (loop with vector = (sset-vector set)
         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))
-                  (decf (sset-free set))
                   (setf (aref vector hash) element)
+                  (when (> (incf (sset-count set)) (sset-limit set))
+                    (sset-grow set))
                   (return t))
                  ((eq current element)
                   (return nil)))))
@@ -122,7 +114,6 @@
                     (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))
@@ -171,7 +162,7 @@
 ;;; Return a new copy of SET.
 (declaim (ftype (sfunction (sset) sset) copy-sset))
 (defun copy-sset (set)
-  (%make-sset (copy-seq (sset-vector set)) (sset-free set) (sset-count set)))
+  (%make-sset (copy-seq (sset-vector set)) (sset-limit set) (sset-count set)))
 
 ;;; Perform the appropriate set operation on SET1 and SET2 by
 ;;; destructively modifying SET1. We return true if SET1 was modified,
diff --git a/tests/sset.pure.lisp b/tests/sset.pure.lisp
index 1c2890579..51a0503d6 100644
--- a/tests/sset.pure.lisp
+++ b/tests/sset.pure.lisp
@@ -110,3 +110,26 @@
       (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)))))))
+
+(with-test (:name :sset-growth-optimization)
+  (let ((set (make-sset))
+        (e1 (make-dummy-test-element 1))
+        (e2 (make-dummy-test-element 2)))
+    ;; Initially empty, limit is 0
+    (assert (zerop (sb-c::sset-limit set)))
+    (assert (= (length (sset-vector set)) 0))
+
+    ;; Adjoin e1. Should grow to size 2, and count reaches limit.
+    (assert (sset-adjoin e1 set))
+    (assert (= (sb-c::sset-count set) (sb-c::sset-limit set)))
+    (assert (= (length (sset-vector set)) 2))
+
+    ;; Adjoin e1 again. Should NOT grow.
+    (assert (not (sset-adjoin e1 set)))
+    (assert (= (sb-c::sset-count set) (sb-c::sset-limit set)))
+    (assert (= (length (sset-vector set)) 2))
+
+    ;; Adjoin e2. Should grow to size 4.
+    (assert (sset-adjoin e2 set))
+    (assert (= (length (sset-vector set)) 4))))
+

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL