entry_point != NIL;
entry_point = function_ptr->next) {
- gc_assert_verbose(is_lisp_pointer(entry_point), "Entry point %lx\n",
+ gc_assert_verbose(is_lisp_pointer(entry_point),
+ "Entry point %lx\n is not a lisp pointer.",
(long)entry_point);
function_ptr = (struct simple_fun *) native_pointer(entry_point);
void scan_weak_pointers(void)
{
- struct weak_pointer *wp;
- for (wp = weak_pointers; wp != NULL; wp=wp->next) {
+ struct weak_pointer *wp, *next_wp;
+ for (wp = weak_pointers, next_wp = NULL; wp != NULL; wp = next_wp) {
lispobj value = wp->value;
lispobj *first_pointer;
gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG);
+
+ next_wp = wp->next;
+ wp->next = NULL;
+ if (next_wp == wp) /* gencgc uses a ref to self for end of list */
+ next_wp = NULL;
+
if (!(is_lisp_pointer(value) && from_space_p(value)))
continue;
/* 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<<N_WIDETAG_BITS) |
- SIMPLE_VECTOR_WIDETAG;
-#else
- unsigned long old_index = EQ_HASH(old_key)%length;
+ /* If an EQ-based key has moved, mark the hash-table for
+ * rehashing. */
+ if (!hash_vector || hash_vector[i] == MAGIC_HASH_VECTOR_VALUE) {
lispobj new_key = kv_vector[2*i];
- unsigned long new_index = EQ_HASH(new_key)%length;
- /* Check whether the key has moved. */
- if ((old_index != new_index) &&
- (new_key != empty_symbol)) {
- gc_assert(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));*/
-
- /* Unlink the key from the old_index chain. */
- if (!index_vector[old_index]) {
- /* It's not here, must be on the
- * needing_rehash chain. */
- } else 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];
- }
- }
+
+ if (old_key != new_key && new_key != empty_symbol) {
+ hash_table->needs_rehash_p = T;
}
-#endif
}
}
}
/* 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]);
+ /* 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));*/
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. */
}
return (NULL);
}
+
+boolean
+maybe_gc(os_context_t *context)
+{
+#ifndef LISP_FEATURE_WIN32
+ struct thread *thread = arch_os_get_current_thread();
+#endif
+
+ fake_foreign_function_call(context);
+ /* SUB-GC may return without GCing if *GC-INHIBIT* is set, in
+ * which case we will be running with no gc trigger barrier
+ * thing for a while. But it shouldn't be long until the end
+ * of WITHOUT-GCING.
+ *
+ * FIXME: It would be good to protect the end of dynamic space for
+ * CheneyGC and signal a storage condition from there.
+ */
+
+ /* Restore the signal mask from the interrupted context before
+ * calling into Lisp if interrupts are enabled. Why not always?
+ *
+ * Suppose there is a WITHOUT-INTERRUPTS block far, far out. If an
+ * interrupt hits while in SUB-GC, it is deferred and the
+ * os_context_sigmask of that interrupt is set to block further
+ * deferrable interrupts (until the first one is
+ * handled). Unfortunately, that context refers to this place and
+ * when we return from here the signals will not be blocked.
+ *
+ * A kludgy alternative is to propagate the sigmask change to the
+ * outer context.
+ */
+#ifndef LISP_FEATURE_WIN32
+ if(SymbolValue(INTERRUPTS_ENABLED,thread)!=NIL) {
+ sigset_t *context_sigmask = os_context_sigmask_addr(context);
+#ifdef LISP_FEATURE_SB_THREAD
+ /* What if the context we'd like to restore has GC signals
+ * blocked? Just skip the GC: we can't set GC_PENDING, because
+ * that would block the next attempt, and we don't know when
+ * we'd next check for it -- and it's hard to be sure that
+ * unblocking would be safe.
+ *
+ * FIXME: This is not actually much better: we may already have
+ * GC_PENDING set, and presumably our caller assumes that we will
+ * clear it. Perhaps we should, even though we don't actually GC? */
+ if (sigismember(context_sigmask,SIG_STOP_FOR_GC)) {
+ undo_fake_foreign_function_call(context);
+ return 1;
+ }
+#endif
+ thread_sigmask(SIG_SETMASK, context_sigmask, 0);
+ }
+ else
+ unblock_gc_signals();
+#endif
+ /* SIG_STOP_FOR_GC needs to be enabled before we can call lisp:
+ * otherwise two threads racing here may deadlock: the other will
+ * wait on the GC lock, and the other cannot stop the first one... */
+ funcall0(SymbolFunction(SUB_GC));
+ undo_fake_foreign_function_call(context);
+ return 1;
+}
projects / sbcl.git / blobdiff