X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;h=f4ffd2ffa5a0567a721c53f921af9af818e28311;hb=37d3828773e2f847bb1ed7522b0af4fb8e736fc8;hp=2d279255e925c756f448b030d36bdac895733d45;hpb=844ecf93b004399bf575e700d8b2865edd517c08;p=sbcl.git diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 2d27925..f4ffd2f 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -26,10 +26,14 @@ #include #include -#include #include #include #include "sbcl.h" +#if defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD) +#include "pthreads_win32.h" +#else +#include +#endif #include "runtime.h" #include "os.h" #include "interr.h" @@ -57,7 +61,7 @@ #endif /* forward declarations */ -page_index_t gc_find_freeish_pages(page_index_t *restart_page_ptr, long nbytes, +page_index_t gc_find_freeish_pages(page_index_t *restart_page_ptr, sword_t nbytes, int page_type_flag); @@ -96,7 +100,7 @@ os_vm_size_t large_allocation = 0; /* the verbosity level. All non-error messages are disabled at level 0; * and only a few rare messages are printed at level 1. */ -#if QSHOW +#if QSHOW == 2 boolean gencgc_verbose = 1; #else boolean gencgc_verbose = 0; @@ -168,7 +172,7 @@ boolean gc_active_p = 0; 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. + * This helps to quickly map between an address and its page structure. * page_table_pages is set from the size of the dynamic space. */ page_index_t page_table_pages; struct page *page_table; @@ -447,6 +451,15 @@ write_generation_stats(FILE *file) #elif defined(LISP_FEATURE_PPC) #define FPU_STATE_SIZE 32 long long fpu_state[FPU_STATE_SIZE]; +#elif defined(LISP_FEATURE_SPARC) + /* + * 32 (single-precision) FP registers, and the FP state register. + * But Sparc V9 has 32 double-precision registers (equivalent to 64 + * single-precision, but can't be accessed), so we leave enough room + * for that. + */ +#define FPU_STATE_SIZE (((32 + 32 + 1) + 1)/2) + long long fpu_state[FPU_STATE_SIZE]; #endif /* This code uses the FP instructions which may be set up for Lisp @@ -584,7 +597,7 @@ report_heap_exhaustion(long available, long requested, struct thread *th) } -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +#if defined(LISP_FEATURE_X86) void fast_bzero(void*, size_t); /* in -assem.S */ #endif @@ -788,7 +801,7 @@ set_generation_alloc_start_page(generation_index_t generation, int page_type_fla * are allocated, although they will initially be empty. */ static void -gc_alloc_new_region(long nbytes, int page_type_flag, struct alloc_region *alloc_region) +gc_alloc_new_region(sword_t nbytes, int page_type_flag, struct alloc_region *alloc_region) { page_index_t first_page; page_index_t last_page; @@ -917,7 +930,8 @@ size_t max_new_areas; static void add_new_area(page_index_t first_page, size_t offset, size_t size) { - size_t new_area_start, c, i; + size_t new_area_start, c; + ssize_t i; /* Ignore if full. */ if (new_areas_index >= NUM_NEW_AREAS) @@ -1112,11 +1126,11 @@ gc_alloc_update_page_tables(int page_type_flag, struct alloc_region *alloc_regio gc_set_region_empty(alloc_region); } -static inline void *gc_quick_alloc(long nbytes); +static inline void *gc_quick_alloc(word_t nbytes); /* Allocate a possibly large object. */ void * -gc_alloc_large(long nbytes, int page_type_flag, struct alloc_region *alloc_region) +gc_alloc_large(sword_t nbytes, int page_type_flag, struct alloc_region *alloc_region) { boolean more; page_index_t first_page, next_page, last_page; @@ -1227,7 +1241,7 @@ gc_alloc_large(long nbytes, int page_type_flag, struct alloc_region *alloc_regio static page_index_t gencgc_alloc_start_page = -1; void -gc_heap_exhausted_error_or_lose (long available, long requested) +gc_heap_exhausted_error_or_lose (sword_t available, sword_t requested) { struct thread *thread = arch_os_get_current_thread(); /* Write basic information before doing anything else: if we don't @@ -1245,10 +1259,12 @@ gc_heap_exhausted_error_or_lose (long available, long requested) else { /* FIXME: assert free_pages_lock held */ (void)thread_mutex_unlock(&free_pages_lock); +#if !(defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD)) gc_assert(get_pseudo_atomic_atomic(thread)); clear_pseudo_atomic_atomic(thread); if (get_pseudo_atomic_interrupted(thread)) do_pending_interrupt(); +#endif /* 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 @@ -1264,7 +1280,7 @@ gc_heap_exhausted_error_or_lose (long available, long requested) } page_index_t -gc_find_freeish_pages(page_index_t *restart_page_ptr, long bytes, +gc_find_freeish_pages(page_index_t *restart_page_ptr, sword_t bytes, int page_type_flag) { page_index_t most_bytes_found_from = 0, most_bytes_found_to = 0; @@ -1359,7 +1375,7 @@ gc_find_freeish_pages(page_index_t *restart_page_ptr, long bytes, * functions will eventually call this */ void * -gc_alloc_with_region(long nbytes,int page_type_flag, struct alloc_region *my_region, +gc_alloc_with_region(sword_t nbytes,int page_type_flag, struct alloc_region *my_region, int quick_p) { void *new_free_pointer; @@ -1404,19 +1420,19 @@ gc_alloc_with_region(long nbytes,int page_type_flag, struct alloc_region *my_reg * region */ static inline void * -gc_quick_alloc(long nbytes) +gc_quick_alloc(word_t nbytes) { return gc_general_alloc(nbytes, BOXED_PAGE_FLAG, ALLOC_QUICK); } static inline void * -gc_alloc_unboxed(long nbytes) +gc_alloc_unboxed(word_t nbytes) { return gc_general_alloc(nbytes, UNBOXED_PAGE_FLAG, 0); } static inline void * -gc_quick_alloc_unboxed(long nbytes) +gc_quick_alloc_unboxed(word_t nbytes) { return gc_general_alloc(nbytes, UNBOXED_PAGE_FLAG, ALLOC_QUICK); } @@ -1428,7 +1444,7 @@ gc_quick_alloc_unboxed(long nbytes) * Bignums and vectors may have shrunk. If the object is not copied * the space needs to be reclaimed, and the page_tables corrected. */ static lispobj -general_copy_large_object(lispobj object, long nwords, boolean boxedp) +general_copy_large_object(lispobj object, word_t nwords, boolean boxedp) { int tag; lispobj *new; @@ -1573,20 +1589,20 @@ general_copy_large_object(lispobj object, long nwords, boolean boxedp) } lispobj -copy_large_object(lispobj object, long nwords) +copy_large_object(lispobj object, sword_t nwords) { return general_copy_large_object(object, nwords, 1); } lispobj -copy_large_unboxed_object(lispobj object, long nwords) +copy_large_unboxed_object(lispobj object, sword_t nwords) { return general_copy_large_object(object, nwords, 0); } /* to copy unboxed objects */ lispobj -copy_unboxed_object(lispobj object, long nwords) +copy_unboxed_object(lispobj object, sword_t nwords) { return gc_general_copy_object(object, nwords, UNBOXED_PAGE_FLAG); } @@ -1613,7 +1629,7 @@ void sniff_code_object(struct code *code, os_vm_size_t displacement) { #ifdef LISP_FEATURE_X86 - long nheader_words, ncode_words, nwords; + sword_t nheader_words, ncode_words, nwords; os_vm_address_t constants_start_addr = NULL, constants_end_addr, p; os_vm_address_t code_start_addr, code_end_addr; os_vm_address_t code_addr = (os_vm_address_t)code; @@ -1789,7 +1805,7 @@ gencgc_apply_code_fixups(struct code *old_code, struct code *new_code) { /* x86-64 uses pc-relative addressing instead of this kludge */ #ifndef LISP_FEATURE_X86_64 - long nheader_words, ncode_words, nwords; + sword_t nheader_words, ncode_words, nwords; os_vm_address_t constants_start_addr, constants_end_addr; os_vm_address_t code_start_addr, code_end_addr; os_vm_address_t code_addr = (os_vm_address_t)new_code; @@ -1852,8 +1868,8 @@ gencgc_apply_code_fixups(struct code *old_code, struct code *new_code) if (widetag_of(fixups_vector->header) == SIMPLE_ARRAY_WORD_WIDETAG) { /* Got the fixups for the code block. Now work through the vector, and apply a fixup at each address. */ - long length = fixnum_value(fixups_vector->length); - long i; + sword_t length = fixnum_value(fixups_vector->length); + sword_t i; for (i = 0; i < length; i++) { long offset = fixups_vector->data[i]; /* Now check the current value of offset. */ @@ -1892,7 +1908,7 @@ static lispobj trans_boxed_large(lispobj object) { lispobj header; - unsigned long length; + uword_t length; gc_assert(is_lisp_pointer(object)); @@ -1909,7 +1925,7 @@ static lispobj trans_unboxed_large(lispobj object) { lispobj header; - unsigned long length; + uword_t length; gc_assert(is_lisp_pointer(object)); @@ -1933,7 +1949,7 @@ trans_unboxed_large(lispobj object) #define WEAK_POINTER_NWORDS \ CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2) -static long +static sword_t scav_weak_pointer(lispobj *where, lispobj object) { /* Since we overwrite the 'next' field, we have to make @@ -2034,11 +2050,11 @@ maybe_adjust_large_object(lispobj *where) { page_index_t first_page; page_index_t next_page; - long nwords; + sword_t nwords; - unsigned long remaining_bytes; - unsigned long bytes_freed; - unsigned long old_bytes_used; + uword_t remaining_bytes; + uword_t bytes_freed; + uword_t old_bytes_used; int boxed; @@ -2225,7 +2241,7 @@ preserve_pointer(void *addr) /* quick check 2: Check the offset within the page. * */ - if (((unsigned long)addr & (GENCGC_CARD_BYTES - 1)) > + if (((uword_t)addr & (GENCGC_CARD_BYTES - 1)) > page_table[addr_page_index].bytes_used) return; @@ -2277,7 +2293,7 @@ preserve_pointer(void *addr) if (page_free_p(addr_page_index) || (page_table[addr_page_index].bytes_used == 0) /* Check the offset within the page. */ - || (((unsigned long)addr & (GENCGC_CARD_BYTES - 1)) + || (((uword_t)addr & (GENCGC_CARD_BYTES - 1)) > page_table[addr_page_index].bytes_used)) { FSHOW((stderr, "weird? ignore ptr 0x%x to freed area of large object\n", @@ -2341,10 +2357,10 @@ static int update_page_write_prot(page_index_t page) { generation_index_t gen = page_table[page].gen; - long j; + sword_t j; int wp_it = 1; void **page_addr = (void **)page_address(page); - long num_words = page_table[page].bytes_used / N_WORD_BYTES; + sword_t num_words = page_table[page].bytes_used / N_WORD_BYTES; /* Shouldn't be a free page. */ gc_assert(page_allocated_p(page)); @@ -2466,7 +2482,7 @@ scavenge_generations(generation_index_t from, generation_index_t to) } if (!write_protected) { scavenge(page_address(i), - ((unsigned long)(page_table[last_page].bytes_used + ((uword_t)(page_table[last_page].bytes_used + npage_bytes(last_page-i))) /N_WORD_BYTES); @@ -2583,7 +2599,7 @@ scavenge_newspace_generation_one_scan(generation_index_t generation) /* Do a limited check for write-protected pages. */ if (!all_wp) { - long nwords = (((unsigned long) + sword_t nwords = (((uword_t) (page_table[last_page].bytes_used + npage_bytes(last_page-i) + page_table[i].region_start_offset)) @@ -2749,7 +2765,7 @@ unprotect_oldspace(void) page_index_t i; void *region_addr = 0; void *page_addr = 0; - unsigned long region_bytes = 0; + uword_t region_bytes = 0; for (i = 0; i < last_free_page; i++) { if (page_allocated_p(i) @@ -2788,10 +2804,10 @@ unprotect_oldspace(void) * assumes that all objects have been copied or promoted to an older * generation. Bytes_allocated and the generation bytes_allocated * counter are updated. The number of bytes freed is returned. */ -static unsigned long +static uword_t free_oldspace(void) { - unsigned long bytes_freed = 0; + uword_t bytes_freed = 0; page_index_t first_page, last_page; first_page = 0; @@ -2847,8 +2863,8 @@ print_ptr(lispobj *addr) page_index_t pi1 = find_page_index((void*)addr); if (pi1 != -1) - fprintf(stderr," %x: page %d alloc %d gen %d bytes_used %d offset %lu dont_move %d\n", - (unsigned long) addr, + fprintf(stderr," %p: page %d alloc %d gen %d bytes_used %d offset %lu dont_move %d\n", + addr, pi1, page_table[pi1].allocated, page_table[pi1].gen, @@ -2890,8 +2906,8 @@ verify_space(lispobj *start, size_t words) { int is_in_dynamic_space = (find_page_index((void*)start) != -1); int is_in_readonly_space = - (READ_ONLY_SPACE_START <= (unsigned long)start && - (unsigned long)start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0)); + (READ_ONLY_SPACE_START <= (uword_t)start && + (uword_t)start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0)); while (words > 0) { size_t count = 1; @@ -2899,10 +2915,10 @@ verify_space(lispobj *start, size_t words) if (is_lisp_pointer(thing)) { page_index_t page_index = find_page_index((void*)thing); - long to_readonly_space = + sword_t to_readonly_space = (READ_ONLY_SPACE_START <= thing && thing < SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0)); - long to_static_space = + sword_t to_static_space = (STATIC_SPACE_START <= thing && thing < SymbolValue(STATIC_SPACE_FREE_POINTER,0)); @@ -2980,7 +2996,7 @@ verify_space(lispobj *start, size_t words) case INSTANCE_HEADER_WIDETAG: { lispobj nuntagged; - long ntotal = HeaderValue(thing); + sword_t ntotal = HeaderValue(thing); lispobj layout = ((struct instance *)start)->slots[0]; if (!layout) { count = 1; @@ -2997,7 +3013,7 @@ verify_space(lispobj *start, size_t words) { lispobj object = *start; struct code *code; - long nheader_words, ncode_words, nwords; + sword_t nheader_words, ncode_words, nwords; lispobj fheaderl; struct simple_fun *fheaderp; @@ -3146,15 +3162,15 @@ verify_gc(void) * Some counts of lispobjs are called foo_count; it might be good * to grep for all foo_size and rename the appropriate ones to * foo_count. */ - long read_only_space_size = + sword_t read_only_space_size = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0) - (lispobj*)READ_ONLY_SPACE_START; - long static_space_size = + sword_t static_space_size = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER,0) - (lispobj*)STATIC_SPACE_START; struct thread *th; for_each_thread(th) { - long binding_stack_size = + sword_t binding_stack_size = (lispobj*)get_binding_stack_pointer(th) - (lispobj*)th->binding_stack_start; verify_space(th->binding_stack_start, binding_stack_size); @@ -3195,7 +3211,7 @@ verify_generation(generation_index_t generation) break; verify_space(page_address(i), - ((unsigned long) + ((uword_t) (page_table[last_page].bytes_used + npage_bytes(last_page-i))) / N_WORD_BYTES); @@ -3213,21 +3229,21 @@ verify_zero_fill(void) for (page = 0; page < last_free_page; page++) { if (page_free_p(page)) { /* The whole page should be zero filled. */ - long *start_addr = (long *)page_address(page); - long size = 1024; - long i; + sword_t *start_addr = (sword_t *)page_address(page); + sword_t size = 1024; + sword_t i; for (i = 0; i < size; i++) { if (start_addr[i] != 0) { lose("free page not zero at %x\n", start_addr + i); } } } else { - long free_bytes = GENCGC_CARD_BYTES - page_table[page].bytes_used; + sword_t free_bytes = GENCGC_CARD_BYTES - page_table[page].bytes_used; if (free_bytes > 0) { - long *start_addr = (long *)((unsigned long)page_address(page) + sword_t *start_addr = (sword_t *)((uword_t)page_address(page) + page_table[page].bytes_used); - long size = free_bytes / N_WORD_BYTES; - long i; + sword_t size = free_bytes / N_WORD_BYTES; + sword_t i; for (i = 0; i < size; i++) { if (start_addr[i] != 0) { lose("free region not zero at %x\n", start_addr + i); @@ -3309,7 +3325,7 @@ preserve_context_registers (os_context_t *c) /* On Darwin the signal context isn't a contiguous block of memory, * so just preserve_pointering its contents won't be sufficient. */ -#if defined(LISP_FEATURE_DARWIN) +#if defined(LISP_FEATURE_DARWIN)||defined(LISP_FEATURE_WIN32) #if defined LISP_FEATURE_X86 preserve_pointer((void*)*os_context_register_addr(c,reg_EAX)); preserve_pointer((void*)*os_context_register_addr(c,reg_ECX)); @@ -3338,9 +3354,11 @@ preserve_context_registers (os_context_t *c) #error "preserve_context_registers needs to be tweaked for non-x86 Darwin" #endif #endif +#if !defined(LISP_FEATURE_WIN32) for(ptr = ((void **)(c+1))-1; ptr>=(void **)c; ptr--) { preserve_pointer(*ptr); } +#endif } #endif @@ -3349,9 +3367,9 @@ preserve_context_registers (os_context_t *c) static void garbage_collect_generation(generation_index_t generation, int raise) { - unsigned long bytes_freed; + uword_t bytes_freed; page_index_t i; - unsigned long static_space_size; + uword_t static_space_size; struct thread *th; gc_assert(generation <= HIGHEST_NORMAL_GENERATION); @@ -3422,8 +3440,42 @@ garbage_collect_generation(generation_index_t generation, int raise) for_each_thread(th) { void **ptr; void **esp=(void **)-1; -#ifdef LISP_FEATURE_SB_THREAD - long i,free; + if (th->state == STATE_DEAD) + continue; +# if defined(LISP_FEATURE_SB_SAFEPOINT) + /* Conservative collect_garbage is always invoked with a + * foreign C call or an interrupt handler on top of every + * existing thread, so the stored SP in each thread + * structure is valid, no matter which thread we are looking + * at. For threads that were running Lisp code, the pitstop + * and edge functions maintain this value within the + * interrupt or exception handler. */ + esp = os_get_csp(th); + assert_on_stack(th, esp); + + /* In addition to pointers on the stack, also preserve the + * return PC, the only value from the context that we need + * in addition to the SP. The return PC gets saved by the + * foreign call wrapper, and removed from the control stack + * into a register. */ + preserve_pointer(th->pc_around_foreign_call); + + /* And on platforms with interrupts: scavenge ctx registers. */ + + /* Disabled on Windows, because it does not have an explicit + * stack of `interrupt_contexts'. The reported CSP has been + * chosen so that the current context on the stack is + * covered by the stack scan. See also set_csp_from_context(). */ +# ifndef LISP_FEATURE_WIN32 + if (th != arch_os_get_current_thread()) { + long k = fixnum_value( + SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,th)); + while (k > 0) + preserve_context_registers(th->interrupt_contexts[--k]); + } +# endif +# elif defined(LISP_FEATURE_SB_THREAD) + sword_t i,free; if(th==arch_os_get_current_thread()) { /* Somebody is going to burn in hell for this, but casting * it in two steps shuts gcc up about strict aliasing. */ @@ -3441,9 +3493,12 @@ garbage_collect_generation(generation_index_t generation, int raise) } } } -#else +# else esp = (void **)((void *)&raise); -#endif +# endif + if (!esp || esp == (void*) -1) + lose("garbage_collect: no SP known for thread %x (OS %x)", + th, th->os_thread); for (ptr = ((void **)th->control_stack_end)-1; ptr >= esp; ptr--) { preserve_pointer(*ptr); } @@ -3466,7 +3521,7 @@ garbage_collect_generation(generation_index_t generation, int raise) #if QSHOW if (gencgc_verbose > 1) { - long num_dont_move_pages = count_dont_move_pages(); + sword_t num_dont_move_pages = count_dont_move_pages(); fprintf(stderr, "/non-movable pages due to conservative pointers = %d (%d bytes)\n", num_dont_move_pages, @@ -3488,10 +3543,18 @@ garbage_collect_generation(generation_index_t generation, int raise) scavenge_control_stack(th); } +# ifdef LISP_FEATURE_SB_SAFEPOINT + /* In this case, scrub all stacks right here from the GCing thread + * instead of doing what the comment below says. Suboptimal, but + * easier. */ + for_each_thread(th) + scrub_thread_control_stack(th); +# else /* 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 } #endif @@ -3508,7 +3571,7 @@ garbage_collect_generation(generation_index_t generation, int raise) { struct thread *th; for_each_thread(th) { - long len= (lispobj *)get_binding_stack_pointer(th) - + sword_t len= (lispobj *)get_binding_stack_pointer(th) - th->binding_stack_start; scavenge((lispobj *) th->binding_stack_start,len); #ifdef LISP_FEATURE_SB_THREAD @@ -3529,7 +3592,7 @@ garbage_collect_generation(generation_index_t generation, int raise) * please submit a patch. */ #if 0 if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) { - unsigned long read_only_space_size = + uword_t read_only_space_size = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - (lispobj*)READ_ONLY_SPACE_START; FSHOW((stderr, @@ -3637,7 +3700,7 @@ garbage_collect_generation(generation_index_t generation, int raise) } /* Update last_free_page, then SymbolValue(ALLOCATION_POINTER). */ -long +sword_t update_dynamic_space_free_pointer(void) { page_index_t last_page = -1, i; @@ -3847,7 +3910,7 @@ collect_garbage(generation_index_t last_gen) /* Update auto_gc_trigger. Make sure we trigger the next GC before * running out of heap! */ - if (bytes_consed_between_gcs >= dynamic_space_size - bytes_allocated) + if (bytes_consed_between_gcs <= (dynamic_space_size - bytes_allocated)) auto_gc_trigger = bytes_allocated + bytes_consed_between_gcs; else auto_gc_trigger = bytes_allocated + (dynamic_space_size - bytes_allocated)/2; @@ -3913,12 +3976,12 @@ gc_free_heap(void) #endif } else if (gencgc_zero_check_during_free_heap) { /* Double-check that the page is zero filled. */ - long *page_start; + sword_t *page_start; page_index_t i; gc_assert(page_free_p(page)); gc_assert(page_table[page].bytes_used == 0); - page_start = (long *)page_address(page); - for (i=0; i0); /* Check for alignment allocation problems. */ - gc_assert((((unsigned long)region->free_pointer & LOWTAG_MASK) == 0) + gc_assert((((uword_t)region->free_pointer & LOWTAG_MASK) == 0) && ((nbytes & LOWTAG_MASK) == 0)); +#if !(defined(LISP_FEATURE_WIN32) && defined(LISP_FEATURE_SB_THREAD)) /* Must be inside a PA section. */ gc_assert(get_pseudo_atomic_atomic(thread)); +#endif if (nbytes > large_allocation) large_allocation = nbytes; @@ -4146,10 +4217,19 @@ general_alloc_internal(long nbytes, int page_type_flag, struct alloc_region *reg return(new_obj); /* yup */ } + /* We don't want to count nbytes against auto_gc_trigger unless we + * have to: it speeds up the tenuring of objects and slows down + * allocation. However, unless we do so when allocating _very_ + * large objects we are in danger of exhausting the heap without + * running sufficient GCs. + */ + if (nbytes >= bytes_consed_between_gcs) + trigger_bytes = nbytes; + /* we have to go the long way around, it seems. Check whether we * should GC in the near future */ - if (auto_gc_trigger && bytes_allocated+nbytes > auto_gc_trigger) { + if (auto_gc_trigger && (bytes_allocated+trigger_bytes > auto_gc_trigger)) { /* Don't flood the system with interrupts if the need to gc is * already noted. This can happen for example when SUB-GC * allocates or after a gc triggered in a WITHOUT-GCING. */ @@ -4158,8 +4238,11 @@ general_alloc_internal(long nbytes, int page_type_flag, struct alloc_region *reg * section */ SetSymbolValue(GC_PENDING,T,thread); if (SymbolValue(GC_INHIBIT,thread) == NIL) { +#ifdef LISP_FEATURE_SB_SAFEPOINT + thread_register_gc_trigger(); +#else set_pseudo_atomic_interrupted(thread); -#ifdef LISP_FEATURE_PPC +#ifdef GENCGC_IS_PRECISE /* PPC calls alloc() from a trap or from pa_alloc(), * look up the most context if it's from a trap. */ { @@ -4171,15 +4254,17 @@ general_alloc_internal(long nbytes, int page_type_flag, struct alloc_region *reg #else maybe_save_gc_mask_and_block_deferrables(NULL); #endif +#endif } } } new_obj = gc_alloc_with_region(nbytes, page_type_flag, region, 0); #ifndef LISP_FEATURE_WIN32 + /* for sb-prof, and not supported on Windows yet */ alloc_signal = SymbolValue(ALLOC_SIGNAL,thread); if ((alloc_signal & FIXNUM_TAG_MASK) == 0) { - if ((signed long) alloc_signal <= 0) { + if ((sword_t) alloc_signal <= 0) { SetSymbolValue(ALLOC_SIGNAL, T, thread); raise(SIGPROF); } else { @@ -4194,7 +4279,7 @@ general_alloc_internal(long nbytes, int page_type_flag, struct alloc_region *reg } lispobj * -general_alloc(long nbytes, int page_type_flag) +general_alloc(sword_t nbytes, int page_type_flag) { struct thread *thread = arch_os_get_current_thread(); /* Select correct region, and call general_alloc_internal with it. @@ -4218,11 +4303,26 @@ general_alloc(long nbytes, int page_type_flag) } } -lispobj * +lispobj AMD64_SYSV_ABI * alloc(long nbytes) { +#ifdef LISP_FEATURE_SB_SAFEPOINT_STRICTLY + struct thread *self = arch_os_get_current_thread(); + int was_pseudo_atomic = get_pseudo_atomic_atomic(self); + if (!was_pseudo_atomic) + set_pseudo_atomic_atomic(self); +#else gc_assert(get_pseudo_atomic_atomic(arch_os_get_current_thread())); - return general_alloc(nbytes, BOXED_PAGE_FLAG); +#endif + + lispobj *result = general_alloc(nbytes, BOXED_PAGE_FLAG); + +#ifdef LISP_FEATURE_SB_SAFEPOINT_STRICTLY + if (!was_pseudo_atomic) + clear_pseudo_atomic_atomic(self); +#endif + + return result; } /* @@ -4332,8 +4432,12 @@ void gc_alloc_update_all_page_tables(void) { /* Flush the alloc regions updating the tables. */ struct thread *th; - for_each_thread(th) + for_each_thread(th) { gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->alloc_region); +#if defined(LISP_FEATURE_SB_SAFEPOINT_STRICTLY) && !defined(LISP_FEATURE_WIN32) + gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &th->sprof_alloc_region); +#endif + } gc_alloc_update_page_tables(UNBOXED_PAGE_FLAG, &unboxed_region); gc_alloc_update_page_tables(BOXED_PAGE_FLAG, &boxed_region); }