diff --git a/bootfiles/19c/boot-2006-08-1-cross.lisp b/bootfiles/19c/boot-2006-08-1-cross.lisp new file mode 100644 index 0000000000000000000000000000000000000000..d6f5a0d02cb890eaddbc8014e52b60e8a88631c0 --- /dev/null +++ b/bootfiles/19c/boot-2006-08-1-cross.lisp @@ -0,0 +1,15 @@ +;; This simple file is used to bootstrap the weak hash table changes. +;; The cross-compile is only needed because we want to add four new +;; static symbols so the C code can access them. + +#+ppc +(load "target:tools/cross-scripts/cross-ppc-ppc-darwin.lisp") + +#+sparc +(load "target:tools/cross-scripts/cross-sparc-sparc.lisp") + +#+x86 +(load "target:tools/cross-scripts/cross-x86-x86.lisp") + + + diff --git a/code/hash-new.lisp b/code/hash-new.lisp index f9ea1319ad1976d3b1384d0847b8b4284d4adc8c..d86e90848841cbe6a334aa6f49a33973f4c326f0 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.41 2006/08/16 16:19:09 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/hash-new.lisp,v 1.42 2006/08/18 02:26:28 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -76,7 +76,11 @@ ;; 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. - (weak-p nil :type (member t nil)) + (weak-p nil :type (member nil + :key + :value + :key-and-value + :key-or-value)) ;; ;; Index into the next-vector, chaining together buckets that need ;; to be rehashed because their hashing is EQ based and the key has @@ -112,10 +116,13 @@ ;;; (defun %print-hash-table (ht stream depth) (declare (ignore depth) (stream stream)) - (print-unreadable-object (ht stream :identity t) - (format stream "~:[~;Weak ~]~A hash table, ~D entr~@:P" + (print-unreadable-object (ht stream :type t :identity t) + (format stream "~S ~S ~S ~S ~S ~D" + :test + (hash-table-test ht) + :weak-p (hash-table-weak-p ht) - (symbol-name (hash-table-test ht)) + :count (hash-table-number-entries ht)))) (defconstant max-hash most-positive-fixnum) @@ -206,13 +213,24 @@ approaching zero as the threshold approaches 0. Density 1 means an average of one entry per bucket. CMUCL Extension: - :WEAK-P -- If T, don't keep entries if the key would otherwise be - garbage." + :WEAK-P -- Weak hash table. An entry in the table is remains if the + condition holds: + + :KEY -- key is referenced elsewhere + :VALUE -- value is referenced elsewhere + :KEY-AND-VALUE -- key and value are referenced elsewhere + :KEY-OR-VALUE -- key or value is referenced elsewhere + + If the condition does not hold, the entry is removed. For + backward compatibility, a value of T is the same as :KEY." (declare (type (or function symbol) test) - (type index size) (type (member t nil) weak-p)) + (type index size) + (type (member t nil :key :value :key-and-value :key-or-value) weak-p)) (let ((rehash-size (if (integerp rehash-size) rehash-size (float rehash-size 1.0)))) + (when (eq weak-p t) + (setf weak-p :key)) (multiple-value-bind (test test-fun hash-fun) (cond ((or (eq test #'eq) (eq test 'eq)) @@ -246,14 +264,15 @@ (when weak-p (format *debug-io* ";; Creating unsupported weak-p hash table~%")) #+gencgc - (when (and weak-p (not (eq test 'eq))) + (when (and (member weak-p '(t :key :key-and-value :key-or-value)) + (not (member test '(eq eql)))) ;; I (rtoy) think the current GENCGC code really expects the ;; test to be EQ, but doesn't enforce it in any way. Let's ;; warn about it for now. ;; ;; XXX: Either fix GC to work with other tests, or change ;; this warning into an error. - (warn "Creating weak key hashtable with unsupported test: ~S" test)) + (error "Cannot make a weak ~A hashtable with test: ~S" weak-p test)) (let* ((index-vector (make-array length :element-type '(unsigned-byte 32) :initial-element 0)) diff --git a/compiler/ppc/parms.lisp b/compiler/ppc/parms.lisp index 38578c4815d4a8f33830804e3e9c3bc19484302e..e4d30082e72f100345056bafd375107e2310a4ee 100644 --- a/compiler/ppc/parms.lisp +++ b/compiler/ppc/parms.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.12 2006/06/30 18:41:24 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ppc/parms.lisp,v 1.13 2006/08/18 02:26:29 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -250,6 +250,12 @@ *current-region-end-addr* #+gencgc *scavenge-read-only-space* + + ;; Weak hash table support + :key + :value + :key-and-value + :key-or-value ;; Spare symbols. Rename these when you need to add some static ;; symbols and don't want to do a cross-compile. diff --git a/compiler/sparc/parms.lisp b/compiler/sparc/parms.lisp index 3fcff8c38a0b444733fd5db5108db18075b0614f..1eca6bb44ff6c4dc0ba5bfadc7d9d6d741dd73aa 100644 --- a/compiler/sparc/parms.lisp +++ b/compiler/sparc/parms.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/compiler/sparc/parms.lisp,v 1.51 2006/06/30 18:41:32 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/sparc/parms.lisp,v 1.52 2006/08/18 02:26:29 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -315,6 +315,12 @@ #+gencgc *scavenge-read-only-space* + ;; Types of weak hash tables + :key + :value + :key-and-value + :key-or-value + ;; Some spare static symbols. Useful for adding another static ;; symbol without having to do a cross-compile. Just rename one ;; of these to the desired name. diff --git a/lisp/gencgc.c b/lisp/gencgc.c index 4d0b85f29111ca0161d3a208618c12a7bd89e572..309aaf2ebed8f418b4b349d9988c541cd5e5b150 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.79 2006/08/16 16:19:09 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.80 2006/08/18 02:26:29 rtoy Exp $ * */ @@ -3736,6 +3736,98 @@ 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); +} + +static inline boolean +removable_weak_key(lispobj old_key, unsigned int index_value, boolean eq_hash_p) +{ + return (!survives_gc(old_key) + && eq_hash_p + && (index_value != 0)); +} + +static inline boolean +removable_weak_value(lispobj value, unsigned int index_value) +{ + /* + * The entry can be removed if the value can be GCed. + */ + return (!survives_gc(value) + && (index_value != 0)); +} + +static inline boolean +removable_weak_key_and_value(lispobj old_key, lispobj value, unsigned int index_value, + boolean eq_hash_p) +{ + boolean removable_key; + boolean removable_val; + + removable_key = (!survives_gc(old_key) + && eq_hash_p + && (index_value != 0)); + removable_val = (!survives_gc(value) + && (index_value != 0)); + + /* + * The entry must stay if the key and value are alive. In other + * words, the entry can be removed if the key or value can be GCed. + */ + return removable_key || removable_val; +} + +static inline boolean +removable_weak_key_or_value(lispobj old_key, lispobj value, unsigned int index_value, + boolean eq_hash_p) +{ + boolean removable_key; + boolean removable_val; + + removable_key = (!survives_gc(old_key) + && eq_hash_p + && (index_value != 0)); + removable_val = (!survives_gc(value) + && (index_value != 0)); + + /* + * The entry must be kept if either the key or value is alive. In + * other words, the entry can be removed only if both the key and + * value can be GCed. + */ + return (removable_key && removable_val); +} + +static void +maybe_record_for_rehashing(struct hash_table *hash_table, lispobj* kv_vector, + unsigned int length, + unsigned int old_index, + unsigned int i, + boolean eq_hash_p, + unsigned int index_value) +{ + lispobj new_key; + unsigned int new_index; + lispobj empty_symbol; + lispobj value; + + new_key = kv_vector[2 * i]; + value = kv_vector[2 * i + 1]; + new_index = EQ_HASH(new_key) % length; + empty_symbol = kv_vector[1]; + + if (old_index != new_index + && eq_hash_p + && index_value != 0 + && (new_key != empty_symbol + || (value != empty_symbol))) { + record_for_rehashing(hash_table, old_index, i); + } +} + /* Scavenge the keys and values of hash-table HASH_TABLE. WEAK non-zero means this function is called for a weak hash-table at the end of a GC. WEAK zero means this function is called for @@ -3743,7 +3835,7 @@ record_for_rehashing(struct hash_table *hash_table, int hash_index, scheduled for rehashing or removed. */ static void -scav_hash_entries(struct hash_table *hash_table, int weak, int removep) +scav_hash_entries(struct hash_table *hash_table, lispobj weak, int removep) { unsigned kv_length; lispobj *kv_vector; @@ -3768,45 +3860,58 @@ scav_hash_entries(struct hash_table *hash_table, int weak, int removep) for (i = 1; i < next_vector_length; i++) { lispobj old_key = kv_vector[2 * i]; + lispobj value = kv_vector[2 * i + 1]; unsigned int old_index = EQ_HASH(old_key) % length; - lispobj new_key; - unsigned int new_index; - - if (weak && !survives_gc(old_key) - && index_vector[old_index] != 0 - && (hash_vector == 0 || hash_vector[i] == 0x80000000)) { + boolean eq_hash_p = eq_based_hash_vector(hash_vector, i); + unsigned int index_value = index_vector[old_index]; + + if (((weak == KEY) + && removable_weak_key(old_key, index_value, + eq_hash_p)) + || ((weak == VALUE) + && removable_weak_value(value, index_value)) + || ((weak == KEY_AND_VALUE) + && removable_weak_key_and_value(old_key, value, index_value, eq_hash_p)) + || ((weak == KEY_OR_VALUE) + && removable_weak_key_or_value(old_key, value, index_value, eq_hash_p))) { if (removep) { free_hash_entry(hash_table, old_index, i); } } else { /* If the key is EQ-hashed and moves, schedule it for rehashing. */ -#if 0 - if ((i < 4) && (hash_table >= (void*)0x40000000)) { - fprintf(stderr, "scav_hash_entries: %p: %d\n", hash_table, i); - fprintf(stderr, " key = %p\n", kv_vector[2*i]); - fprintf(stderr, " val = %p\n", kv_vector[2*i+1]); - } -#endif scavenge(&kv_vector[2 * i], 2); +#if 0 new_key = kv_vector[2 * i]; new_index = EQ_HASH(new_key) % length; -#if 0 - if ((i < 4) && (hash_table >= (void*)0x40000000)) { - fprintf(stderr, " new key = %p\n", kv_vector[2*i]); - fprintf(stderr, " new val = %p\n", kv_vector[2*i+1]); - } -#endif if (old_index != new_index - && index_vector[old_index] != 0 - && (hash_vector == 0 || hash_vector[i] == 0x80000000) + && eq_hash_p + && index_value != 0 && (new_key != empty_symbol - || kv_vector[2 * i + 1] != empty_symbol)) - record_for_rehashing(hash_table, old_index, i); + || (value != empty_symbol))) { + record_for_rehashing(hash_table, old_index, i); + } +#endif + maybe_record_for_rehashing(hash_table, kv_vector, length, old_index, i, eq_hash_p, + index_value); } } } +static inline boolean +weak_key_survives(lispobj old_key, unsigned index_value, unsigned int eq_hash_p) +{ + return (survives_gc(old_key) + && index_value != 0 + && eq_hash_p); +} + +static inline boolean +weak_value_survives(lispobj value) +{ + return (survives_gc(value)); +} + /* Scavenge entries of the weak hash-table HASH_TABLE that haven't been already. Value is 1 if anything new has been scavenged, 0 otherwise. */ @@ -3828,27 +3933,55 @@ scav_weak_entries(struct hash_table *hash_table) for (i = 1; i < next_vector_length; i++) { lispobj old_key = kv_vector[2 * i]; + lispobj value = kv_vector[2 * i + 1]; unsigned int old_index = EQ_HASH(old_key) % length; + boolean eq_hash_p = eq_based_hash_vector(hash_vector, i); + boolean key_survives = weak_key_survives(old_key, + index_vector[old_index], eq_hash_p); + boolean value_survives = weak_value_survives(value); - /* If the key survives, scavenge its value, for the case that - the only reference to a key in a weak table is a value in - another weak table. Don't scavenge the value twice; - scan_weak_tables calls this function more than once for the - same hash table. */ - if (survives_gc(old_key) - && index_vector[old_index] != 0 - && (hash_vector == 0 || hash_vector[old_index] == 0x80000000) - && !survives_gc(kv_vector[2 * i + 1])) { -#if 0 - lispobj old_val; - old_val = kv_vector[2*i+1]; -#endif + + if ((hash_table->weak_p == KEY) + && key_survives + && !survives_gc(value)) { + /* + * For a weak key hash table, if the key survives, + * scavenge its value, for the case that the only + * reference to a key in a weak table is a value in + * another weak table. Don't scavenge the value twice; + * scan_weak_tables calls this function more than once for + * the same hash table. + */ scavenge(&kv_vector[2 * i + 1], 1); -#if 0 - fprintf(stderr, "scav_weak_entries: kv_vector[entry = %d] from %p to %p\n", - i, old_val, kv_vector[2*i+1]); -#endif scavenged = 1; + } else if ((hash_table->weak_p == VALUE) + && value_survives + && !survives_gc(old_key)) { + /* + * For a weak value hash table, scavenge the key, if the + * value survives gc. + */ + scavenge(&kv_vector[2 * i], 1); + maybe_record_for_rehashing(hash_table, kv_vector, length, old_index, i, eq_hash_p, + index_vector[old_index]); + scavenged = 1; + } else if ((hash_table->weak_p == KEY_AND_VALUE) + && key_survives && value_survives) { + /* There's nothing to do for key-and-value. Both are already alive */ + } else if ((hash_table->weak_p == KEY_OR_VALUE) + && (key_survives || value_survives)) { + /* For key-or-value, make sure the other is scavenged */ + if (key_survives && !survives_gc(value)) { + scavenge(&kv_vector[2 * i + 1], 1); + scavenged = 1; + } + if (value_survives && !survives_gc(old_key)) { + scavenge(&kv_vector[2 * i], 1); + maybe_record_for_rehashing(hash_table, kv_vector, length, old_index, i, + eq_hash_p, + index_vector[old_index]); + scavenged = 1; + } } } @@ -3881,7 +4014,7 @@ scav_weak_tables(void) struct hash_table *ht = (struct hash_table *) PTR(table); next = ht->next_weak_table; - scav_hash_entries(ht, 1, 0); + scav_hash_entries(ht, ht->weak_p, 0); } } @@ -3904,7 +4037,7 @@ scan_weak_tables(void) * Remove the entries in the table. (This probably does too * much work!) */ - scav_hash_entries(ht, 1, 1); + scav_hash_entries(ht, ht->weak_p, 1); } weak_hash_tables = NIL; @@ -3979,7 +4112,7 @@ scav_hash_vector(lispobj * where, lispobj object) scavenge((lispobj *) hash_table, HASH_TABLE_SIZE); if (hash_table->weak_p == NIL) { - scav_hash_entries(hash_table, 0, 1); + scav_hash_entries(hash_table, hash_table->weak_p, 1); } else if (hash_table->next_weak_table == NIL) { /* * Make sure we only add the table once, which means