X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;h=699cc62fb2da2634b2d179737c8f75ebbd3de1ed;hb=f87f749ba5ffeb2e51b28c83d01ac7e33a5ca76d;hp=75ee8bbae24998dfe615700ffba539fd7e999282;hpb=1de12891f900d156ed035a097561ecd7755a256a;p=sbcl.git diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 75ee8bb..699cc62 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -38,10 +38,10 @@ #include "validate.h" #include "lispregs.h" #include "arch.h" -#include "fixnump.h" #include "gc.h" #include "gc-internal.h" #include "thread.h" +#include "alloc.h" #include "genesis/vector.h" #include "genesis/weak-pointer.h" #include "genesis/fdefn.h" @@ -50,9 +50,9 @@ #include "genesis/hash-table.h" #include "genesis/instance.h" #include "genesis/layout.h" - -#ifdef LUTEX_WIDETAG -#include "genesis/lutex.h" +#include "gencgc.h" +#if defined(LUTEX_WIDETAG) +#include "pthread-lutex.h" #endif /* forward declarations */ @@ -79,7 +79,7 @@ enum { boolean enable_page_protection = 1; /* the minimum size (in bytes) for a large object*/ -unsigned long large_object_size = 4 * PAGE_BYTES; +long large_object_size = 4 * PAGE_BYTES; /* @@ -145,11 +145,8 @@ boolean gencgc_partial_pickup = 0; /* the total bytes allocated. These are seen by Lisp DYNAMIC-USAGE. */ unsigned long bytes_allocated = 0; -extern unsigned long bytes_consed_between_gcs; /* gc-common.c */ unsigned long auto_gc_trigger = 0; -size_t dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE; - /* the source and destination generations. These are set before a GC starts * scavenging. */ generation_index_t from_space; @@ -165,7 +162,7 @@ static boolean conservative_stack = 1; /* An array of page structures is allocated on gc initialization. * This helps quickly map between an address its page structure. * page_table_pages is set from the size of the dynamic space. */ -unsigned page_table_pages; +page_index_t page_table_pages; struct page *page_table; /* To map addresses to page structures the address of the first page @@ -675,21 +672,6 @@ gc_alloc_new_region(long nbytes, int unboxed, struct alloc_region *alloc_region) ret = thread_mutex_unlock(&free_pages_lock); gc_assert(ret == 0); - /* we can do this after releasing free_pages_lock */ - if (gencgc_zero_check) { - long *p; - for (p = (long *)alloc_region->start_addr; - p < (long *)alloc_region->end_addr; p++) { - if (*p != 0) { - /* KLUDGE: It would be nice to use %lx and explicit casts - * (long) in code like this, so that it is less likely to - * break randomly when running on a machine with different - * word sizes. -- WHN 19991129 */ - lose("The new region at %x is not zero.\n", p); - } - } - } - #ifdef READ_PROTECT_FREE_PAGES os_protect(page_address(first_page), PAGE_BYTES*(1+last_page-first_page), @@ -705,6 +687,22 @@ gc_alloc_new_region(long nbytes, int unboxed, struct alloc_region *alloc_region) } zero_dirty_pages(first_page, last_page); + + /* we can do this after releasing free_pages_lock */ + if (gencgc_zero_check) { + long *p; + for (p = (long *)alloc_region->start_addr; + p < (long *)alloc_region->end_addr; p++) { + if (*p != 0) { + /* KLUDGE: It would be nice to use %lx and explicit casts + * (long) in code like this, so that it is less likely to + * break randomly when running on a machine with different + * word sizes. -- WHN 19991129 */ + lose("The new region at %x is not zero (start=%p, end=%p).\n", + p, alloc_region->start_addr, alloc_region->end_addr); + } + } + } } /* If the record_new_objects flag is 2 then all new regions created @@ -1074,9 +1072,9 @@ void gc_heap_exhausted_error_or_lose (long available, long requested) { /* 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 handled, - * or indeed even printed. + * 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 + * handled, or indeed even printed. */ fprintf(stderr, "Heap exhausted during %s: %ld bytes available, %ld requested.\n", gc_active_p ? "garbage collection" : "allocation", available, requested); @@ -1084,14 +1082,23 @@ 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"); +#ifdef LISP_FEATURE_SB_THREAD + fprintf(stderr, " *STOP-FOR-GC-PENDING* = %s\n", + SymbolValue(STOP_FOR_GC_PENDING,thread)==NIL ? "false" : "true"); +#endif lose("Heap exhausted, game over."); } else { /* FIXME: assert free_pages_lock held */ - thread_mutex_unlock(&free_pages_lock); - funcall2(SymbolFunction(HEAP_EXHAUSTED_ERROR), - make_fixnum(available), make_fixnum(requested)); + (void)thread_mutex_unlock(&free_pages_lock); + funcall2(StaticSymbolFunction(HEAP_EXHAUSTED_ERROR), + alloc_number(available), alloc_number(requested)); lose("HEAP-EXHAUSTED-ERROR fell through"); } } @@ -1181,7 +1188,7 @@ gc_alloc_with_region(long nbytes,int unboxed_p, struct alloc_region *my_region, { void *new_free_pointer; - if(nbytes>=large_object_size) + if (nbytes>=large_object_size) return gc_alloc_large(nbytes,unboxed_p,my_region); /* Check whether there is room in the current alloc region. */ @@ -1563,6 +1570,8 @@ sniff_code_object(struct code *code, unsigned long displacement) if (!check_code_fixups) return; + FSHOW((stderr, "/sniffing code: %p, %lu\n", code, displacement)); + ncode_words = fixnum_value(code->code_size); nheader_words = HeaderValue(*(lispobj *)code); nwords = ncode_words + nheader_words; @@ -1810,7 +1819,9 @@ gencgc_apply_code_fixups(struct code *old_code, struct code *new_code) old_value - displacement; } } else { - fprintf(stderr, "widetag of fixup vector is %d\n", widetag_of(fixups_vector->header)); + /* This used to just print a note to stderr, but a bogus fixup seems to + * indicate real heap corruption, so a hard hailure is in order. */ + lose("fixup vector %p has a bad widetag: %d\n", fixups_vector, widetag_of(fixups_vector->header)); } /* Check for possible errors. */ @@ -1941,7 +1952,7 @@ reap_lutexes (generation_index_t gen) { while (lutex) { struct lutex *next = lutex->next; if (!lutex->live) { - lutex_destroy(lutex); + lutex_destroy((tagged_lutex_t) lutex); gencgc_unregister_lutex(lutex); } lutex = next; @@ -2000,7 +2011,7 @@ scav_lutex(lispobj *where, lispobj object) static lispobj trans_lutex(lispobj object) { - struct lutex *lutex = native_pointer(object); + struct lutex *lutex = (struct lutex *) native_pointer(object); lispobj copied; size_t words = CEILING(sizeof(struct lutex)/sizeof(lispobj), 2); gc_assert(is_lisp_pointer(object)); @@ -2008,13 +2019,14 @@ trans_lutex(lispobj object) /* Update the links, since the lutex moved in memory. */ if (lutex->next) { - lutex->next->prev = native_pointer(copied); + lutex->next->prev = (struct lutex *) native_pointer(copied); } if (lutex->prev) { - lutex->prev->next = native_pointer(copied); + lutex->prev->next = (struct lutex *) native_pointer(copied); } else { - generations[lutex->gen].lutexes = native_pointer(copied); + generations[lutex->gen].lutexes = + (struct lutex *) native_pointer(copied); } return copied; @@ -2043,29 +2055,21 @@ size_lutex(lispobj *where) static long scav_weak_pointer(lispobj *where, lispobj object) { - struct weak_pointer *wp = weak_pointers; - /* Push the weak pointer onto the list of weak pointers. - * Do I have to watch for duplicates? Originally this was - * part of trans_weak_pointer but that didn't work in the - * case where the WP was in a promoted region. + /* Since we overwrite the 'next' field, we have to make + * sure not to do so for pointers already in the list. + * Instead of searching the list of weak_pointers each + * time, we ensure that next is always NULL when the weak + * pointer isn't in the list, and not NULL otherwise. + * Since we can't use NULL to denote end of list, we + * use a pointer back to the same weak_pointer. */ + struct weak_pointer * wp = (struct weak_pointer*)where; - /* Check whether it's already in the list. */ - while (wp != NULL) { - if (wp == (struct weak_pointer*)where) { - break; - } - wp = wp->next; - } - if (wp == NULL) { - /* Add it to the start of the list. */ - wp = (struct weak_pointer*)where; - if (wp->next != weak_pointers) { - wp->next = weak_pointers; - } else { - /*SHOW("avoided write to weak pointer");*/ - } + if (NULL == wp->next) { + wp->next = weak_pointers; weak_pointers = wp; + if (NULL == wp->next) + wp->next = wp; } /* Do not let GC scavenge the value slot of the weak pointer. @@ -2118,37 +2122,30 @@ search_dynamic_space(void *pointer) (lispobj *)pointer)); } -/* Is there any possibility that pointer is a valid Lisp object - * reference, and/or something else (e.g. subroutine call return - * address) which should prevent us from moving the referred-to thing? - * This is called from preserve_pointers() */ +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) + +/* Helper for valid_lisp_pointer_p and + * possibly_valid_dynamic_space_pointer. + * + * pointer is the pointer to validate, and start_addr is the address + * of the enclosing object. + */ static int -possibly_valid_dynamic_space_pointer(lispobj *pointer) +looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr) { - lispobj *start_addr; - - /* Find the object start address. */ - if ((start_addr = search_dynamic_space(pointer)) == NULL) { - return 0; - } - /* We need to allow raw pointers into Code objects for return * addresses. This will also pick up pointers to functions in code * objects. */ - if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) { + if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) /* XXX could do some further checks here */ return 1; - } - /* If it's not a return address then it needs to be a valid Lisp - * pointer. */ if (!is_lisp_pointer((lispobj)pointer)) { return 0; } /* Check that the object pointed to is consistent with the pointer - * low tag. - */ + * low tag. */ switch (lowtag_of((lispobj)pointer)) { case FUN_POINTER_LOWTAG: /* Start_addr should be the enclosing code object, or a closure @@ -2186,20 +2183,8 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) return 0; } /* Is it plausible cons? */ - if ((is_lisp_pointer(start_addr[0]) - || (fixnump(start_addr[0])) - || (widetag_of(start_addr[0]) == CHARACTER_WIDETAG) -#if N_WORD_BITS == 64 - || (widetag_of(start_addr[0]) == SINGLE_FLOAT_WIDETAG) -#endif - || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG)) - && (is_lisp_pointer(start_addr[1]) - || (fixnump(start_addr[1])) - || (widetag_of(start_addr[1]) == CHARACTER_WIDETAG) -#if N_WORD_BITS == 64 - || (widetag_of(start_addr[1]) == SINGLE_FLOAT_WIDETAG) -#endif - || (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG))) + if ((is_lisp_pointer(start_addr[0]) || is_lisp_immediate(start_addr[0])) && + (is_lisp_pointer(start_addr[1]) || is_lisp_immediate(start_addr[1]))) break; else { if (gencgc_verbose) @@ -2390,7 +2375,46 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) return 1; } -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +/* Used by the debugger to validate possibly bogus pointers before + * calling MAKE-LISP-OBJ on them. + * + * FIXME: We would like to make this perfect, because if the debugger + * constructs a reference to a bugs lisp object, and it ends up in a + * location scavenged by the GC all hell breaks loose. + * + * Whereas possibly_valid_dynamic_space_pointer has to be conservative + * and return true for all valid pointers, this could actually be eager + * and lie about a few pointers without bad results... but that should + * be reflected in the name. + */ +int +valid_lisp_pointer_p(lispobj *pointer) +{ + lispobj *start; + if (((start=search_dynamic_space(pointer))!=NULL) || + ((start=search_static_space(pointer))!=NULL) || + ((start=search_read_only_space(pointer))!=NULL)) + return looks_like_valid_lisp_pointer_p(pointer, start); + else + return 0; +} + +/* Is there any possibility that pointer is a valid Lisp object + * reference, and/or something else (e.g. subroutine call return + * address) which should prevent us from moving the referred-to thing? + * This is called from preserve_pointers() */ +static int +possibly_valid_dynamic_space_pointer(lispobj *pointer) +{ + lispobj *start_addr; + + /* Find the object start address. */ + if ((start_addr = search_dynamic_space(pointer)) == NULL) { + return 0; + } + + return looks_like_valid_lisp_pointer_p(pointer, start_addr); +} /* Adjust large bignum and vector objects. This will adjust the * allocated region if the size has shrunk, and move unboxed objects @@ -2566,8 +2590,6 @@ maybe_adjust_large_object(lispobj *where) return; } -#endif - /* Take a possible pointer to a Lisp object and mark its page in the * page_table so that it will not be relocated during a GC. * @@ -2581,8 +2603,6 @@ maybe_adjust_large_object(lispobj *where) * It is also assumed that the current gc_alloc() region has been * flushed and the tables updated. */ -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) - static void preserve_pointer(void *addr) { @@ -2699,7 +2719,7 @@ preserve_pointer(void *addr) gc_assert(page_table[addr_page_index].dont_move != 0); } -#endif +#endif // defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) /* If the given page is not write-protected, then scan it for pointers @@ -3471,15 +3491,14 @@ verify_space(lispobj *start, size_t words) #ifdef LUTEX_WIDETAG case LUTEX_WIDETAG: #endif +#ifdef NO_TLS_VALUE_MARKER_WIDETAG + case NO_TLS_VALUE_MARKER_WIDETAG: +#endif count = (sizetab[widetag_of(*start)])(start); break; default: - FSHOW((stderr, - "/Unhandled widetag 0x%x at 0x%x\n", - widetag_of(*start), start)); - fflush(stderr); - gc_abort(); + lose("Unhandled widetag 0x%x at 0x%x\n", widetag_of(*start), start); } } } @@ -3825,6 +3844,22 @@ preserve_context_registers (os_context_t *c) preserve_pointer((void*)*os_context_register_addr(c,reg_ESI)); preserve_pointer((void*)*os_context_register_addr(c,reg_EDI)); preserve_pointer((void*)*os_context_pc_addr(c)); +#elif defined LISP_FEATURE_X86_64 + preserve_pointer((void*)*os_context_register_addr(c,reg_RAX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_RCX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_RDX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_RBX)); + preserve_pointer((void*)*os_context_register_addr(c,reg_RSI)); + preserve_pointer((void*)*os_context_register_addr(c,reg_RDI)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R8)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R9)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R10)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R11)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R12)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R13)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R14)); + preserve_pointer((void*)*os_context_register_addr(c,reg_R15)); + preserve_pointer((void*)*os_context_pc_addr(c)); #else #error "preserve_context_registers needs to be tweaked for non-x86 Darwin" #endif @@ -3843,7 +3878,9 @@ garbage_collect_generation(generation_index_t generation, int raise) unsigned long bytes_freed; page_index_t i; unsigned long static_space_size; +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) struct thread *th; +#endif gc_assert(generation <= HIGHEST_NORMAL_GENERATION); /* The oldest generation can't be raised. */ @@ -3938,7 +3975,7 @@ garbage_collect_generation(generation_index_t generation, int raise) #else esp = (void **)((void *)&raise); #endif - for (ptr = ((void **)th->control_stack_end)-1; ptr > esp; ptr--) { + for (ptr = ((void **)th->control_stack_end)-1; ptr >= esp; ptr--) { preserve_pointer(*ptr); } } @@ -4396,8 +4433,7 @@ gc_free_heap(void) if (verify_after_free_heap) { /* Check whether purify has left any bad pointers. */ - if (gencgc_verbose) - SHOW("checking after free_heap\n"); + FSHOW((stderr, "checking after free_heap\n")); verify_gc(); } } @@ -4410,7 +4446,7 @@ gc_init(void) /* Compute the number of pages needed for the dynamic space. * Dynamic space size should be aligned on page size. */ page_table_pages = dynamic_space_size/PAGE_BYTES; - gc_assert(dynamic_space_size == page_table_pages*PAGE_BYTES); + gc_assert(dynamic_space_size == (size_t) page_table_pages*PAGE_BYTES); page_table = calloc(page_table_pages, sizeof(struct page)); gc_assert(page_table); @@ -4536,7 +4572,7 @@ gc_initialize_pointers(void) * The check for a GC trigger is only performed when the current * region is full, so in most cases it's not needed. */ -char * +lispobj * alloc(long nbytes) { struct thread *thread=arch_os_get_current_thread(); @@ -4546,8 +4582,12 @@ alloc(long nbytes) #else &boxed_region; #endif +#ifndef LISP_FEATURE_WIN32 + lispobj alloc_signal; +#endif void *new_obj; void *new_free_pointer; + gc_assert(nbytes>0); /* Check for alignment allocation problems. */ @@ -4599,6 +4639,25 @@ alloc(long nbytes) } } new_obj = gc_alloc_with_region(nbytes,0,region,0); + +#ifndef LISP_FEATURE_WIN32 + alloc_signal = SymbolValue(ALLOC_SIGNAL,thread); + 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 + } else { + SetSymbolValue(ALLOC_SIGNAL, + alloc_signal - (1 << N_FIXNUM_TAG_BITS), + thread); + } + } +#endif + return (new_obj); } @@ -4607,7 +4666,7 @@ alloc(long nbytes) * catch GENCGC-related write-protect violations */ -void unhandled_sigmemoryfault(void); +void unhandled_sigmemoryfault(void* addr); /* Depending on which OS we're running under, different signals might * be raised for a violation of write protection in the heap. This @@ -4634,7 +4693,7 @@ gencgc_handle_wp_violation(void* fault_addr) /* It can be helpful to be able to put a breakpoint on this * case to help diagnose low-level problems. */ - unhandled_sigmemoryfault(); + unhandled_sigmemoryfault(fault_addr); /* not within the dynamic space -- not our responsibility */ return 0; @@ -4665,7 +4724,7 @@ gencgc_handle_wp_violation(void* fault_addr) * are about to let Lisp deal with it. It's basically just a * convenient place to set a gdb breakpoint. */ void -unhandled_sigmemoryfault() +unhandled_sigmemoryfault(void *addr) {} void gc_alloc_update_all_page_tables(void)