X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;h=f3c3aab333ab3c572318df5b9ad442c8e849a7b6;hb=6793d7dd32d1fa48d2ee395e240e1b7ff857912e;hp=8937ebe9759d9348762d733904779190532fd534;hpb=96191081d3a73894005f32d370163c8ade2a2a3e;p=sbcl.git diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 8937ebe..f3c3aab 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -55,6 +55,9 @@ #if defined(LUTEX_WIDETAG) #include "pthread-lutex.h" #endif +#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) +#include "genesis/cons.h" +#endif /* forward declarations */ page_index_t gc_find_freeish_pages(long *restart_page_ptr, long nbytes, @@ -69,9 +72,7 @@ page_index_t gc_find_freeish_pages(long *restart_page_ptr, long nbytes, * scratch space by the collector, and should never get collected. */ enum { - HIGHEST_NORMAL_GENERATION = 5, - PSEUDO_STATIC_GENERATION, - SCRATCH_GENERATION, + SCRATCH_GENERATION = PSEUDO_STATIC_GENERATION+1, NUM_GENERATIONS }; @@ -257,7 +258,12 @@ size_t void_diff(void *x, void *y) return (pointer_sized_uint_t)x - (pointer_sized_uint_t)y; } -/* a structure to hold the state of a generation */ +/* a structure to hold the state of a generation + * + * CAUTION: If you modify this, make sure to touch up the alien + * definition in src/code/gc.lisp accordingly. ...or better yes, + * deal with the FIXME there... + */ struct generation { /* the first page that gc_alloc() checks on its next call */ @@ -287,9 +293,9 @@ struct generation { /* the number of GCs since the last raise */ int num_gc; - /* the average age after which a GC will raise objects to the + /* the number of GCs to run on the generations before raising objects to the * next generation */ - int trigger_age; + int number_of_gcs_before_promotion; /* the cumulative sum of the bytes allocated to this generation. It is * cleared after a GC on this generations, and update before new @@ -301,7 +307,7 @@ struct generation { /* a minimum average memory age before a GC will occur helps * prevent a GC when a large number of new live objects have been * added, in which case a GC could be a waste of time */ - double min_av_mem_age; + double minimum_age_before_gc; /* A linked list of lutex structures in this generation, used for * implementing lutex finalization. */ @@ -416,8 +422,8 @@ count_generation_bytes_allocated (generation_index_t gen) } /* Return the average age of the memory in a generation. */ -static double -gen_av_mem_age(generation_index_t gen) +extern double +generation_average_age(generation_index_t gen) { if (generations[gen].bytes_allocated == 0) return 0.0; @@ -500,7 +506,7 @@ print_generation_stats() /* FIXME: should take FILE argument, or construct a str generations[i].gc_trigger, count_write_protect_generation_pages(i), generations[i].num_gc, - gen_av_mem_age(i)); + generation_average_age(i)); } fprintf(stderr," Total bytes allocated = %lu\n", bytes_allocated); fprintf(stderr," Dynamic-space-size bytes = %u\n", dynamic_space_size); @@ -1158,21 +1164,21 @@ gc_heap_exhausted_error_or_lose (long available, long requested) fprintf(stderr, "Heap exhausted during %s: %ld bytes available, %ld requested.\n", gc_active_p ? "garbage collection" : "allocation", available, requested); - if (gc_active_p || (available == 0)) { - /* If we are in GC, or totally out of memory there is no way - * to sanely transfer control to the lisp-side of things. - */ - print_generation_stats(); + print_generation_stats(); fprintf(stderr, "GC control variables:\n"); - fprintf(stderr, " *GC-INHIBIT* = %s\n *GC-PENDING* = %s\n", + fprintf(stderr, " *GC-INHIBIT* = %s\n *GC-PENDING* = %s\n", SymbolValue(GC_INHIBIT,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", + fprintf(stderr, " *STOP-FOR-GC-PENDING* = %s\n", SymbolValue(STOP_FOR_GC_PENDING,thread)==NIL ? "false" : "true"); #endif + if (gc_active_p || (available == 0)) { + /* If we are in GC, or totally out of memory there is no way + * to sanely transfer control to the lisp-side of things. + */ lose("Heap exhausted, game over."); } else { @@ -1409,15 +1415,11 @@ copy_large_object(lispobj object, long nwords) gc_assert(page_table[next_page].region_start_offset == npage_bytes(next_page-first_page)); gc_assert(page_table[next_page].bytes_used == PAGE_BYTES); + /* Should have been unprotected by unprotect_oldspace(). */ + gc_assert(page_table[next_page].write_protected == 0); page_table[next_page].gen = new_space; - /* Remove any write-protection. We should be able to rely - * on the write-protect flag to avoid redundant calls. */ - if (page_table[next_page].write_protected) { - os_protect(page_address(next_page), PAGE_BYTES, OS_VM_PROT_ALL); - page_table[next_page].write_protected = 0; - } remaining_bytes -= PAGE_BYTES; next_page++; } @@ -2215,8 +2217,6 @@ search_dynamic_space(void *pointer) (lispobj *)pointer)); } -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) - /* Helper for valid_lisp_pointer_p and * possibly_valid_dynamic_space_pointer. * @@ -2305,6 +2305,23 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr) } break; case OTHER_POINTER_LOWTAG: + +#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) + /* The all-architecture test below is good as far as it goes, + * but an LRA object is similar to a FUN-POINTER: It is + * embedded within a CODE-OBJECT pointed to by start_addr, and + * cannot be found by simply walking the heap, therefore we + * need to check for it. -- AB, 2010-Jun-04 */ + if ((widetag_of(start_addr[0]) == CODE_HEADER_WIDETAG)) { + lispobj *potential_lra = + (lispobj *)(((unsigned long)pointer) - OTHER_POINTER_LOWTAG); + if ((widetag_of(potential_lra[0]) == RETURN_PC_HEADER_WIDETAG) && + ((potential_lra - HeaderValue(potential_lra[0])) == start_addr)) { + return 1; /* It's as good as we can verify. */ + } + } +#endif + if ((unsigned long)pointer != ((unsigned long)start_addr+OTHER_POINTER_LOWTAG)) { if (gencgc_verbose) { @@ -2500,6 +2517,8 @@ valid_lisp_pointer_p(lispobj *pointer) return 0; } +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) + /* 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? @@ -2517,6 +2536,8 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) return looks_like_valid_lisp_pointer_p(pointer, start_addr); } +#endif // defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) + /* Adjust large bignum and vector objects. This will adjust the * allocated region if the size has shrunk, and move unboxed objects * into unboxed pages. The pages are not promoted here, and the @@ -2735,11 +2756,17 @@ preserve_pointer(void *addr) * address referring to something in a CodeObject). This is * expensive but important, since it vastly reduces the * probability that random garbage will be bogusly interpreted as - * a pointer which prevents a page from moving. */ + * a pointer which prevents a page from moving. + * + * This only needs to happen on x86oids, where this is used for + * conservative roots. Non-x86oid systems only ever call this + * function on known-valid lisp objects. */ +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) if (!(code_page_p(addr_page_index) || (is_lisp_pointer((lispobj)addr) && possibly_valid_dynamic_space_pointer(addr)))) return; +#endif /* Find the beginning of the region. Note that there may be * objects in the region preceding the one that we were passed a @@ -2818,9 +2845,6 @@ preserve_pointer(void *addr) /* Check that the page is now static. */ gc_assert(page_table[addr_page_index].dont_move != 0); } - -#endif // defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) - /* If the given page is not write-protected, then scan it for pointers * to younger generations or the top temp. generation, if no @@ -3242,23 +3266,41 @@ static void unprotect_oldspace(void) { page_index_t i; + void *region_addr = 0; + void *page_addr = 0; + unsigned long region_bytes = 0; for (i = 0; i < last_free_page; i++) { if (page_allocated_p(i) && (page_table[i].bytes_used != 0) && (page_table[i].gen == from_space)) { - void *page_start; - - page_start = (void *)page_address(i); /* Remove any write-protection. We should be able to rely * on the write-protect flag to avoid redundant calls. */ if (page_table[i].write_protected) { - os_protect(page_start, PAGE_BYTES, OS_VM_PROT_ALL); page_table[i].write_protected = 0; + page_addr = page_address(i); + if (!region_addr) { + /* First region. */ + region_addr = page_addr; + region_bytes = PAGE_BYTES; + } else if (region_addr + region_bytes == page_addr) { + /* Region continue. */ + region_bytes += PAGE_BYTES; + } else { + /* Unprotect previous region. */ + os_protect(region_addr, region_bytes, OS_VM_PROT_ALL); + /* First page in new region. */ + region_addr = page_addr; + region_bytes = PAGE_BYTES; + } } } } + if (region_addr) { + /* Unprotect last region. */ + os_protect(region_addr, region_bytes, OS_VM_PROT_ALL); + } } /* Work through all the pages and free any in from_space. This @@ -3294,17 +3336,8 @@ free_oldspace(void) page_table[last_page].bytes_used; page_table[last_page].allocated = FREE_PAGE_FLAG; page_table[last_page].bytes_used = 0; - - /* Remove any write-protection. We should be able to rely - * on the write-protect flag to avoid redundant calls. */ - { - void *page_start = (void *)page_address(last_page); - - if (page_table[last_page].write_protected) { - os_protect(page_start, PAGE_BYTES, OS_VM_PROT_ALL); - page_table[last_page].write_protected = 0; - } - } + /* Should already be unprotected by unprotect_oldspace(). */ + gc_assert(!page_table[last_page].write_protected); last_page++; } while ((last_page < last_free_page) @@ -3354,6 +3387,23 @@ print_ptr(lispobj *addr) } #endif +static int +is_in_stack_space(lispobj ptr) +{ + /* For space verification: Pointers can be valid if they point + * to a thread stack space. This would be faster if the thread + * structures had page-table entries as if they were part of + * the heap space. */ + struct thread *th; + for_each_thread(th) { + if ((th->control_stack_start <= (lispobj *)ptr) && + (th->control_stack_end >= (lispobj *)ptr)) { + return 1; + } + } + return 0; +} + static void verify_space(lispobj *start, size_t words) { @@ -3381,15 +3431,15 @@ verify_space(lispobj *start, size_t words) * page. XX Could check the offset too. */ if (page_allocated_p(page_index) && (page_table[page_index].bytes_used == 0)) - lose ("Ptr %x @ %x sees free page.\n", thing, start); + lose ("Ptr %p @ %p sees free page.\n", thing, start); /* Check that it doesn't point to a forwarding pointer! */ if (*((lispobj *)native_pointer(thing)) == 0x01) { - lose("Ptr %x @ %x sees forwarding ptr.\n", thing, start); + lose("Ptr %p @ %p sees forwarding ptr.\n", thing, start); } /* Check that its not in the RO space as it would then be a * pointer from the RO to the dynamic space. */ if (is_in_readonly_space) { - lose("ptr to dynamic space %x from RO space %x\n", + lose("ptr to dynamic space %p from RO space %x\n", thing, start); } /* Does it point to a plausible object? This check slows @@ -3403,13 +3453,16 @@ verify_space(lispobj *start, size_t words) * dynamically. */ /* if (!possibly_valid_dynamic_space_pointer((lispobj *)thing)) { - lose("ptr %x to invalid object %x\n", thing, start); + lose("ptr %p to invalid object %p\n", thing, start); } */ } else { + extern void funcallable_instance_tramp; /* Verify that it points to another valid space. */ - if (!to_readonly_space && !to_static_space) { - lose("Ptr %x @ %x sees junk.\n", thing, start); + if (!to_readonly_space && !to_static_space + && (thing != (lispobj)&funcallable_instance_tramp) + && !is_in_stack_space(thing)) { + lose("Ptr %p @ %p sees junk.\n", thing, start); } } } else { @@ -3486,7 +3539,7 @@ verify_space(lispobj *start, size_t words) /* Only when enabled */ && verify_dynamic_code_check) { FSHOW((stderr, - "/code object at %x in the dynamic space\n", + "/code object at %p in the dynamic space\n", start)); } @@ -3602,7 +3655,7 @@ verify_space(lispobj *start, size_t words) break; default: - lose("Unhandled widetag 0x%x at 0x%x\n", + lose("Unhandled widetag %p at %p\n", widetag_of(*start), start); } } @@ -3777,165 +3830,19 @@ write_protect_generation_pages(generation_index_t generation) } #if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) - static void -scavenge_control_stack() +scavenge_control_stack(struct thread *th) { - unsigned long control_stack_size; - - /* This is going to be a big problem when we try to port threads - * to PPC... CLH */ - struct thread *th = arch_os_get_current_thread(); lispobj *control_stack = (lispobj *)(th->control_stack_start); + unsigned long control_stack_size = + access_control_stack_pointer(th) - control_stack; - control_stack_size = current_control_stack_pointer - control_stack; scavenge(control_stack, control_stack_size); } - -/* Scavenging Interrupt Contexts */ - -static int boxed_registers[] = BOXED_REGISTERS; - -static void -scavenge_interrupt_context(os_context_t * context) -{ - int i; - -#ifdef reg_LIP - unsigned long lip; - unsigned long lip_offset; - int lip_register_pair; -#endif - unsigned long pc_code_offset; - -#ifdef ARCH_HAS_LINK_REGISTER - unsigned long lr_code_offset; -#endif -#ifdef ARCH_HAS_NPC_REGISTER - unsigned long npc_code_offset; -#endif - -#ifdef reg_LIP - /* Find the LIP's register pair and calculate it's offset */ - /* before we scavenge the context. */ - - /* - * I (RLT) think this is trying to find the boxed register that is - * closest to the LIP address, without going past it. Usually, it's - * reg_CODE or reg_LRA. But sometimes, nothing can be found. - */ - lip = *os_context_register_addr(context, reg_LIP); - lip_offset = 0x7FFFFFFF; - lip_register_pair = -1; - for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { - unsigned long reg; - long offset; - int index; - - index = boxed_registers[i]; - reg = *os_context_register_addr(context, index); - if ((reg & ~((1L<uc_mcontext.gregs[2]. But gregs[2] is REG_nPC. Is - * that what we really want? My guess is that that is not what we - * want, so if lip_register_pair is -1, we don't touch reg_LIP at - * all. But maybe it doesn't really matter if LIP is trashed? - */ - if (lip_register_pair >= 0) { - *os_context_register_addr(context, reg_LIP) = - *os_context_register_addr(context, lip_register_pair) - + lip_offset; - } -#endif /* reg_LIP */ - - /* Fix the PC if it was in from space */ - if (from_space_p(*os_context_pc_addr(context))) - *os_context_pc_addr(context) = - *os_context_register_addr(context, reg_CODE) + pc_code_offset; - -#ifdef ARCH_HAS_LINK_REGISTER - /* Fix the LR ditto; important if we're being called from - * an assembly routine that expects to return using blr, otherwise - * harmless */ - if (from_space_p(*os_context_lr_addr(context))) - *os_context_lr_addr(context) = - *os_context_register_addr(context, reg_CODE) + lr_code_offset; -#endif - -#ifdef ARCH_HAS_NPC_REGISTER - if (from_space_p(*os_context_npc_addr(context))) - *os_context_npc_addr(context) = - *os_context_register_addr(context, reg_CODE) + npc_code_offset; -#endif /* ARCH_HAS_NPC_REGISTER */ -} - -void -scavenge_interrupt_contexts(void) -{ - int i, index; - os_context_t *context; - - struct thread *th=arch_os_get_current_thread(); - - index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,0)); - -#if defined(DEBUG_PRINT_CONTEXT_INDEX) - printf("Number of active contexts: %d\n", index); -#endif - - for (i = 0; i < index; i++) { - context = th->interrupt_contexts[i]; - scavenge_interrupt_context(context); - } -} - #endif -#if defined(LISP_FEATURE_SB_THREAD) +#if defined(LISP_FEATURE_SB_THREAD) && (defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)) static void preserve_context_registers (os_context_t *c) { @@ -3986,9 +3893,8 @@ 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. */ @@ -4088,6 +3994,19 @@ garbage_collect_generation(generation_index_t generation, int raise) } } } +#else + /* Non-x86oid systems don't have "conservative roots" as such, but + * the same mechanism is used for objects pinned for use by alien + * code. */ + for_each_thread(th) { + lispobj pin_list = SymbolTlValue(PINNED_OBJECTS,th); + while (pin_list != NIL) { + struct cons *list_entry = + (struct cons *)native_pointer(pin_list); + preserve_pointer(list_entry->car); + pin_list = list_entry->cdr; + } + } #endif #if QSHOW @@ -4107,8 +4026,18 @@ garbage_collect_generation(generation_index_t generation, int raise) * If not x86, we need to scavenge the interrupt context(s) and the * control stack. */ - scavenge_interrupt_contexts(); - scavenge_control_stack(); + { + struct thread *th; + for_each_thread(th) { + scavenge_interrupt_contexts(th); + scavenge_control_stack(th); + } + + /* Scrub the unscavenged control stack space, so that we can't run + * into any stale pointers in a later GC (this is done by the + * stop-for-gc handler in the other threads). */ + scrub_control_stack(); + } #endif /* Scavenge the Lisp functions of the interrupt handlers, taking @@ -4357,7 +4286,7 @@ collect_garbage(generation_index_t last_gen) } else { raise = (gen < last_gen) - || (generations[gen].num_gc >= generations[gen].trigger_age); + || (generations[gen].num_gc >= generations[gen].number_of_gcs_before_promotion); } if (gencgc_verbose > 1) { @@ -4394,8 +4323,8 @@ collect_garbage(generation_index_t last_gen) && raise && (generations[gen].bytes_allocated > generations[gen].gc_trigger) - && (gen_av_mem_age(gen) - > generations[gen].min_av_mem_age)))); + && (generation_average_age(gen) + > generations[gen].minimum_age_before_gc)))); /* Now if gen-1 was raised all generations before gen are empty. * If it wasn't raised then all generations before gen-1 are empty. @@ -4599,8 +4528,8 @@ gc_init(void) generations[i].cum_sum_bytes_allocated = 0; /* the tune-able parameters */ generations[i].bytes_consed_between_gc = 2000000; - generations[i].trigger_age = 1; - generations[i].min_av_mem_age = 0.75; + generations[i].number_of_gcs_before_promotion = 1; + generations[i].minimum_age_before_gc = 0.75; generations[i].lutexes = NULL; } @@ -4626,13 +4555,18 @@ gencgc_pickup_dynamic(void) generation_index_t gen = PSEUDO_STATIC_GENERATION; do { lispobj *first,*ptr= (lispobj *)page_address(page); - page_table[page].gen = gen; - page_table[page].bytes_used = PAGE_BYTES; - page_table[page].large_object = 0; - page_table[page].write_protected = 0; - page_table[page].write_protected_cleared = 0; - page_table[page].dont_move = 0; - page_table[page].need_to_zero = 1; + + if (!gencgc_partial_pickup || page_allocated_p(page)) { + /* It is possible, though rare, for the saved page table + * to contain free pages below alloc_ptr. */ + page_table[page].gen = gen; + page_table[page].bytes_used = PAGE_BYTES; + page_table[page].large_object = 0; + page_table[page].write_protected = 0; + page_table[page].write_protected_cleared = 0; + page_table[page].dont_move = 0; + page_table[page].need_to_zero = 1; + } if (!gencgc_partial_pickup) { page_table[page].allocated = BOXED_PAGE_FLAG;