From eff841d2c2e899fc9d9804cd0b292e0267733418 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Fri, 18 Aug 2006 13:19:05 +0000 Subject: [PATCH] code/hash-new.lisp: o Replace the magic value #x80000000 with +eq-based-hash-value+. lisp/gencgc.c: o Replace the magic value 0x80000000 with EQ_BASED_HASH_VALUE. o When freeing the hash entry, we forgot to reset the hash-vector entry to EQ_BASED_HASH_VALUE. --- code/hash-new.lisp | 39 ++++++++++++++++++++++++--------------- lisp/gencgc.c | 13 +++++++++++-- 2 files changed, 35 insertions(+), 17 deletions(-) diff --git a/code/hash-new.lisp b/code/hash-new.lisp index d86e90848..f1422c431 100644 --- a/code/hash-new.lisp +++ b/code/hash-new.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.42 2006/08/18 02:26:28 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.43 2006/08/18 13:19:05 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -73,9 +73,13 @@ ;; The Key-Value pair vector. (table (required-argument) :type simple-vector) ;; - ;; True if this is a weak hash table, meaning that key->value mappings will - ;; disappear if there are no other references to the key. Note: this only - ;; matters if the hash function indicates that the hashing is EQ based. + ;; Non-nil if this is a weak hash table. Four separate types of + ;; weakness are supported: :key, :value, :key-and-value, + ;; :key-or-value. The entry in the table is retained if the key, + ;; (respectively, value, key and value, key or value) is alive + ;; because it is referenced elsewhere. If the condition does not + ;; hold, the entry is removed. For tables with a weak key, EQL or + ;; EQ must be used as the test. (weak-p nil :type (member nil :key :value @@ -130,6 +134,10 @@ (deftype hash () `(integer 0 ,max-hash)) +;; This value in the hash-vector indicates the the key uses EQ-based +;; hashing (i.e., either EQ or EQL). +(defconstant +eq-based-hash-value+ #x80000000) + ;;;; Utility functions. @@ -295,7 +303,7 @@ :hash-vector (unless (eq test 'eq) (make-array size+1 :element-type '(unsigned-byte 32) - :initial-element #x80000000))))) + :initial-element +eq-based-hash-value+))))) ;; Setup the free list, all free. These lists are 0 ;; terminated. (do ((i 1 (1+ i))) @@ -363,7 +371,7 @@ (new-hash-vector (when old-hash-vector (make-array new-size :element-type '(unsigned-byte 32) - :initial-element #x80000000))) + :initial-element +eq-based-hash-value+))) (old-index-vector (hash-table-index-vector table)) (new-length (almost-primify (round (/ (float new-size) @@ -404,7 +412,7 @@ (hash-table-next-free-kv table)) (setf (hash-table-next-free-kv table) i)) ((and new-hash-vector - (not (= (aref new-hash-vector i) #x80000000))) + (not (= (aref new-hash-vector i) +eq-based-hash-value+))) ;; Can use the existing hash value (not EQ based) (let* ((hashing (aref new-hash-vector i)) (index (rem hashing new-length)) @@ -476,7 +484,7 @@ ;; Push this slot onto the free list. (setf (aref next-vector i) (hash-table-next-free-kv table)) (setf (hash-table-next-free-kv table) i)) - ((and hash-vector (not (= (aref hash-vector i) #x80000000))) + ((and hash-vector (not (= (aref hash-vector i) +eq-based-hash-value+))) ;; Can use the existing hash value (not EQ based) (let* ((hashing (aref hash-vector i)) (index (rem hashing length)) @@ -637,7 +645,7 @@ (when hash-vector (if (not eq-based) (setf (aref hash-vector free-kv-slot) hashing) - (assert (= (aref hash-vector free-kv-slot) #x80000000)))) + (assert (= (aref hash-vector free-kv-slot) +eq-based-hash-value+)))) ;; Push this slot into the next chain. (setf (aref next-vector free-kv-slot) next) @@ -691,7 +699,7 @@ (hash-table-next-free-kv hash-table)) (setf (hash-table-next-free-kv hash-table) next) (when hash-vector - (setf (aref hash-vector next) #x80000000)) + (setf (aref hash-vector next) +eq-based-hash-value+)) (decf (hash-table-number-entries hash-table)) t) ;; Search next-vector chain for a matching key. @@ -713,7 +721,7 @@ (hash-table-next-free-kv hash-table)) (setf (hash-table-next-free-kv hash-table) next) (when hash-vector - (setf (aref hash-vector next) #x80000000)) + (setf (aref hash-vector next) +eq-based-hash-value+)) (decf (hash-table-number-entries hash-table)) (return t)))) (t @@ -735,7 +743,7 @@ (hash-table-next-free-kv hash-table)) (setf (hash-table-next-free-kv hash-table) next) (when hash-vector - (setf (aref hash-vector next) #x80000000)) + (setf (aref hash-vector next) +eq-based-hash-value+)) (decf (hash-table-number-entries hash-table)) (return t))))))))) @@ -773,7 +781,7 @@ ;; Clear the hash-vector (when hash-vector (dotimes (i size) - (setf (aref hash-vector i) #x80000000)))) + (setf (aref hash-vector i) +eq-based-hash-value+)))) (setf (hash-table-number-entries hash-table) 0) hash-table) @@ -794,7 +802,7 @@ (new-hash-vector (when old-hash-vector (make-array new-size :element-type '(unsigned-byte 32) - :initial-element #x80000000))) + :initial-element +eq-based-hash-value+))) (new-length 37) (new-index-vector (make-array new-length :element-type '(unsigned-byte 32) @@ -1153,7 +1161,8 @@ `(make-hash-table :test ',(hash-table-test table) :size ',(hash-table-size table) :rehash-size ',(hash-table-rehash-size table) - :rehash-threshold ',(hash-table-rehash-threshold table)) + :rehash-threshold ',(hash-table-rehash-threshold table) + :weak-p (hash-table-weak-p table)) (let ((values nil)) (declare (inline maphash)) (maphash #'(lambda (key value) diff --git a/lisp/gencgc.c b/lisp/gencgc.c index 309aaf2eb..8f111fa0b 100644 --- a/lisp/gencgc.c +++ b/lisp/gencgc.c @@ -7,7 +7,7 @@ * * Douglas Crosher, 1996, 1997, 1998, 1999. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.80 2006/08/18 02:26:29 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.81 2006/08/18 13:19:05 rtoy Exp $ * */ @@ -26,6 +26,12 @@ #include "interr.h" #include "gencgc.h" +/* + * This value in a hash table hash-vector means that the key uses + * EQ-based hashing. That is, the key might be using EQ or EQL for + * the test. This MUST match the value used in hash-new.lisp! + */ +#define EQ_BASED_HASH_VALUE 0x80000000 #define gc_abort() lose("GC invariant lost! File \"%s\", line %d\n", \ __FILE__, __LINE__) @@ -3698,6 +3704,9 @@ free_hash_entry(struct hash_table *hash_table, int hash_index, int kv_index) kv_vector[2 * kv_index] = empty_symbol; kv_vector[2 * kv_index + 1] = empty_symbol; + if (hash_vector) { + hash_vector[kv_index] = EQ_BASED_HASH_VALUE; + } } } @@ -3739,7 +3748,7 @@ record_for_rehashing(struct hash_table *hash_table, int hash_index, static inline boolean eq_based_hash_vector(unsigned int* hash_vector, unsigned int index) { - return (hash_vector == 0) || (hash_vector[index] = 0x80000000); + return (hash_vector == 0) || (hash_vector[index] = EQ_BASED_HASH_VALUE); } static inline boolean -- GitLab