+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])) {
+ /* This'll happen when REHASH clears the header of old-kv-vector
+ * and fills it with zero, but some other thread simulatenously
+ * sets the header in %%PUTHASH.
+ */
+ fprintf(stderr,
+ "Warning: no pointer at %lx in hash table: this indicates "
+ "non-fatal corruption caused by concurrent access to a "
+ "hash-table from multiple threads. Any accesses to "
+ "hash-tables shared between threads should be protected "
+ "by locks.\n", (unsigned long)&where[2]);
+ // We've scavenged three words.
+ return 3;
+ }
+ 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;
+ unsigned 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);
+ }
+}
+
+/* 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;
+}