Re: master: Process smashed weak hash-table cells more quickly

// Running ctor.impure.lisp in COMPILE evaluator mode
While evaluating the form starting at line 37, column 0
  of #P"/home/runner/work/sbcl/sbcl/tests/ctor.impure.lisp":
Unhandled UNDEFINED-FUNCTION: The function COMMON-LISP:NIL is undefined.
Backtrace for: #<SB-THREAD:THREAD tid=60184 "main thread" RUNNING {1200030003}>
0: ("undefined function")
1: ((LAMBDA NIL :IN "/home/runner/work/sbcl/sbcl/tests/ctor.impure.lisp"))
2: (SB-INT:SIMPLE-EVAL-IN-LEXENV (ASSERT (TYPEP (FUNCALL (GETHASH
(QUOTE #) SB-PCL::*ALL-CTORS*)) (QUOTE NO-SLOTS))) #<NULL-LEXENV>)

On Mon, Dec 8, 2025 at 2:52 AM snuglas via Sbcl-commits
<[email protected]> wrote:
>
> The branch "master" has been updated in SBCL:
>        via  4450de63ff2aa1d5664468ae401e65dd38c01f20 (commit)
>       from  58c43d7c837f44ad39a704dea19cff31138d4889 (commit)
>
> - Log -----------------------------------------------------------------
> commit 4450de63ff2aa1d5664468ae401e65dd38c01f20
> Author: Douglas Katzman <[email protected]>
> Date:   Sun Dec 7 18:51:05 2025 -0500
>
>     Process smashed weak hash-table cells more quickly
>
>     The first (SETF GETHASH) operation on a given table after a GC now deletes
>     the entire list that GC constructed to transfer the indices of culled cells
>     to Lisp. This is not great because the list is consed in alloc_generation
>     following any particular collect_generation. That is, we can't always
>     allocate to generation 0. Nor can the construction of such list be delayed
>     until just before returning from collect_garbage, because that would lose
>     information about what was clobbered. So at worst, we still cons the list
>     in a high generation only because we are forced to.
>
>     There are a couple of solutions but none readily at hand.
>     My sense is that we should change weak tables to using an open-addressing
>     strategy wherein it would be legal to stuff tombstones into k/v cells
>     during GC, and have probing figure out what happened. (Like maybe
>     rehashing the table if there are too many tombstones)
> ---
>  src/code/target-hash-table.lisp | 87 +++++++++++++++++++++++++----------------
>  src/runtime/gc-common.c         |  7 +++-
>  2 files changed, 60 insertions(+), 34 deletions(-)
>
> diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp
> index 28b32351f..fbebdfe78 100644
> --- a/src/code/target-hash-table.lisp
> +++ b/src/code/target-hash-table.lisp
> @@ -13,6 +13,8 @@
>  (in-package "SB-IMPL")
>
>
> +(defvar *show-putweak* nil)
> +
>  (!begin-collecting-cold-init-forms)
>
>  (declaim (ftype (sfunction (hash-table t maybe-truncated-hash)
> @@ -2649,37 +2651,51 @@ nnnn 1_    any       linear scan (don't try to read when rehash already in progr
>    (declare (ignore default))
>    (%puthash key table new-value))
>
> -(defun hash-table-next-smashed-kv (hash-table)
> +(defun transfer-culled-cells (hash-table)
>    ;; Entries culled by GC are linked into a plain old list of cons cells,
>    ;; because we can atomically manipulate that. We can't atomically operate
>    ;; on the array-qua-list representation, both because we don't support
>    ;; numeric arrays in (CAS AREF) and lockfree deletion from interior nodes
>    ;; of singly-linked lists is tricky (a concurrent insert can get lost).
> -  (when (hash-table-smashed-cells hash-table)
> -    (binding* ((data (atomic-pop (hash-table-smashed-cells hash-table)))
> -               ((kv-index bucket) (etypecase data
> -                                   (fixnum (values (ldb (byte 14 14) data)
> -                                                   (ldb (byte 14 0) data)))
> -                                   (cons (values (car data) (cdr data)))))
> -               (index-vector (hash-table-index-vector hash-table))
> -               (next-vector (hash-table-next-vector hash-table))
> -               (this (aref index-vector bucket))
> -               (successor (aref next-vector this)))
> -      (if (= kv-index this)
> -          ;; This pair started a chain. Removing it is easy
> -          (setf (aref index-vector bucket) successor)
> -          ;; Else, find the kv-index in the chain and snap it out.
> -          (do ((predecessor this)
> -               (this successor))
> -              ((= this 0) (signal-corrupt-hash-table hash-table))
> -            (let ((successor (aref next-vector this)))
> -              (when (= kv-index this)
> -                (return (setf (aref next-vector predecessor) successor)))
> -              (setq predecessor this this successor))))
> -      ;; Set the 'next' at kv-index to the head of the ordinary freelist
> -      ;; so that when INSERT-AT pops the freelist, it stays correct.
> -      (setf (aref next-vector kv-index) (hash-table-next-free-kv hash-table))
> -      kv-index)))
> +  (unless (hash-table-smashed-cells hash-table)
> +    (return-from transfer-culled-cells))
> +  (let ((index-vector (hash-table-index-vector hash-table))
> +        (next-vector (hash-table-next-vector hash-table))
> +        (list (hash-table-smashed-cells hash-table)))
> +    (loop ; take ownership of the entire list in one CAS operation
> +     (let ((old (cas (hash-table-smashed-cells hash-table) list nil)))
> +       (if (eq old list) (return))
> +       (setq list old)))
> +    ;; TODO: special case if count = 0 then just reestablish the
> +    ;; initial conditions without processing one cell at a time.
> +    (loop
> +      (when (null list) (return))
> +      (binding* ((data (car list))
> +                 ((kv-index bucket) (etypecase data
> +                                      (fixnum (values (ldb (byte 14 14) data)
> +                                                      (ldb (byte 14 0) data)))
> +                                      (cons (values (car data) (cdr data)))))
> +                 (this (aref index-vector bucket))
> +                 (successor (aref next-vector this)))
> +        (let ((cdr (cdr list)))
> +          ;; Break up the the list in case GC sees an interior cell as an ambiguous root
> +          (rplacd list 0)
> +          (setq list cdr))
> +        (if (= kv-index this)
> +            ;; This pair started a chain. Removing it is easy
> +            (setf (aref index-vector bucket) successor)
> +            ;; Else, find the kv-index in the chain and snap it out.
> +            (do ((predecessor this)
> +                 (this successor))
> +                ((= this 0) (signal-corrupt-hash-table hash-table))
> +              (let ((successor (aref next-vector this)))
> +                (when (= kv-index this)
> +                  (return (setf (aref next-vector predecessor) successor)))
> +                (setq predecessor this this successor))))
> +        ;; Update the list headed by hash-table-next-free-kv and linked
> +        ;; through the 'next' vector.
> +        (setf (aref next-vector kv-index) (hash-table-next-free-kv hash-table)
> +              (hash-table-next-free-kv hash-table) kv-index)))))
>
>  ;;; We don't need the looping and checking for GC activiy in PUTHASH
>  ;;; because insertion can not co-occur with any other operation,
> @@ -2853,13 +2869,17 @@ nnnn 1_    any       linear scan (don't try to read when rehash already in progr
>
>    (defun puthash/weak (key hash-table value)
>      (declare (type hash-table hash-table) (optimize speed))
> +    ;; Delaying the transfer of culled cells could causee the linked list
> +    ;; denoting the cells to itself be promoted into a higher generation.
> +    ;; Ideally the list would be off-heap and not subject to GC. Attempting to
> +    ;; do that would engender two other problems: (1) knowing when to free the list
> +    ;; if the table becomes garbage and we had not yet processed - and thus freed -
> +    ;; the list. (2) GC can't call malloc()
> +    (transfer-culled-cells hash-table)
>      (with-weak-hash-table-entry
>        (declare (ignore predecessor))
>        (cond ((= physical-index 0)
> -             ;; There are two kinds of freelists. Prefer a smashed cell
> -             ;; so that we might shorten the chain it belonged to.
> -             (insert-at (or (hash-table-next-smashed-kv hash-table)
> -                            (hash-table-next-free-kv hash-table))
> +             (insert-at (hash-table-next-free-kv hash-table)
>                          hash-table key hash address-sensitive-p value))
>              ((or (empty-ht-slot-p (cas (weak-kvv-ref kv-vector (1+ physical-index))
>                                         probed-value value))
> @@ -3240,19 +3260,20 @@ table itself."
>  (defun hash-table-freelist (tbl)
>    (hash-table-chain tbl (hash-table-next-free-kv tbl)))
>
> -(defun show-chains (tbl &aux (nv (hash-table-next-vector tbl))
> +(defun show-chains (tbl &optional print &aux (nv (hash-table-next-vector tbl))
>                          (tot-len 0) (max-len 0) (n-chains 0))
> -  (flet ((show-chain (label next &aux (len 0))
> +  (flet ((show-chain (label next &optional print &aux (len 0))
>             (unless (eql next 0)
>               (write-string label)
>               (loop (format t " ~d" next)
> +                   (when print (format t "=~A" (aref (hash-table-pairs tbl) (ash next 1))))
>                     (incf len)
>                     (when (zerop (setq next (aref nv next))) (return)))
>               (terpri))
>             len))
>      (loop for x across (hash-table-index-vector tbl)
>            for i from 0
> -          do (let ((len (show-chain (format nil "Bucket ~d:" i) x)))
> +          do (let ((len (show-chain (format nil "Bucket ~d:" i) x print)))
>                 (when (plusp len)
>                   (incf tot-len len)
>                   (setf max-len (max len max-len))
> diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c
> index 2a5f686fd..ace25d5ec 100644
> --- a/src/runtime/gc-common.c
> +++ b/src/runtime/gc-common.c
> @@ -1761,7 +1761,12 @@ scav_vector_t(lispobj *where, lispobj header)
>  }
>
>  /* Walk through the chain whose first element is *FIRST and remove
> - * dead weak entries.
> + * dead weak entries. Such entries are linked into a list which is distinct
> + * from the list of free entries linked through the table's "next" vector.
> + * Because GC can run in the middle of any hash-table modification -
> + * since we no longer use WITHOUT-GCING around every weak table operation -
> + * this has to avoid touching the table structure itself. But it's fairly easy
> + * to create an ordinary list which is amenable to SB-EXT:ATOMIC-POP.
>   * Return the new value for 'should rehash'.
>   *
>   * This operation might have to touch a hash-table that is currently
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> [email protected]
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits


_______________________________________________
Sbcl-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits