X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fruntime%2Fgencgc.c;h=81ef8b29537b5ffdece4d6966573e21a7ba0c9d5;hb=aa0ed5a420ea5295d586b3f323b5375d3b506860;hp=a13bbebb4fd852ddd56710ec7fb11d87d2d5f4d4;hpb=2db410feb35e7e30c95af8f20f67e6177fa92488;p=sbcl.git diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index a13bbeb..81ef8b2 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -41,6 +41,7 @@ #include "gc.h" #include "gc-internal.h" #include "thread.h" +#include "pseudo-atomic.h" #include "alloc.h" #include "genesis/vector.h" #include "genesis/weak-pointer.h" @@ -508,7 +509,7 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ gen_av_mem_age(i)); } fprintf(stderr," Total bytes allocated = %lu\n", bytes_allocated); - fprintf(stderr," Dynamic-space-size bytes = %lu\n", dynamic_space_size); + fprintf(stderr," Dynamic-space-size bytes = %u\n", dynamic_space_size); fpu_restore(fpu_state); } @@ -1046,7 +1047,7 @@ gc_alloc_large(long nbytes, int page_type_flag, struct alloc_region *alloc_regio int orig_first_page_bytes_used; long byte_cnt; int more; - long bytes_used; + unsigned long bytes_used; page_index_t next_page; int ret; @@ -1154,6 +1155,7 @@ static page_index_t gencgc_alloc_start_page = -1; void gc_heap_exhausted_error_or_lose (long available, long requested) { + struct thread *thread = arch_os_get_current_thread(); /* Write basic information before doing anything else: if we don't * call to lisp this is a must, and even if we do there is always * the danger that we bounce back here before the error has been @@ -1166,12 +1168,13 @@ gc_heap_exhausted_error_or_lose (long available, long requested) /* If we are in GC, or totally out of memory there is no way * to sanely transfer control to the lisp-side of things. */ - struct thread *thread = arch_os_get_current_thread(); print_generation_stats(1); fprintf(stderr, "GC control variables:\n"); fprintf(stderr, " *GC-INHIBIT* = %s\n *GC-PENDING* = %s\n", SymbolValue(GC_INHIBIT,thread)==NIL ? "false" : "true", - SymbolValue(GC_PENDING,thread)==NIL ? "false" : "true"); + (SymbolValue(GC_PENDING, thread) == T) ? + "true" : ((SymbolValue(GC_PENDING, thread) == NIL) ? + "false" : "in progress")); #ifdef LISP_FEATURE_SB_THREAD fprintf(stderr, " *STOP-FOR-GC-PENDING* = %s\n", SymbolValue(STOP_FOR_GC_PENDING,thread)==NIL ? "false" : "true"); @@ -1181,6 +1184,18 @@ gc_heap_exhausted_error_or_lose (long available, long requested) else { /* FIXME: assert free_pages_lock held */ (void)thread_mutex_unlock(&free_pages_lock); + gc_assert(get_pseudo_atomic_atomic(thread)); + clear_pseudo_atomic_atomic(thread); + if (get_pseudo_atomic_interrupted(thread)) + do_pending_interrupt(); + /* Another issue is that signalling HEAP-EXHAUSTED error leads + * to running user code at arbitrary places, even in a + * WITHOUT-INTERRUPTS which may lead to a deadlock without + * running out of the heap. So at this point all bets are + * off. */ + if (SymbolValue(INTERRUPTS_ENABLED,thread) == NIL) + corruption_warning_and_maybe_lose + ("Signalling HEAP-EXHAUSTED in a WITHOUT-INTERRUPTS."); funcall2(StaticSymbolFunction(HEAP_EXHAUSTED_ERROR), alloc_number(available), alloc_number(requested)); lose("HEAP-EXHAUSTED-ERROR fell through"); @@ -1188,7 +1203,8 @@ gc_heap_exhausted_error_or_lose (long available, long requested) } page_index_t -gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes, int page_type_flag) +gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes, + int page_type_flag) { page_index_t first_page, last_page; page_index_t restart_page = *restart_page_ptr; @@ -1201,7 +1217,8 @@ gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes, int page_type restart_page = gencgc_alloc_start_page; } - if (nbytes>=PAGE_BYTES) { + gc_assert(nbytes>=0); + if (((unsigned long)nbytes)>=PAGE_BYTES) { /* Search for a contiguous free space of at least nbytes, * aligned on a page boundary. The page-alignment is strictly * speaking needed only for objects at least large_object_size @@ -1515,9 +1532,10 @@ copy_large_unboxed_object(lispobj object, long nwords) gc_assert(from_space_p(object)); gc_assert((nwords & 0x01) == 0); - if ((nwords > 1024*1024) && gencgc_verbose) + if ((nwords > 1024*1024) && gencgc_verbose) { FSHOW((stderr, "/copy_large_unboxed_object: %d bytes\n", nwords*N_WORD_BYTES)); + } /* Check whether it's a large object. */ first_page = find_page_index((void *)object); @@ -1586,10 +1604,11 @@ copy_large_unboxed_object(lispobj object, long nwords) next_page++; } - if ((bytes_freed > 0) && gencgc_verbose) + if ((bytes_freed > 0) && gencgc_verbose) { FSHOW((stderr, "/copy_large_unboxed bytes_freed=%d\n", bytes_freed)); + } generations[from_space].bytes_allocated -= nwords*N_WORD_BYTES + bytes_freed; @@ -2231,28 +2250,31 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr) case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: if ((unsigned long)pointer != ((unsigned long)start_addr+FUN_POINTER_LOWTAG)) { - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "/Wf2: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; } break; default: - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "/Wf3: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; } break; case LIST_POINTER_LOWTAG: if ((unsigned long)pointer != ((unsigned long)start_addr+LIST_POINTER_LOWTAG)) { - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "/Wl1: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; } /* Is it plausible cons? */ @@ -2262,44 +2284,49 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr) is_lisp_immediate(start_addr[1]))) break; else { - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "/Wl2: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; } case INSTANCE_POINTER_LOWTAG: if ((unsigned long)pointer != ((unsigned long)start_addr+INSTANCE_POINTER_LOWTAG)) { - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "/Wi1: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; } if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) { - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "/Wi2: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; } break; case OTHER_POINTER_LOWTAG: if ((unsigned long)pointer != ((unsigned long)start_addr+OTHER_POINTER_LOWTAG)) { - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "/Wo1: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; } /* Is it plausible? Not a cons. XXX should check the headers. */ if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) { - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "/Wo2: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; } switch (widetag_of(start_addr[0])) { @@ -2309,26 +2336,29 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr) #if N_WORD_BITS == 64 case SINGLE_FLOAT_WIDETAG: #endif - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "*Wo3: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; /* only pointed to by function pointers? */ case CLOSURE_HEADER_WIDETAG: case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "*Wo4: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; case INSTANCE_HEADER_WIDETAG: - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "*Wo5: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; /* the valid other immediate pointer objects */ @@ -2431,18 +2461,20 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr) break; default: - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "/Wo6: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; } break; default: - if (gencgc_verbose) + if (gencgc_verbose) { FSHOW((stderr, "*W?: %x %x %x\n", pointer, start_addr, *start_addr)); + } return 0; } @@ -2711,7 +2743,7 @@ preserve_pointer(void *addr) * probability that random garbage will be bogusly interpreted as * a pointer which prevents a page from moving. */ if (!(code_page_p(addr_page_index) - || (is_lisp_pointer(addr) && + || (is_lisp_pointer((lispobj)addr) && possibly_valid_dynamic_space_pointer(addr)))) return; @@ -3146,8 +3178,9 @@ scavenge_newspace_generation(generation_index_t generation) /* New areas of objects allocated have been lost so need to do a * full scan to be sure! If this becomes a problem try * increasing NUM_NEW_AREAS. */ - if (gencgc_verbose) + if (gencgc_verbose) { SHOW("new_areas overflow, doing full scavenge"); + } /* Don't need to record new areas that get scavenged * anyway during scavenge_newspace_generation_one_scan. */ @@ -4069,7 +4102,7 @@ garbage_collect_generation(generation_index_t generation, int raise) fprintf(stderr, "/non-movable pages due to conservative pointers = %d (%d bytes)\n", num_dont_move_pages, - npage_bytes(num_dont_move_pages); + npage_bytes(num_dont_move_pages)); } #endif @@ -4206,8 +4239,9 @@ garbage_collect_generation(generation_index_t generation, int raise) generations[generation].alloc_large_unboxed_start_page = 0; if (generation >= verify_gens) { - if (gencgc_verbose) + if (gencgc_verbose) { SHOW("verifying"); + } verify_gc(); verify_dynamic_space(); } @@ -4435,8 +4469,9 @@ gc_free_heap(void) { page_index_t page; - if (gencgc_verbose > 1) + if (gencgc_verbose > 1) { SHOW("entering gc_free_heap"); + } for (page = 0; page < page_table_pages; page++) { /* Skip free pages which should already be zero filled. */ @@ -4688,8 +4723,23 @@ general_alloc_internal(long nbytes, int page_type_flag, struct alloc_region *reg /* set things up so that GC happens when we finish the PA * section */ SetSymbolValue(GC_PENDING,T,thread); - if (SymbolValue(GC_INHIBIT,thread) == NIL) - set_pseudo_atomic_interrupted(thread); + if (SymbolValue(GC_INHIBIT,thread) == NIL) { + set_pseudo_atomic_interrupted(thread); +#ifdef LISP_FEATURE_PPC + /* PPC calls alloc() from a trap, look up the most + * recent one and frob that. */ + { + int context_index = + fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX, + thread)); + os_context_t *context = + thread->interrupt_contexts[context_index - 1]; + maybe_save_gc_mask_and_block_deferrables(context); + } +#else + maybe_save_gc_mask_and_block_deferrables(NULL); +#endif + } } } new_obj = gc_alloc_with_region(nbytes, page_type_flag, region, 0); @@ -4699,11 +4749,7 @@ general_alloc_internal(long nbytes, int page_type_flag, struct alloc_region *reg if ((alloc_signal & FIXNUM_TAG_MASK) == 0) { if ((signed long) alloc_signal <= 0) { SetSymbolValue(ALLOC_SIGNAL, T, thread); -#ifdef LISP_FEATURE_SB_THREAD - kill_thread_safely(thread->os_thread, SIGPROF); -#else - raise(SIGPROF); -#endif + thread_kill(thread->os_thread, SIGPROF); } else { SetSymbolValue(ALLOC_SIGNAL, alloc_signal - (1 << N_FIXNUM_TAG_BITS), @@ -4743,6 +4789,7 @@ general_alloc(long nbytes, int page_type_flag) lispobj * alloc(long nbytes) { + gc_assert(get_pseudo_atomic_atomic(arch_os_get_current_thread())); return general_alloc(nbytes, BOXED_PAGE_FLAG); }