X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgc-common.c;h=9347957d74c5a2c7722871363c7d2913be21bafc;hb=afb24f64fe95ed8ebce578ba7526b8a0a7aa5f14;hp=a439957d23bad509c3793c6fb1a4620f503e88f6;hpb=1479483c5f40fc470053da0fc5cd8e42fc77676e;p=sbcl.git diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c index a439957..9347957 100644 --- a/src/runtime/gc-common.c +++ b/src/runtime/gc-common.c @@ -53,6 +53,8 @@ #endif #endif +size_t dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE; + inline static boolean forwarding_pointer_p(lispobj *pointer) { lispobj first_word=*pointer; @@ -135,7 +137,9 @@ scavenge(lispobj *start, long n_words) lispobj object = *object_ptr; #ifdef LISP_FEATURE_GENCGC - gc_assert(!forwarding_pointer_p(object_ptr)); + if (forwarding_pointer_p(object_ptr)) + lose("unexpect forwarding pointer in scavenge: %p, start=%p, n=%l\n", + object_ptr, start, n_words); #endif if (is_lisp_pointer(object)) { if (from_space_p(object)) { @@ -356,7 +360,8 @@ scav_code_header(lispobj *where, lispobj object) 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); @@ -365,6 +370,7 @@ scav_code_header(lispobj *where, lispobj object) scavenge(&function_ptr->name, 1); scavenge(&function_ptr->arglist, 1); scavenge(&function_ptr->type, 1); + scavenge(&function_ptr->xrefs, 1); } return n_words; @@ -1519,11 +1525,17 @@ size_weak_pointer(lispobj *where) 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; @@ -1628,7 +1640,7 @@ scav_hash_table_entries (struct hash_table *hash_table) unsigned long hash_vector_length; lispobj empty_symbol; lispobj weakness = hash_table->weakness; - long i; + unsigned long i; kv_vector = get_array_data(hash_table->table, SIMPLE_VECTOR_WIDETAG, &kv_length); @@ -1675,66 +1687,14 @@ scav_hash_table_entries (struct hash_table *hash_table) /* 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]; - } - } + + if (old_key != new_key && new_key != empty_symbol) { + hash_table->needs_rehash_p = T; } -#endif } } } @@ -1760,7 +1720,18 @@ scav_vector (lispobj *where, lispobj object) /* 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));*/ @@ -1858,7 +1829,7 @@ scan_weak_hash_table (struct hash_table *hash_table) lispobj *hash_vector; lispobj empty_symbol; lispobj weakness = hash_table->weakness; - long i; + unsigned long i; kv_vector = get_array_data(hash_table->table, SIMPLE_VECTOR_WIDETAG, NULL); @@ -1876,13 +1847,6 @@ scan_weak_hash_table (struct hash_table *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. */ @@ -1941,7 +1905,7 @@ size_lose(lispobj *where) void gc_init_tables(void) { - long i; + unsigned long i; /* Set default value in all slots of scavenge table. FIXME * replace this gnarly sizeof with something based on @@ -2081,12 +2045,11 @@ gc_init_tables(void) scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header; scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header; #endif + scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed; #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header; - scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header; #else scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed; - scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed; #endif scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed; scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed; @@ -2433,3 +2396,64 @@ gc_search_space(lispobj *start, size_t words, lispobj *pointer) } 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(StaticSymbolFunction(SUB_GC)); + undo_fake_foreign_function_call(context); + return 1; +}