Subject: bug#69864: 30.0.50; Problem with equal hash tables

From: Gerd Möllmann <[email-masked]>
Date: Sun, 17 Mar 2024 18:59:51 +0100

This is in master, 562d9c9db56172c754a2556a996245145ae223f5

I suspect we have a problem with equal hash-tables in master. Apply the
attached patch, configure with checking enabled, and build it.

diff --git a/src/fns.c b/src/fns.c
index 0a64e515402..9467c806975 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -4506,6 +4506,31 @@ hashfn_user_defined (Lisp_Object key, struct Lisp_Hash_Table *h)
   hashtest_equal = { .name = LISPSYM_INITIALLY (Qequal),
 		     .cmpfn = cmpfn_equal, .hashfn = hashfn_equal };
 
+static ptrdiff_t hash_index_index (struct Lisp_Hash_Table *h,
+				   hash_hash_t hash);
+
+static void
+check_table (struct Lisp_Hash_Table *h)
+{
+  ptrdiff_t n = hash_table_index_size (h);
+  for (ptrdiff_t bucket = 0; bucket < n; ++bucket)
+    {
+      ptrdiff_t next;
+      for (ptrdiff_t i = HASH_INDEX (h, bucket); i >= 0; i = next)
+        {
+	  next = HASH_NEXT (h, i);
+	  eassert (i >= 0 && i < HASH_TABLE_SIZE (h));
+
+	  Lisp_Object key = HASH_KEY (h, i);
+	  eassert (!hash_unused_entry_key_p (key));
+	  hash_hash_t hash = hash_from_key (h, key);
+	  eassert (hash == HASH_HASH (h, i));
+	  hash_idx_t bucket_now = hash_index_index (h, hash);
+	  eassert (bucket_now == bucket);
+	}
+    }
+}
+
 /* Allocate basically initialized hash table.  */
 
 static struct Lisp_Hash_Table *
@@ -4785,6 +4810,7 @@ hash_table_thaw (Lisp_Object hash_table)
 hash_lookup_with_hash (struct Lisp_Hash_Table *h,
 		       Lisp_Object key, hash_hash_t hash)
 {
+  check_table (h);
   ptrdiff_t start_of_bucket = hash_index_index (h, hash);
   for (ptrdiff_t i = HASH_INDEX (h, start_of_bucket);
        0 <= i; i = HASH_NEXT (h, i))

This adds a check that all collision lists of hash-tables are ok. I
originally added something similar in my local Emacs because I'm
changing the hash-table implementation, for reasons that have to do with
changing the GC.

The compilation will fail with 

  Loading /Users/gerd/emacs/savannah/master/lisp/emacs-lisp/cl-generic.el (source)...

  fns.c:4527: Emacs fatal error: assertion failed: hash == HASH_HASH (h, i)
  Fatal error 6: Aborted

I don't think I have an error in the checking code, but who knows.
If there's no error in the checks, then we might have a problem with
sxhash, I suspect.

LLDB session:

(lldb) r --batch  -l loadup --temacs=pbootstrap -dest /Users/gerd/emacs/savannah/master/nextstep/Emacs.app/Contents/MacOS/ --eln-dest /Users/gerd/emacs/savannah/master/nextstep/Emacs.app/Contents/Frameworks/
Process 90778 launched: '/Users/gerd/emacs/savannah/master/src/temacs' (x86_64)
...
Loading /Users/gerd/emacs/savannah/master/lisp/emacs-lisp/cl-generic.el (source)...

fns.c:4527: Emacs fatal error: assertion failed: hash == HASH_HASH (h, i)
Process 90778 stopped
* thread #1, queue = 'com.apple.main-thread', stop reason = signal SIGABRT
    frame #0: 0x00007ff80a71414a libsystem_kernel.dylib`__pthread_kill + 10
libsystem_kernel.dylib`__pthread_kill:
->  0x7ff80a71414a <+10>: jae    0x7ff80a714154            ; <+20>
    0x7ff80a71414c <+12>: movq   %rax, %rdi
    0x7ff80a71414f <+15>: jmp    0x7ff80a70db20            ; cerror_nocancel
    0x7ff80a714154 <+20>: retq   
(lldb) up 10
frame #10: 0x00000001002cc88c temacs`hash_lookup_with_hash(h=0x00007fb1f89211a0, key=(struct Lisp_Cons *) $4 = 0x00007fb1fbab76c0, hash=1339923535) at fns.c:4813:3
(lldb) do
frame #9: 0x00000001002d39f1 temacs`check_table(h=0x00007fb1f89211a0) at fns.c:4527:4
(lldb) p hash 
(hash_hash_t) 664518371
(lldb) p h->hash[i]
(hash_hash_t) 26984166
(lldb) xdebug_print h->key_and_value[2*i]
(#s(cl--generic cl-generic-generalizers ((0 #s(cl--generic-generalizer cl--generic-t-generalizer 0 (closure (cl-struct-cl--generic-generalizer-tags t) (_name &rest _) nil) (closure (cl-struct-cl--generic-generalizer-tags t) (_tag &rest _) '(t))))) (#s(cl--generic-method (t) (:extra "head") curried (closure (cl-struct-cl--generic-tags cl-struct-cl--generic-method-tags cl-struct-cl--generic-generalizer-tags t) (cl--nm) (let ((cl--nmp (if (cl--generic-isnot-nnm-p cl--nm) #'always #'ignore))) #'(lambda (&rest cl--args) "Support for (head VAL) specializers.
These match if the argument is a cons cell whose car is `eql' to VAL.

(fn SPECIALIZER)" (let ((cl--cnm #'(lambda (&rest args) (apply cl--nm (or args cl--args))))) (apply #'(lambda (cl--cnm specializer) (progn (if (not (eq (car-safe specializer) 'head)) (funcall cl--cnm) (let* ((v (car (cdr specializer))) (v cl--generic-head-used)) (or (gethash v v) (let* ((val specializer)) (progn (puthash v val v) val)))) (list cl--generic-head-generalizer)))) cl--cnm cl--args)))))) #s(cl--generic-method (t) nil nil (closure (cl-struct-cl--generic-tags cl-struct-cl--generic-method-tags cl-struct-cl--generic-generalizer-tags t) (specializer) "Support for the catch-all t specializer which always matches." (progn (if (eq specializer t) (list cl--generic-t-generalizer) (error "Unknown specializer %S" specializer)))))) nil) #s(cl--generic-method (t) nil nil (closure (cl-struct-cl--generic-tags cl-struct-cl--generic-method-tags cl-struct-cl--generic-generalizer-tags t) (specializer) "Support for the catch-all t specializer which always matches." (progn (if (eq specializer t) (list cl--generic-t-generalizer) (error "Unknown specializer %S" specializer))))))
(lldb) p h->test
(const hash_table_test *) 0x000000010049e7e8
(lldb) p h->frozen_test 
(hash_table_std_test_t) Test_eq | Test_equal
(lldb) p *h
(Lisp_Hash_Table) {
  header = (size = 4611686018662301696)
  index = 0x0000600001cf41a0
  hash = 0x0000600001cf4180
  key_and_value = 0x00006000038f4060 (struct Lisp_Symbol *) $27 = 0x000060010439bcb0
  test = 0x000000010049e7e8
  next = 0x0000600001cf4160
  count = 5
  next_free = 5
  table_size = 6
  index_bits = '\x03'
  weakness = Weak_Value
  frozen_test = Test_eq | Test_equal
  purecopy = false
  mutable = true
  next_weak = NULL
}
(lldb) xbacktrace 
(unsigned char *) data = 0x0000000100481d88 "gethash"
(unsigned char *) data = 0x00000001004812d4 "or"
(unsigned char *) data = 0x00000001004813af "let*"
(unsigned char *) data = 0x00000001004813ab "let"
(unsigned char *) data = 0x00000001004812db "if"
(unsigned char *) data = 0x00007fb1f8a41978 "cl--generic-build-combined-method"
(unsigned char *) data = 0x00000001004812db "if"
(unsigned char *) data = 0x00000001004813af "let*"
(unsigned char *) data = 0x00007fb1f8a41950 "cl--generic-make-next-function"
(unsigned char *) data = 0x00007fb1f8a40d58 "cl--generic-make-function"
(unsigned char *) data = 0x00000001004813ab "let"
(unsigned char *) data = 0x00000001004812e3 "progn"
(unsigned char *) data = 0x00000001004813af "let*"
(unsigned char *) data = 0x00000001004813ab "let"
(unsigned char *) data = 0x00000001004813af "let*"
(unsigned char *) data = 0x00000001004812e3 "progn"
(unsigned char *) data = 0x00000001004813af "let*"
(unsigned char *) data = 0x00007fb1f8a41478 "cl-generic-define-method"
(unsigned char *) data = 0x0000000100487f58 "eval-buffer"
(unsigned char *) data = 0x00000001004812db "if"
(unsigned char *) data = 0x00000001004813ab "let"
(unsigned char *) data = 0x00000001004813ab "let"
(unsigned char *) data = 0x00000001004813ef "unwind-protect"
(unsigned char *) data = 0x00000001004813ab "let"
(unsigned char *) data = 0x00000001004812db "if"
(unsigned char *) data = 0x00007fb1f883bb28 "load-with-code-conversion"
(unsigned char *) data = 0x0000000100486664 "load"
(unsigned char *) data = 0x0000000100486664 "load"