Subject: [clisp-list] Bug in hash tables?

From: Matt Cross <[email-masked]>
Date: Tue Dec 2 13:44:02 2003

I'm running clisp-2.31 on Windows 2000.  When I run the code at the end of 
this message, it ends up with some entries in the hash table twice (once 
with the value 't' and once with the correct numeric value).  Am I doing 
something incorrect or is this a bug in clisp?

	-Matt

(defun hashtbl-keys (hashtbl)
   (let ((keys ()))
     (maphash #'(lambda (key value)
                  (push key keys) )
              hashtbl)
     keys ) )

(defun check-hash-unique (hashtbl)
   (let ((hash-ok t))
     (do* ((keys (hashtbl-keys hashtbl) (cdr keys))
           (key (car keys) (car keys))
           (other-keys (cdr keys) (cdr keys)) )

          ((null keys) hash-ok)

          (if (member key other-keys)
            (progn
              (format t "ERROR! key '~a' occurs multiple times in the hash 
table!~%" key)
              (setf hash-ok nil) ) ) ) ) )

(defparameter *hashtbl* (make-hash-table :size 1000))

(defun do-hash-test ()
   (loop for countval upfrom 1 upto 15000
         for newsym = (gensym)
         do
         (progn
           (gethash newsym *hashtbl*)
           (setf (gethash newsym *hashtbl*) t)
           (setf (gethash newsym *hashtbl*) countval) )
         finally
         (check-hash-unique *hashtbl*) ) )

---

From: Sam Steingold <[email-masked]>
Date: Tue Dec 2 16:08:03 2003

> * Matt Cross <[email-masked]> [2003-12-02 16:43:10 -0500]:
>
> I'm running clisp-2.31 on Windows 2000.  When I run the code at the
> end of this message, it ends up with some entries in the hash table
> twice (once with the value 't' and once with the correct numeric
> value).  Am I doing something incorrect or is this a bug in clisp?

indeed this is a bug.
moreover, this appears to be a GC-related bug:

(defun hash-table-keys (ht)
  (loop :for kk :being :each :hash-key :of ht :collect kk))
(defun check-hash-unique (ht)
  (let ((hash-ok t))
    (do* ((keys (hash-table-keys ht) (cdr keys))
          (key (car keys) (car keys))
          (other-keys (cdr keys) (cdr keys)))
         ((null keys) hash-ok)
      (when (member key other-keys)
        (format t "ERROR! key ~s occurs multiple times!~%" key)
        (setf hash-ok nil)))))

(defun do-hash-test (ht)
  (clrhash ht)
  (loop for countval upfrom 1 upto 15000
    for key = (format nil "HT-~D" countval)
    do
      (gethash key ht)
      (setf (gethash key ht) t)
      (setf (gethash key ht) countval)
    finally
      (check-hash-unique ht)))

(loop :repeat 2 :do
  (loop :with ht = (make-hash-table :size 1000)
    :for i :from 1 :to 10 :do
    (format t "~& --- ~d ---~%" i)
    (do-hash-test ht)))

 --- 1 ---
ERROR! key "HT-12138" occurs multiple times!
 --- 2 ---
ERROR! key "HT-12138" occurs multiple times!
 --- 3 ---
 --- 4 ---
ERROR! key "HT-8090" occurs multiple times!
ERROR! key "HT-5394" occurs multiple times!
ERROR! key "HT-2398" occurs multiple times!
 --- 5 ---
ERROR! key "HT-12138" occurs multiple times!
 --- 6 ---
 --- 7 ---
ERROR! key "HT-5395" occurs multiple times!
 --- 8 ---
ERROR! key "HT-12136" occurs multiple times!
ERROR! key "HT-8091" occurs multiple times!
ERROR! key "HT-3597" occurs multiple times!
 --- 9 ---
 --- 10 ---
 --- 1 ---
ERROR! key "HT-3597" occurs multiple times!
 --- 2 ---
ERROR! key "HT-5395" occurs multiple times!
 --- 3 ---
ERROR! key "HT-12137" occurs multiple times!
ERROR! key "HT-8092" occurs multiple times!
 --- 4 ---
ERROR! key "HT-12138" occurs multiple times!
 --- 5 ---
ERROR! key "HT-12138" occurs multiple times!
 --- 6 ---
 --- 7 ---
ERROR! key "HT-12137" occurs multiple times!
ERROR! key "HT-3597" occurs multiple times!
 --- 8 ---
ERROR! key "HT-1599" occurs multiple times!
 --- 9 ---
 --- 10 ---
ERROR! key "HT-5395" occurs multiple times!

note that you get two _different_ error logs for the inner loop!
if you replace the strings with (GC-invariant) fixnums, the bug hides.

this appears to have been introduced on 2003-05-16 with the
DEFINE-HASH-TABLE-TEST patch.
I don't see anything in hash_lookup() that could have triggered this.
I don't have time for this now, I hope Bruno will look into this.

>               (format t "ERROR! key '~a' occurs multiple times in the
>               hash table!~%" key)

-- 
Sam Steingold (http://www.podval.org/~sds) running w2k
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.honestreporting.com>
All extremists should be taken out and shot.

---

From: Pascal J.Bourguignon <[email-masked]>
Date: Wed Dec 3 03:41:01 2003

> moreover, this appears to be a GC-related bug:

It  does  not  happen  in  "2.30  (released  2002-09-15)  ..."  either
interpreted or compiled.

-- 
__Pascal_Bourguignon__                          http://www.informatimago.com/
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Living free in Alaska or in Siberia, a grizzli's life expectancy is 35 years,
but no more than 8 years in captivity.           http://www.theadvocates.org/

---

From: Sam Steingold <[email-masked]>
Date: Thu Dec 4 13:33:03 2003

> value).  Am I doing something incorrect or is this a bug in clisp?

this is a bug in CLISP, introduced on 2003-05-13.
Please try the appended patch.

-- 
Sam Steingold (http://www.podval.org/~sds) running w2k
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.honestreporting.com>
Those who can laugh at themselves will never cease to be amused.

--- hashtabl.d.~1.57.~	2003-10-27 09:34:27.700910400 -0500
+++ hashtabl.d	2003-12-04 16:28:05.421879500 -0500
@@ -1148,20 +1148,26 @@
 }
 
 /* Macro: Enlarges a hash-table until freelist /= nix
- hash_prepare_store(key_pos);
- > int literal: key position in STACK
+ hash_prepare_store(hash_pos,key_pos);
  > int literal: hash-table position in STACK
+ > int literal: key position in STACK
  < object ht: hash-table
  < object freelist: start of the free-list in the next-vector, /= nix
  < gcv_object_t* Iptr: arbitrary element of the "list", that belongs to the key
+ for EQ/EQL hashtables the hash code changes after GC,
+ so the raw hashcode cannot be cached.
+ for EQUAL/EQUALP/user-defined hashtables, raw hashcode caching is good
+ (especially for the user-defined tables, where hashcode can trigger GC!)
  can trigger GC */
 #define hash_prepare_store(hash_pos,key_pos)                            \
-  do { var uintL hc_raw = hashcode_raw(STACK_(hash_pos),STACK_(key_pos)); \
-    ht = STACK_(hash_pos);                                              \
-   retry:                                                               \
+  do { ht = STACK_(hash_pos);                                           \
     freelist = TheHashtable(ht)->ht_freelist;                           \
     if (eq(freelist,nix)) { /* free-list = empty "list" ? */            \
-      /* yes -> hash-table must be enlarged: */                         \
+      var uintB flags = record_flags(TheHashtable(ht));                 \
+      var uintL hc_raw = 0;                                             \
+      var bool cacheable = !(flags & (bit(0)|bit(1))); /* not EQ|EQL */ \
+      if (cacheable) hc_raw = hashcode_raw(ht,STACK_(key_pos));         \
+     retry: /* hash-table must still be enlarged: */                    \
       /* calculate new maxcount: */                                     \
       pushSTACK(TheHashtable(ht)->ht_maxcount);                         \
       pushSTACK(TheHashtable(ht)->ht_rehash_size); /* REHASH-SIZE (>1) */ \
@@ -1171,9 +1177,12 @@
       ht = resize(STACK_(hash_pos),value1); /* enlarge table */         \
       ht = rehash(ht); /* and reorganize */                             \
       /* newly calculate the address of the entry in the index-vector: */ \
-     {var uintL hashindex = hashcode_cook(hc_raw,TheHashtable(ht)->ht_size); \
+     {var uintL hashindex = cacheable                                   \
+         ? hashcode_cook(hc_raw,TheHashtable(ht)->ht_size)              \
+         : hashcode(ht,STACK_(key_pos));                                \
       Iptr = &TheSvector(TheHashtable(ht)->ht_itable)->data[hashindex];} \
-      goto retry;                                                        \
+     freelist = TheHashtable(ht)->ht_freelist;                          \
+     if (eq(freelist,nix)) goto retry;                                  \
     }                                                                   \
   } while(0)

---

From: Fred Cohen <[email-masked]>
Date: Thu Dec 4 14:00:02 2003

Per the message sent by Sam Steingold:

...
> +++ hashtabl.d	2003-12-04 16:28:05.421879500 -0500

Ouch! I don't see a hashtabl.d in my clisp sources...  and I have seen
no errors in my clisp! And I compiled from a fairly recent source about
a month ago.  What am I missing?

FC

-- This communication is confidential to the parties it is intended to serve --
Fred Cohen - http://all.net/ - [email-masked] - [email-masked] - tel/fax: 925-454-0171
Fred Cohen & Associates	- University of New Haven - Security Posture

---

From: Sam Steingold <[email-masked]>
Date: Thu Dec 4 14:27:05 2003

> * Fred Cohen <[email-masked]> [2003-12-04 14:03:34 -0800]:
>
> no errors in my clisp! And I compiled from a fairly recent source
> about a month ago.  What am I missing?

<clisp/src/hashtabl.d>

-- 
Sam Steingold (http://www.podval.org/~sds) running w2k
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.honestreporting.com>
(let ((a "(let ((a %c%s%c)) (format a 34 a 34))")) (format a 34 a 34))

---

From: Fred Cohen <[email-masked]>
Date: Thu Dec 4 15:33:02 2003

> Please try the appended patch.

clisp-2.31/src>patch hashtabl.d patch                                                                        
patching file hashtabl.d
patch: **** malformed patch at line 35: @@ -1171,9 +1177,12 @@

ll hashtabl.d
-rw-rw-r--    1 500      500         85102 May 24  2003 hashtabl.d

Is there a particular different approach I should take to this patch?

FC

---

From: Sam Steingold <[email-masked]>
Date: Fri Dec 5 05:22:04 2003

> * Fred Cohen <[email-masked]> [2003-12-04 15:36:57 -0800]:
>

this is a simple unified diff and should have worked OOTB.
please try CVS.

-- 
Sam Steingold (http://www.podval.org/~sds) running w2k
<http://www.camera.org> <http://www.iris.org.il> <http://www.memri.org/>
<http://www.mideasttruth.com/> <http://www.honestreporting.com>
Abandon all hope, all ye who press Enter.

---

From: Matt Cross <[email-masked]>
Date: Tue Dec 9 08:10:03 2003

>Please try the appended patch.

Sorry it took me a while to get to trying this patch.  It fixes the problem 
for me.  Thanks for your quick work on this!

I've also come up with quicker test code, some flavor of this may be useful 
to add to the test suite:

(defun check-hash-unique (hashtbl size)
   (let* ((array-size (+ size 1))
          (keys (make-array array-size :initial-element nil))
          (hash-ok t) )
     (loop for key being the hash-keys of hashtbl
           for key-num = (read-from-string (symbol-name key))

           when (svref keys key-num)
           do
           (progn
             (format t "Key '~a' occurs multiple times in the hash 
table!~%" key)
             (setf hash-ok nil) )
           else
           do
           (setf (svref keys key-num) t) )
     hash-ok ) )

(defun do-hash-test (&optional (entries 150000))
    (clrhash *hashtbl*)
    (loop for countval upfrom 1 upto entries
          for newsym = (intern (format nil "~a" countval))
          do
          (progn
            (gethash newsym *hashtbl*)
            (setf (gethash newsym *hashtbl*) t)
            (setf (gethash newsym *hashtbl*) countval) )
          finally return
          (progn
            (format t "built table, now checking...~%")
            (check-hash-unique *hashtbl* entries) ) ) )