Re: [Sbcl-commits] master: Fix adaptive equal hash tables

I pushed a quick fix. It compiles and runs the tests now on x86. There are
a few warts (also related to weak hash tables) that I ran into while
investigating. Those will be addressed later.


On Mon, 8 Dec 2025 at 14:18, Stas Boukarev <[email protected]> wrote:

> That didn't fix the fixnum issue.
>
> On Mon, Dec 8, 2025 at 3:45 PM melisgl via Sbcl-commits
> <[email protected]> wrote:
> >
> > The branch "master" has been updated in SBCL:
> >        via  393fd97d93dbb805e0477c6d417aa2cf454d9605 (commit)
> >       from  018143647fdd3acd3ab67d7a981db8bc9ee774b7 (commit)
> >
> > - Log -----------------------------------------------------------------
> > commit 393fd97d93dbb805e0477c6d417aa2cf454d9605
> > Author: Gabor Melis <[email protected]>
> > Date:   Mon Dec 8 13:32:04 2025 +0100
> >
> >     Fix adaptive equal hash tables
> >
> >     ADAPTIVE-EQUAL-HASH was called with a single argument, and the second
> >     argument (the state) got garbage.
> > ---
> >  src/code/hash-table.lisp        |  6 +++---
> >  src/code/target-hash-table.lisp | 22 +++++++++++-----------
> >  2 files changed, 14 insertions(+), 14 deletions(-)
> >
> > diff --git a/src/code/hash-table.lisp b/src/code/hash-table.lisp
> > index 385b6f6c1..f98fd691b 100644
> > --- a/src/code/hash-table.lisp
> > +++ b/src/code/hash-table.lisp
> > @@ -81,14 +81,14 @@
> >    (puthash-impl #'error :type (sfunction * t))
> >    (remhash-impl #'error :type (sfunction * t))
> >    ;; If non-negative, this gets passed to HASH-TABLE-HASH-FUN as its
> > -  ;; second argument (see HASH-KEY and HT-HASH-SETUP). For a given
> > +  ;; second argument (see REHASH-KEY and HT-HASH-SETUP). For a given
> >    ;; HASH-TABLE-TEST, the same HASH-FUN-STATE cannot be an argument
> >    ;; for the different HASH-FUNs. Thus, it completely identifies the
> >    ;; hash function. It may be changed during the lifetime of the hash
> >    ;; table, which allows us to do adaptive hashing.
> >    (%hash-fun-state 0
> > -   ;; HASH-FUN-STATE easily fits into a fixnum, but having it unboxed
> > -   ;; as a signed word allows EQ-HASH/SMALL in EQ-HASH/COMMON to be
> > +   ;; HASH-FUN-STATE fits into a fixnum, but having it unboxed as a
> > +   ;; signed word allows EQ-HASH/SMALL in EQ-HASH/COMMON to be
> >     ;; compiled a bit more tightly.
> >     :type sb-vm:signed-word)
> >    ;; The Key-Value pair vector.
> > diff --git a/src/code/target-hash-table.lisp
> b/src/code/target-hash-table.lisp
> > index 365ab9795..6189a9ad1 100644
> > --- a/src/code/target-hash-table.lisp
> > +++ b/src/code/target-hash-table.lisp
> > @@ -138,6 +138,10 @@
> >    ;; is (UNSIGNED-BYTE 32).
> >    '(unsigned-byte #.(the (integer 0 32) (1+ +max-hash-table-bits+))))
> >
> > +(declaim (inline adaptive-hash-fun-state-p))
> > +(defun adaptive-hash-fun-state-p (state)
> > +  (<= 0 state))
> > +
> >  ;;; Hash KEY again after a hash function change. This is like
> >  ;;; HASH-KEY, but it's not inline, and it does not return
> >  ;;; ADDRESS-BASED-P because we assume that hash function changes
> > @@ -149,7 +153,7 @@
> >             (optimize (safety 0)))
> >    (let ((hash-fun (hash-table-hash-fun hash-table)))
> >      (the maybe-truncated-hash
> > -         (values (if (<= 0 hash-fun-state)
> > +         (values (if (adaptive-hash-fun-state-p hash-fun-state)
> >                       (funcall hash-fun key hash-fun-state)
> >                       (funcall hash-fun key))))))
> >
> > @@ -2036,6 +2040,7 @@ if there is no such entry. Entries can be added
> using SETF."
> >
> >    (defun ht-hash-setup (hash-fun-name stateful-hash-p)
> >      (cond ((null hash-fun-name)
> > +           (aver (not stateful-hash-p))
> >             '((hash (clip-hash (the fixnum
> >                                 (funcall (hash-table-hash-fun
> hash-table) key))))
> >               (address-based-p nil)))
> > @@ -2448,16 +2453,11 @@ nnnn 1_    any       linear scan (don't try to
> read when rehash already in progr
> >  (defmacro with-weak-hash-table-entry (&body body)
> >    `(with-pinned-objects (key)
> >       (binding* (((hash0 address-sensitive-p)
> > -                 ;; I'm pretty sure this is not how this code is
> supposed to look,
> > -                 ;; but it worked for me.
> > -                 (if (eq (hash-table-hash-fun hash-table)
> #'adaptive-equal-hash)
> > -                     (funcall (hash-table-hash-fun hash-table) key
> > -                              #+64-bit (hash-table-hash-fun-state
> hash-table)
> > -                              ;; adaptive-equal-hash says (truly-the
> fixnum sxstate) though the
> > -                              ;; slot's initial value is something like
> #x3999BA85 which accords
> > -                              ;; with its declared type of
> sb-vm:signed-word, but is non-fixnum.
> > -                              #-64-bit 0)
> > -                     (funcall (hash-table-hash-fun hash-table) key)))
> > +                 (let ((hash-fun (hash-table-hash-fun hash-table))
> > +                       (hash-fun-state (hash-table-hash-fun-state
> hash-table)))
> > +                   (if (adaptive-hash-fun-state-p hash-fun-state)
> > +                       (funcall hash-fun key hash-fun-state)
> > +                       (funcall hash-fun key))))
> >                  (address-sensitive-p
> >                   (and address-sensitive-p
> >                        (not (logtest (hash-table-flags hash-table)
> hash-table-userfun-flag))))
> >
> > -----------------------------------------------------------------------
> >
> >
> > hooks/post-receive
> > --
> > SBCL
> >
> >
> > _______________________________________________
> > Sbcl-commits mailing list
> > [email protected]
> > https://lists.sourceforge.net/lists/listinfo/sbcl-commits
>

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