[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-devel
Subject:    Re: [Sbcl-devel] [Sbcl-commits] master: Make solist elements-per-bin a parameter
From:       Stas Boukarev <stassats () gmail ! com>
Date:       2023-01-21 21:27:39
Message-ID: CAF63=13ZgvYW98Uxnt8PycnrX139j6k7MyRpg8GKkSCc88ARxA () mail ! gmail ! com
[Download RAW message or body]

arm32:

; file: src/code/solist.lisp
; in: DEFUN SO-INSERT
;     (SB-EXT:CAS (SB-LOCKLESS::SO-THRESHOLD SB-LOCKLESS::TABLE)
;      SB-LOCKLESS::CUR-THRESHOLD SB-LOCKLESS::NEW-THRESHOLD)
;
; caught ERROR:
;   during XC macroexpansion of (CAS (SO-THRESHOLD TABLE)
CUR-THRESHOLD ...). Use
;   *BREAK-ON-SIGNALS* to intercept.
;
;    Cannot use COMPARE-AND-SWAP with structure accessor for a typed
slot: (SO-THRESHOLD
;
     TABLE)

On Sat, Jan 21, 2023 at 11:21 PM snuglas via Sbcl-commits
<sbcl-commits@lists.sourceforge.net> wrote:
>
> The branch "master" has been updated in SBCL:
>        via  050bf2fff3b2849430d812925aaf318913971804 (commit)
>       from  4a08a8eb4ea63ed5af054bcd803a1bcfb5614ad3 (commit)
>
> - Log -----------------------------------------------------------------
> commit 050bf2fff3b2849430d812925aaf318913971804
> Author: Douglas Katzman <dougk@google.com>
> Date:   Sat Jan 21 15:20:50 2023 -0500
>
>     Make solist elements-per-bin a parameter
> ---
>  src/code/solist.lisp             | 39 ++++++++++++++++++++++-----------------
>  src/compiler/generic/objdef.lisp |  7 ++++++-
>  2 files changed, 28 insertions(+), 18 deletions(-)
>
> diff --git a/src/code/solist.lisp b/src/code/solist.lisp
> index 711636b74..806c492a1 100644
> --- a/src/code/solist.lisp
> +++ b/src/code/solist.lisp
> @@ -219,10 +219,6 @@
>                     ,@(if rest '(bins+shift bins shift)))))
>       ,@body))
>
> -;;; The more bins there are, the more dummy nodes.
> -;;; Dummy nodes constitute extra space overhead.
> -(defconstant +desired-elts-per-bin+ 3)
> -
>  (defun so-insert (table key &optional (value nil valuep))
>    (when (and valuep (not (so-valuesp table)))
>      (error "~S is a set, not a map" table))
> @@ -233,20 +229,28 @@
>              (funcall (so-inserter table) start-node (logior hash 1) key))
>        (cond (foundp ; must not find a dummy node
>               ;; Note that in this case we do not update SO-DATA. The client of the table
> -             ;; should use the secondary value to notice that the node existed,
> +             ;; can use the secondary value to notice that the node existed,
>               ;; and pick an appropriate way to atomically update the node.
>               (aver (typep node 'so-key-node)))
> -            (t
> -             (let* ((n-bins (length bins))
> -                    (threshold (* n-bins +desired-elts-per-bin+)))
> -               (when (and (> (atomic-incf (so-count table)) threshold)
> -                          (> shift 1)) ; can't reduce the shift below 1
> -                 #+so-debug (format t "count = ~d thresh = ~d~%" new-count threshold)
> -                 (let ((new-bins (make-array (* 2 n-bins) :initial-element (make-unbound-marker))))
> -                   (dotimes (i n-bins)
> -                     (setf (aref new-bins (* i 2)) (aref bins i)))
> -                   ;; It makes no difference whether this CAS succeeds or fails!
> -                   (cas (so-bins table) bins+shift (cons new-bins (1- shift))))))))
> +            ((and (> (atomic-incf (so-count table)) (so-threshold table))
> +                  (> shift 1)) ; can't reduce the shift below 1
> +             ;; Try to compare-and-swap the threshold first before changing the bins.
> +             ;; This way, at most one thread should win, and rellocate bins.
> +             (let* ((cur-n-bins (length bins))
> +                    (new-n-bins (the index (* 2 cur-n-bins)))
> +                    (cur-threshold (so-threshold table))
> +                    (new-threshold (the index (* new-n-bins (so-elts-per-bin table)))))
> +               ;; These tables don't downsize ever (same as our HASH-TABLE), so just make sure
> +               ;; we're increasing the threshold.  Due to unusual scheduling of threads, it could
> +               ;; be that CUR-THRESHOLD is already larger than NEW-THRESHOLD.
> +               (when (and (> new-threshold cur-threshold)
> +                          (eql (cas (so-threshold table) cur-threshold new-threshold)
> +                               cur-threshold))
> +                 (let ((new-bins (make-array new-n-bins :initial-element (make-unbound-marker))))
> +                   (declare (optimize (sb-c::insert-array-bounds-checks 0)))
> +                   (dotimes (i cur-n-bins) (setf (aref new-bins (* i 2)) (aref bins i)))
> +                   ;; If the CAS fails, there was already at least another doubling in another thread.
> +                   (cas (so-bins table) bins+shift (cons new-bins (1- shift))) bins+shift)))))
>        (values node foundp))))
>
>  ;; This is like LFL-DELETE-MACRO but passes both a hash and a key
> @@ -331,7 +335,8 @@
>      (let ((so-list (apply #'%%make-split-ordered-list initial-bin args)))
>        ;; Start with 2 bins, only the first being initialized.
>        ;; Shift out all bits except 1 for the bin number.
> -      (setf (so-bins so-list) (cons (vector initial-bin (make-unbound-marker))
> +      (setf (so-threshold so-list) (* 2 (so-elts-per-bin so-list)) ; 2 bins
> +            (so-bins so-list) (cons (vector initial-bin (make-unbound-marker))
>                                      (- +hash-nbits+ 1)))
>        so-list)))
>
> diff --git a/src/compiler/generic/objdef.lisp b/src/compiler/generic/objdef.lisp
> index f64467e49..cac216ec2 100644
> --- a/src/compiler/generic/objdef.lisp
> +++ b/src/compiler/generic/objdef.lisp
> @@ -762,6 +762,9 @@ during backtrace.
>  ;; NODE-HASH is a fixnum. Negatives probably don't do the right thing
>  (eval-when (:compile-toplevel :load-toplevel :execute)
>    (defconstant +hash-nbits+ sb-vm:n-positive-fixnum-bits))
> +;;; The more bins there are, the more dummy nodes.
> +;;; Dummy nodes constitute extra space overhead.
> +(defparameter *desired-elts-per-bin* 4)
>  (sb-xc:defstruct (split-ordered-list
>                     (:include linked-list)
>                     (:conc-name so-)
> @@ -769,8 +772,10 @@ during backtrace.
>                     (:constructor %%make-split-ordered-list
>                      (head hashfun inserter deleter finder
>                       inequality equality valuesp)))
> +  (count 0 :type sb-ext:word)
> +  (threshold 0 :type sb-ext:word)
>    (hashfun #'error :type (sfunction (t) (and fixnum unsigned-byte)))
>    (bins '(#() . 1) :type (cons simple-vector (integer 1 (#.+hash-nbits+))))
> -  (count 0 :type sb-ext:word)
> +  (elts-per-bin *desired-elts-per-bin* :type (integer 1 20))
>    ;; If VALUESP is NIL, then this is a set, otherwise it is a map.
>    (valuesp nil))
>
> -----------------------------------------------------------------------
>
>
> hooks/post-receive
> --
> SBCL
>
>
> _______________________________________________
> Sbcl-commits mailing list
> Sbcl-commits@lists.sourceforge.net
> https://lists.sourceforge.net/lists/listinfo/sbcl-commits


_______________________________________________
Sbcl-devel mailing list
Sbcl-devel@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-devel
[prev in list] [next in list] [prev in thread] [next in thread]