From 1479483c5f40fc470053da0fc5cd8e42fc77676e Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Fri, 15 Sep 2006 14:39:44 +0000 Subject: [PATCH] 0.9.16.32: weak hash tables The implementation is based on cmucl's weak hash table code. * scav_vector defers scavenging of weak hash tables until ... * ... newspace scavenging at which time the deferred weak hash tables are scavenged according to their WEAKNESS type (this happens after each scan of newspace) * finally just before weak pointers are scanned (i.e. with the purpose of breaking them) the weak hash tables are scanned (i.e. the appropriate entries are removed) too. --- NEWS | 1 + package-data-list.lisp-expr | 2 +- src/code/hash-table.lisp | 12 +- src/code/target-hash-table.lisp | 80 +++++---- src/compiler/fndb.lisp | 2 +- src/compiler/generic/parms.lisp | 8 +- src/compiler/x86/parms.lisp | 3 +- src/runtime/cheneygc.c | 23 +-- src/runtime/gc-common.c | 356 +++++++++++++++++++++++++++++++++++++++ src/runtime/gc-internal.h | 9 + src/runtime/gencgc.c | 241 ++------------------------ tests/compiler.pure.lisp | 8 +- tests/hash.impure.lisp | 134 +++++++++++++++ tests/stress-gc.lisp | 21 +++ version.lisp-expr | 2 +- 15 files changed, 612 insertions(+), 290 deletions(-) diff --git a/NEWS b/NEWS index 4c2a480..f83a6a9 100644 --- a/NEWS +++ b/NEWS @@ -1,5 +1,6 @@ ;;;; -*- coding: utf-8; -*- changes in sbcl-0.9.17 (0.9.99?) relative to sbcl-0.9.16: + * feature: weak hash tables, see MAKE-HASH-TABLE documentation * incompatible change: External-format support for FFI calls. The SB-ALIEN:C-STRING no longer implies an ASCII external-format. Instead the string is subject to external-format diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 2058cdf..306d232 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -665,7 +665,7 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*." ;; weak pointers and finalization "CANCEL-FINALIZATION" "FINALIZE" - "HASH-TABLE-WEAK-P" "MAKE-WEAK-POINTER" + "HASH-TABLE-WEAKNESS" "MAKE-WEAK-POINTER" "WEAK-POINTER" "WEAK-POINTER-P" "WEAK-POINTER-VALUE" ;; If the user knows we're doing IEEE, he might reasonably diff --git a/src/code/hash-table.lisp b/src/code/hash-table.lisp index 1811acf..9f2a6b4 100644 --- a/src/code/hash-table.lisp +++ b/src/code/hash-table.lisp @@ -39,11 +39,13 @@ (number-entries 0 :type index) ;; The Key-Value pair vector. (table (missing-arg) :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. - (weak-p nil :type (member t nil)) + ;; This slot is used to link weak hash tables during GC. When the GC + ;; isn't running it is always NIL. + (next-weak-hash-table nil :type null) + ;; Non-NIL if this is some kind of weak hash table. For details see + ;; the docstring of MAKE-HASH-TABLE. + (weakness nil :type (member nil :key :value :key-or-value :key-and-value) + :read-only t) ;; Index into the next-vector, chaining together buckets that need ;; to be rehashed because their hashing is EQ based and the key has ;; been moved by the garbage collector. diff --git a/src/code/target-hash-table.lisp b/src/code/target-hash-table.lisp index 51d6537..8947388 100644 --- a/src/code/target-hash-table.lisp +++ b/src/code/target-hash-table.lisp @@ -105,10 +105,10 @@ (defconstant +min-hash-table-rehash-threshold+ (float 1/16 1.0)) (defun make-hash-table (&key (test 'eql) - (size +min-hash-table-size+) - (rehash-size 1.5) - (rehash-threshold 1) - (weak-p nil)) + (size +min-hash-table-size+) + (rehash-size 1.5) + (rehash-threshold 1) + (weakness nil)) #!+sb-doc "Create and return a new hash table. The keywords are as follows: :TEST -- Indicates what kind of test to use. @@ -122,13 +122,20 @@ forcing a rehash. Can be any positive number <=1, with density approaching zero as the threshold approaches 0. Density 1 means an average of one entry per bucket. - :WEAK-P -- (This is an extension from CMU CL, not currently supported - in SBCL 0.6.6, but perhaps supported in a future version.) If T, - don't keep entries if the key would otherwise be garbage." + :WEAKNESS -- IF NIL (the default) it is a normal non-weak hash table. + If one of :KEY, :VALUE, :KEY-AND-VALUE, :KEY-OR-VALUE it is a weak + hash table. + Depending on the type of weakness the lack of references to the + key and the value may allow for removal of the entry. If WEAKNESS + is :KEY and the key would otherwise be garbage the entry is eligible + for removal from the hash table. Similarly, if WEAKNESS is :VALUE + the life of an entry depends on its value's references. If WEAKNESS + is :KEY-AND-VALUE and either the key or the value would otherwise be + garbage the entry can be removed. If WEAKNESS is :KEY-OR-VALUE and + both the key and the value would otherwise be garbage the entry can + be removed." (declare (type (or function symbol) test)) (declare (type unsigned-byte size)) - (when weak-p - (error "stub: unsupported WEAK-P option")) (multiple-value-bind (test test-fun hash-fun) (cond ((or (eq test #'eq) (eq test 'eq)) (values 'eq #'eq #'eq-hash)) @@ -143,8 +150,8 @@ ;; Failing that, I'd like to rename it to ;; *USER-HASH-TABLE-TESTS*. (dolist (info *hash-table-tests* - (error "unknown :TEST for MAKE-HASH-TABLE: ~S" - test)) + (error "unknown :TEST for MAKE-HASH-TABLE: ~S" + test)) (destructuring-bind (test-name test-fun hash-fun) info (when (or (eq test test-name) (eq test test-fun)) (return (values test-name test-fun hash-fun))))))) @@ -162,7 +169,7 @@ ;; boxing. (rehash-threshold (max +min-hash-table-rehash-threshold+ (float rehash-threshold 1.0))) - (size+1 (1+ size)) ; The first element is not usable. + (size+1 (1+ size)) ; The first element is not usable. ;; KLUDGE: The most natural way of expressing the below is ;; (round (/ (float size+1) rehash-threshold)), and indeed ;; it was expressed like that until 0.7.0. However, @@ -181,8 +188,9 @@ :element-type '(unsigned-byte #.sb!vm:n-word-bits) :initial-element 0)) - ;; needs to be the same length as the KV vector - ;; (FIXME: really? why doesn't the code agree?) + ;; Needs to be the half the length of the KV vector to link + ;; KV entries - mapped to indeces at 2i and 2i+1 - + ;; together. (next-vector (make-array size+1 :element-type '(unsigned-byte #.sb!vm:n-word-bits))) @@ -196,7 +204,7 @@ :rehash-threshold rehash-threshold :rehash-trigger size :table kv-vector - :weak-p weak-p + :weakness weakness :index-vector index-vector :next-vector next-vector :hash-vector @@ -244,9 +252,9 @@ "Return the test HASH-TABLE was created with.") #!+sb-doc -(setf (fdocumentation 'hash-table-weak-p 'function) - "Return T if HASH-TABLE will not keep entries for keys that would - otherwise be garbage, and NIL if it will.") +(setf (fdocumentation 'hash-table-weakness 'function) + "Return the WEAKNESS of HASH-TABLE which is one of NIL, :KEY, +:VALUE, :KEY-AND-VALUE, :KEY-OR-VALUE.") ;;;; accessing functions @@ -279,7 +287,7 @@ (old-index-vector (hash-table-index-vector table)) (new-length (almost-primify (truncate (/ (float new-size) - (hash-table-rehash-threshold table))))) + (hash-table-rehash-threshold table))))) (new-index-vector (make-array new-length :element-type '(unsigned-byte #.sb!vm:n-word-bits) @@ -289,6 +297,10 @@ ;; Disable GC tricks on the OLD-KV-VECTOR. (set-header-data old-kv-vector sb!vm:vector-normal-subtype) + ;; Non-empty weak hash tables always need GC support. + (when (and (hash-table-weakness table) (plusp (hash-table-count table))) + (set-header-data new-kv-vector sb!vm:vector-valid-hashing-subtype)) + ;; FIXME: here and in several other places in the hash table code, ;; loops like this one are used when FILL or REPLACE would be ;; appropriate. why are standard CL functions not used? @@ -368,9 +380,11 @@ (length (length index-vector))) (declare (type index size length)) - ;; Disable GC tricks, they will be re-enabled during the re-hash - ;; if necesary. - (set-header-data kv-vector sb!vm:vector-normal-subtype) + ;; Non-empty weak hash tables always need GC support. + (unless (and (hash-table-weakness table) (plusp (hash-table-count table))) + ;; Disable GC tricks, they will be re-enabled during the re-hash + ;; if necessary. + (set-header-data kv-vector sb!vm:vector-normal-subtype)) ;; Rehash all the entries. (setf (hash-table-next-free-kv table) 0) @@ -536,7 +550,8 @@ (hash-vector (hash-table-hash-vector hash-table)) (test-fun (hash-table-test-fun hash-table))) (declare (type index index)) - + (when (hash-table-weakness hash-table) + (set-header-data kv-vector sb!vm:vector-valid-hashing-subtype)) (cond ((or eq-based (not hash-vector)) (when eq-based (set-header-data kv-vector @@ -682,7 +697,7 @@ ;; Set up the free list, all free. (do ((i 1 (1+ i))) ((>= i (1- size))) - (setf (aref next-vector i) (1+ i))) + (setf (aref next-vector i) (1+ i))) (setf (aref next-vector (1- size)) 0) (setf (hash-table-next-free-kv hash-table) 1) (setf (hash-table-needing-rehash hash-table) 0) @@ -717,8 +732,12 @@ (let* ((kv-vector (hash-table-table hash-table)) (key (aref kv-vector (* 2 i))) (value (aref kv-vector (1+ (* 2 i))))) - (unless (and (eq key +empty-ht-slot+) - (eq value +empty-ht-slot+)) + ;; We are running without locking or WITHOUT-GCING. For a weak + ;; :VALUE hash table it's possible that the GC hit after KEY + ;; was read and now the entry is gone. So check if either the + ;; key or the value is empty. + (unless (or (eq key +empty-ht-slot+) + (eq value +empty-ht-slot+)) (funcall fun key value)))))) ;;;; methods on HASH-TABLE @@ -726,16 +745,11 @@ ;;; Return a list of keyword args and values to use for MAKE-HASH-TABLE ;;; when reconstructing HASH-TABLE. (defun %hash-table-ctor-args (hash-table) - (when (hash-table-weak-p hash-table) - ;; FIXME: This might actually work with no trouble, but as of - ;; sbcl-0.6.12.10 when this code was written, weak hash tables - ;; weren't working yet, so I couldn't test it. When weak hash - ;; tables are supported again, this should be fixed. - (error "can't dump weak hash tables readably")) ; defensive programming.. `(:test ',(hash-table-test hash-table) :size ',(hash-table-size hash-table) :rehash-size ',(hash-table-rehash-size hash-table) - :rehash-threshold ',(hash-table-rehash-threshold hash-table))) + :rehash-threshold ',(hash-table-rehash-threshold hash-table) + :weakness ',(hash-table-weakness hash-table))) ;;; Return an association list representing the same data as HASH-TABLE. (defun %hash-table-alist (hash-table) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index 7414ebc..68036a2 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -793,7 +793,7 @@ (&key (:test callable) (:size unsigned-byte) (:rehash-size (or (integer 1) (float (1.0)))) (:rehash-threshold (real 0 1)) - (:weak-p t)) + (:weakness (member nil :key :value :key-and-value :key-or-value))) hash-table (flushable unsafe)) (defknown hash-table-p (t) boolean (movable foldable flushable)) diff --git a/src/compiler/generic/parms.lisp b/src/compiler/generic/parms.lisp index 79ebe65..ac0043e 100644 --- a/src/compiler/generic/parms.lisp +++ b/src/compiler/generic/parms.lisp @@ -53,4 +53,10 @@ sb!unix::*interrupts-enabled* sb!unix::*interrupt-pending* *gc-inhibit* - *gc-pending*)) + *gc-pending* + + ;; hash table weaknesses + :key + :value + :key-and-value + :key-or-value)) diff --git a/src/compiler/x86/parms.lisp b/src/compiler/x86/parms.lisp index 816db31..0df6e5b 100644 --- a/src/compiler/x86/parms.lisp +++ b/src/compiler/x86/parms.lisp @@ -343,8 +343,7 @@ sb!alien::*enter-alien-callback* ;; see comments in ../x86-64/parms.lisp - sb!pcl::..slot-unbound.. - ))) + sb!pcl::..slot-unbound..))) (defparameter *static-funs* '(length diff --git a/src/runtime/cheneygc.c b/src/runtime/cheneygc.c index 60bd5af..4e5c135 100644 --- a/src/runtime/cheneygc.c +++ b/src/runtime/cheneygc.c @@ -222,11 +222,16 @@ collect_garbage(generation_index_t ignore) /* Scan the weak pointers. */ #ifdef PRINTNOISE + printf("Scanning weak hash tables ...\n"); +#endif + scan_weak_hash_tables(); + + /* Scan the weak pointers. */ +#ifdef PRINTNOISE printf("Scanning weak pointers ...\n"); #endif scan_weak_pointers(); - /* Flip spaces. */ #ifdef PRINTNOISE printf("Flipping spaces ...\n"); @@ -296,6 +301,7 @@ scavenge_newspace(void) here,new_space_free_pointer); */ next = new_space_free_pointer; scavenge(here, next - here); + scav_weak_hash_tables(); here = next; } /* printf("done with newspace\n"); */ @@ -489,20 +495,6 @@ print_garbage(lispobj *from_space, lispobj *from_space_free_pointer) } -/* vector-like objects */ - -static long -scav_vector(lispobj *where, lispobj object) -{ - if (HeaderValue(object) == subtype_VectorValidHashing) { - *where = - (subtype_VectorMustRehash<weakness; + long i; + + kv_vector = get_array_data(hash_table->table, + SIMPLE_VECTOR_WIDETAG, &kv_length); + if (kv_vector == NULL) + lose("invalid kv_vector %x\n", hash_table->table); + + index_vector = get_array_data(hash_table->index_vector, + SIMPLE_ARRAY_WORD_WIDETAG, &length); + if (index_vector == NULL) + lose("invalid index_vector %x\n", hash_table->index_vector); + + next_vector = get_array_data(hash_table->next_vector, + SIMPLE_ARRAY_WORD_WIDETAG, + &next_vector_length); + if (next_vector == NULL) + lose("invalid next_vector %x\n", hash_table->next_vector); + + hash_vector = get_array_data(hash_table->hash_vector, + SIMPLE_ARRAY_WORD_WIDETAG, + &hash_vector_length); + if (hash_vector != NULL) + gc_assert(hash_vector_length == next_vector_length); + + /* These lengths could be different as the index_vector can be a + * different length from the others, a larger index_vector could + * help reduce collisions. */ + gc_assert(next_vector_length*2 == kv_length); + + empty_symbol = kv_vector[1]; + /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/ + if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) != + SYMBOL_HEADER_WIDETAG) { + lose("not a symbol where empty-hash-table-slot symbol expected: %x\n", + *(lispobj *)native_pointer(empty_symbol)); + } + + /* Work through the KV vector. */ + for (i = 1; i < next_vector_length; i++) { + lispobj old_key = kv_vector[2*i]; + lispobj value = kv_vector[2*i+1]; + if ((weakness == NIL) || + weak_hash_entry_alivep(weakness, old_key, value)) { + + /* Scavenge the key and value. */ + scavenge(&kv_vector[2*i],2); + + /* Rehashing of EQ based keys. */ + if ((!hash_vector) || + (hash_vector[i] == MAGIC_HASH_VECTOR_VALUE)) { +#ifndef LISP_FEATURE_GENCGC + /* For GENCGC scav_hash_table_entries only rehashes + * the entries whose keys were moved. Cheneygc always + * moves the objects so here we let the lisp side know + * that rehashing is needed for the whole table. */ + *(kv_vector - 2) = (subtype_VectorMustRehash<needing_rehash); + hash_table->needing_rehash = make_fixnum(i); + /*SHOW("P2");*/ + } else { + unsigned long prior = index_vector[old_index]; + unsigned long next = next_vector[prior]; + + /*FSHOW((stderr, "/P3a %d %d\n", prior, next));*/ + + while (next != 0) { + /*FSHOW((stderr, "/P3b %d %d\n", prior, next));*/ + if (next == i) { + /* Unlink it. */ + next_vector[prior] = next_vector[next]; + /* Link it into the needing rehash + * chain. */ + next_vector[next] = + fixnum_value(hash_table->needing_rehash); + hash_table->needing_rehash = make_fixnum(next); + /*SHOW("/P3");*/ + break; + } + prior = next; + next = next_vector[next]; + } + } + } +#endif + } + } + } +} + +long +scav_vector (lispobj *where, lispobj object) +{ + unsigned long kv_length; + lispobj *kv_vector; + struct hash_table *hash_table; + + /* SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based and weak + * hash tables in the Lisp HASH-TABLE code to indicate need for + * special GC support. */ + if (HeaderValue(object) == subtype_VectorNormal) + return 1; + + kv_length = fixnum_value(where[1]); + kv_vector = where + 2; /* Skip the header and length. */ + /*FSHOW((stderr,"/kv_length = %d\n", kv_length));*/ + + /* Scavenge element 0, which may be a hash-table structure. */ + scavenge(where+2, 1); + if (!is_lisp_pointer(where[2])) { + lose("no pointer at %x in hash table\n", where[2]); + } + hash_table = (struct hash_table *)native_pointer(where[2]); + /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/ + if (widetag_of(hash_table->header) != INSTANCE_HEADER_WIDETAG) { + lose("hash table not instance (%x at %x)\n", + hash_table->header, + hash_table); + } + + /* Scavenge element 1, which should be some internal symbol that + * the hash table code reserves for marking empty slots. */ + scavenge(where+3, 1); + if (!is_lisp_pointer(where[3])) { + lose("not empty-hash-table-slot symbol pointer: %x\n", where[3]); + } + + /* Scavenge hash table, which will fix the positions of the other + * needed objects. */ + scavenge((lispobj *)hash_table, + sizeof(struct hash_table) / sizeof(lispobj)); + + /* Cross-check the kv_vector. */ + if (where != (lispobj *)native_pointer(hash_table->table)) { + lose("hash_table table!=this table %x\n", hash_table->table); + } + + if (hash_table->weakness == NIL) { + scav_hash_table_entries(hash_table); + } else { + /* Delay scavenging of this table by pushing it onto + * weak_hash_tables (if it's not there already) for the weak + * object phase. */ + if (hash_table->next_weak_hash_table == NIL) { + hash_table->next_weak_hash_table = (lispobj)weak_hash_tables; + weak_hash_tables = hash_table; + } + } + + return (CEILING(kv_length + 2, 2)); +} + +void +scav_weak_hash_tables (void) +{ + struct hash_table *table; + + /* Scavenge entries whose triggers are known to survive. */ + for (table = weak_hash_tables; table != NULL; + table = (struct hash_table *)table->next_weak_hash_table) { + scav_hash_table_entries(table); + } +} + +/* Walk through the chain whose first element is *FIRST and remove + * dead weak entries. */ +static inline void +scan_weak_hash_table_chain (struct hash_table *hash_table, lispobj *prev, + lispobj *kv_vector, lispobj *index_vector, + lispobj *next_vector, lispobj *hash_vector, + lispobj empty_symbol, lispobj weakness) +{ + unsigned index = *prev; + while (index) { + unsigned next = next_vector[index]; + lispobj key = kv_vector[2 * index]; + lispobj value = kv_vector[2 * index + 1]; + gc_assert(key != empty_symbol); + gc_assert(value != empty_symbol); + if (!weak_hash_entry_alivep(weakness, key, value)) { + unsigned count = fixnum_value(hash_table->number_entries); + gc_assert(count > 0); + *prev = next; + hash_table->number_entries = make_fixnum(count - 1); + next_vector[index] = fixnum_value(hash_table->next_free_kv); + hash_table->next_free_kv = make_fixnum(index); + kv_vector[2 * index] = empty_symbol; + kv_vector[2 * index + 1] = empty_symbol; + if (hash_vector) + hash_vector[index] = MAGIC_HASH_VECTOR_VALUE; + } else { + prev = &next_vector[index]; + } + index = next; + } +} + +static void +scan_weak_hash_table (struct hash_table *hash_table) +{ + lispobj *kv_vector; + lispobj *index_vector; + unsigned long length = 0; /* prevent warning */ + lispobj *next_vector; + unsigned long next_vector_length = 0; /* prevent warning */ + lispobj *hash_vector; + lispobj empty_symbol; + lispobj weakness = hash_table->weakness; + long i; + + kv_vector = get_array_data(hash_table->table, + SIMPLE_VECTOR_WIDETAG, NULL); + index_vector = get_array_data(hash_table->index_vector, + SIMPLE_ARRAY_WORD_WIDETAG, &length); + next_vector = get_array_data(hash_table->next_vector, + SIMPLE_ARRAY_WORD_WIDETAG, + &next_vector_length); + hash_vector = get_array_data(hash_table->hash_vector, + SIMPLE_ARRAY_WORD_WIDETAG, NULL); + empty_symbol = kv_vector[1]; + + for (i = 0; i < length; i++) { + scan_weak_hash_table_chain(hash_table, &index_vector[i], + kv_vector, index_vector, next_vector, + hash_vector, empty_symbol, weakness); + } + { + lispobj first = fixnum_value(hash_table->needing_rehash); + scan_weak_hash_table_chain(hash_table, &first, + kv_vector, index_vector, next_vector, + hash_vector, empty_symbol, weakness); + hash_table->needing_rehash = make_fixnum(first); + } +} + +/* Remove dead entries from weak hash tables. */ +void +scan_weak_hash_tables (void) +{ + struct hash_table *table, *next; + + for (table = weak_hash_tables; table != NULL; table = next) { + next = (struct hash_table *)table->next_weak_hash_table; + table->next_weak_hash_table = NIL; + scan_weak_hash_table(table); + } + + weak_hash_tables = NULL; +} /* @@ -1745,6 +2100,7 @@ gc_init_tables(void) #else scavtab[FDEFN_WIDETAG] = scav_fdefn; #endif + scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector; /* transport other table, initialized same way as scavtab */ for (i = 0; i < ((sizeof transother)/(sizeof transother[0])); i++) diff --git a/src/runtime/gc-internal.h b/src/runtime/gc-internal.h index 6645871..7de67a1 100644 --- a/src/runtime/gc-internal.h +++ b/src/runtime/gc-internal.h @@ -92,9 +92,12 @@ extern lispobj (*transother[256])(lispobj object); extern long (*sizetab[256])(lispobj *where); extern struct weak_pointer *weak_pointers; /* in gc-common.c */ +extern struct hash_table *weak_hash_tables; /* in gc-common.c */ extern void scavenge(lispobj *start, long n_words); extern void scavenge_interrupt_contexts(void); +extern void scav_weak_hash_tables(void); +extern void scan_weak_hash_tables(void); extern void scan_weak_pointers(void); lispobj copy_large_unboxed_object(lispobj object, long nwords); @@ -116,4 +119,10 @@ lispobj *gc_search_space(lispobj *start, size_t words, lispobj *pointer); #include "cheneygc-internal.h" #endif +#if N_WORD_BITS == 32 +# define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG +#elif N_WORD_BITS == 64 +# define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG +#endif + #endif /* _GC_INTERNAL_H_ */ diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index e25dd40..88de20f 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -168,12 +168,6 @@ struct page page_table[NUM_PAGES]; * is needed. */ static void *heap_base = NULL; -#if N_WORD_BITS == 32 - #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG -#elif N_WORD_BITS == 64 - #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG -#endif - /* Calculate the start address for the given page number. */ inline void * page_address(page_index_t page_num) @@ -1858,225 +1852,6 @@ trans_unboxed_large(lispobj object) /* - * vector-like objects - */ - -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) - -#if N_WORD_BITS == 32 -#define EQ_HASH_MASK 0x1fffffff -#elif N_WORD_BITS == 64 -#define EQ_HASH_MASK 0x1fffffffffffffff -#endif - -/* Compute the EQ-hash of KEY. This must match POINTER-HASH in - * target-hash-table.lisp. */ -#define EQ_HASH(key) ((key) & EQ_HASH_MASK) - -/* Return the beginning of data in ARRAY (skipping the header and the - * length) or NULL if it isn't an array of the specified widetag after - * all. */ -static inline lispobj * -get_array_data (lispobj array, int widetag, unsigned long *length) -{ - if (is_lisp_pointer(array) && - (widetag_of(*(lispobj *)native_pointer(array)) == widetag)) { - if (length != NULL) - *length = fixnum_value(((lispobj *)native_pointer(array))[1]); - return ((lispobj *)native_pointer(array)) + 2; - } else { - return NULL; - } -} - -/* Only need to worry about scavenging the _real_ entries in the - * table. Phantom entries such as the hash table itself at index 0 and - * the empty marker at index 1 were scavenged by scav_vector that - * either called this function directly or arranged for it to be - * called later by pushing the hash table onto weak_hash_tables. */ -static void -scav_hash_table_entries (struct hash_table *hash_table) -{ - lispobj *kv_vector; - unsigned long kv_length; - lispobj *index_vector; - unsigned long length; - lispobj *next_vector; - unsigned long next_vector_length; - lispobj *hash_vector; - unsigned long hash_vector_length; - lispobj empty_symbol; - long i; - - kv_vector = get_array_data(hash_table->table, - SIMPLE_VECTOR_WIDETAG, &kv_length); - if (kv_vector == NULL) - lose("invalid kv_vector %x\n", hash_table->table); - - index_vector = get_array_data(hash_table->index_vector, - SIMPLE_ARRAY_WORD_WIDETAG, &length); - if (index_vector == NULL) - lose("invalid index_vector %x\n", hash_table->index_vector); - - next_vector = get_array_data(hash_table->next_vector, - SIMPLE_ARRAY_WORD_WIDETAG, - &next_vector_length); - if (next_vector == NULL) - lose("invalid next_vector %x\n", hash_table->next_vector); - - hash_vector = get_array_data(hash_table->hash_vector, - SIMPLE_ARRAY_WORD_WIDETAG, - &hash_vector_length); - if (hash_vector != NULL) - gc_assert(hash_vector_length == next_vector_length); - - /* These lengths could be different as the index_vector can be a - * different length from the others, a larger index_vector could help - * reduce collisions. */ - gc_assert(next_vector_length*2 == kv_length); - - empty_symbol = kv_vector[1]; - /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/ - if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) != - SYMBOL_HEADER_WIDETAG) { - lose("not a symbol where empty-hash-table-slot symbol expected: %x\n", - *(lispobj *)native_pointer(empty_symbol)); - } - - /* Work through the KV vector. */ - for (i = 1; i < next_vector_length; i++) { - lispobj old_key = kv_vector[2*i]; - { - unsigned long old_index = EQ_HASH(old_key)%length; - lispobj new_key; - unsigned long new_index; - - /* Scavenge the key and value. */ - scavenge(&kv_vector[2*i],2); - - /* Check whether the key has moved and is EQ based. */ - new_key = kv_vector[2*i]; - new_index = EQ_HASH(new_key)%length; - - if ((old_index != new_index) && - ((!hash_vector) || - (hash_vector[i] == MAGIC_HASH_VECTOR_VALUE)) && - ((new_key != empty_symbol) || - (kv_vector[2*i+1] != empty_symbol))) { - - /*FSHOW((stderr, - "* EQ key %d moved from %x to %x; index %d to %d\n", - i, old_key, new_key, old_index, new_index));*/ - - if (index_vector[old_index] != 0) { - /*FSHOW((stderr, "/P1 %d\n", index_vector[old_index]));*/ - - /* Unlink the key from the old_index chain. */ - if (index_vector[old_index] == i) { - /*FSHOW((stderr, "/P2a %d\n", next_vector[i]));*/ - index_vector[old_index] = next_vector[i]; - /* Link it into the needing rehash chain. */ - next_vector[i] = - fixnum_value(hash_table->needing_rehash); - hash_table->needing_rehash = make_fixnum(i); - /*SHOW("P2");*/ - } else { - unsigned long prior = index_vector[old_index]; - unsigned long next = next_vector[prior]; - - /*FSHOW((stderr, "/P3a %d %d\n", prior, next));*/ - - while (next != 0) { - /*FSHOW((stderr, "/P3b %d %d\n", prior, next));*/ - if (next == i) { - /* Unlink it. */ - next_vector[prior] = next_vector[next]; - /* Link it into the needing rehash - * chain. */ - next_vector[next] = - fixnum_value(hash_table->needing_rehash); - hash_table->needing_rehash = make_fixnum(next); - /*SHOW("/P3");*/ - break; - } - prior = next; - next = next_vector[next]; - } - } - } - } - } - } -} - -static long -scav_vector(lispobj *where, lispobj object) -{ - unsigned long kv_length; - lispobj *kv_vector; - struct hash_table *hash_table; - - /* FIXME: A comment explaining this would be nice. It looks as - * though SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based - * hash tables in the Lisp HASH-TABLE code, and nowhere else. */ - if (HeaderValue(object) != subtype_VectorValidHashing) - return 1; - - kv_length = fixnum_value(where[1]); - kv_vector = where + 2; /* Skip the header and length. */ - /*FSHOW((stderr,"/kv_length = %d\n", kv_length));*/ - - /* Scavenge element 0, which may be a hash-table structure. */ - scavenge(where+2, 1); - if (!is_lisp_pointer(where[2])) { - lose("no pointer at %x in hash table\n", where[2]); - } - hash_table = (struct hash_table *)native_pointer(where[2]); - /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/ - if (widetag_of(hash_table->header) != INSTANCE_HEADER_WIDETAG) { - lose("hash table not instance (%x at %x)\n", - hash_table->header, - hash_table); - } - - /* Scavenge element 1, which should be some internal symbol that - * the hash table code reserves for marking empty slots. */ - scavenge(where+3, 1); - if (!is_lisp_pointer(where[3])) { - lose("not empty-hash-table-slot symbol pointer: %x\n", where[3]); - } - - /* Scavenge hash table, which will fix the positions of the other - * needed objects. */ - scavenge((lispobj *)hash_table, - sizeof(struct hash_table) / sizeof(lispobj)); - - /* Cross-check the kv_vector. */ - if (where != (lispobj *)native_pointer(hash_table->table)) { - lose("hash_table table!=this table %x\n", hash_table->table); - } - - scav_hash_table_entries(hash_table); - - return (CEILING(kv_length + 2, 2)); -} - -#else - -static long -scav_vector(lispobj *where, lispobj object) -{ - if (HeaderValue(object) == subtype_VectorValidHashing) { - *where = - (subtype_VectorMustRehash<