Re: master: Fix adaptive equal hash tables

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-commits mailing list
[email protected]
https://lists.sourceforge.net/lists/listinfo/sbcl-commits