os_vm_size_t large_object_size = 4 * PAGE_BYTES;
#endif
+/* Largest allocation seen since last GC. */
+os_vm_size_t large_allocation = 0;
+
\f
/*
* debugging
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;
size_t size;
};
static struct new_area (*new_areas)[];
-static long new_areas_index;
-long max_new_areas;
+static size_t new_areas_index;
+size_t max_new_areas;
/* Add a new area to new_areas. */
static void
add_new_area(page_index_t first_page, size_t offset, size_t size)
{
- unsigned long new_area_start,c;
- long i;
+ size_t new_area_start, c;
+ ssize_t i;
/* Ignore if full. */
if (new_areas_index >= NUM_NEW_AREAS)
/* Search backwards for a prior area that this follows from. If
found this will save adding a new area. */
for (i = new_areas_index-1, c = 0; (i >= 0) && (c < 8); i--, c++) {
- unsigned long area_end =
+ size_t area_end =
npage_bytes((*new_areas)[i].page)
+ (*new_areas)[i].offset
+ (*new_areas)[i].size;
lispobj
copy_unboxed_object(lispobj object, long nwords)
{
- long tag;
- lispobj *new;
-
- gc_assert(is_lisp_pointer(object));
- gc_assert(from_space_p(object));
- gc_assert((nwords & 0x01) == 0);
-
- /* Get tag of object. */
- tag = lowtag_of(object);
-
- /* Allocate space. */
- new = gc_quick_alloc_unboxed(nwords*N_WORD_BYTES);
-
- memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
-
- /* Return Lisp pointer of new object. */
- return ((lispobj) new) | tag;
+ return gc_general_copy_object(object, nwords, UNBOXED_PAGE_FLAG);
}
\f
* Currently only absolute fixups to the constant vector, or to the
* code area are checked. */
void
-sniff_code_object(struct code *code, unsigned long displacement)
+sniff_code_object(struct code *code, os_vm_size_t displacement)
{
#ifdef LISP_FEATURE_X86
long nheader_words, ncode_words, nwords;
- void *p;
- void *constants_start_addr = NULL, *constants_end_addr;
- void *code_start_addr, *code_end_addr;
+ 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;
int fixup_found = 0;
if (!check_code_fixups)
nheader_words = HeaderValue(*(lispobj *)code);
nwords = ncode_words + nheader_words;
- constants_start_addr = (void *)code + 5*N_WORD_BYTES;
- constants_end_addr = (void *)code + nheader_words*N_WORD_BYTES;
- code_start_addr = (void *)code + nheader_words*N_WORD_BYTES;
- code_end_addr = (void *)code + nwords*N_WORD_BYTES;
+ constants_start_addr = code_addr + 5*N_WORD_BYTES;
+ constants_end_addr = code_addr + nheader_words*N_WORD_BYTES;
+ code_start_addr = code_addr + nheader_words*N_WORD_BYTES;
+ code_end_addr = code_addr + nwords*N_WORD_BYTES;
/* Work through the unboxed code. */
for (p = code_start_addr; p < code_end_addr; p++) {
/* Check for code references. */
/* Check for a 32 bit word that looks like an absolute
reference to within the code adea of the code object. */
- if ((data >= (code_start_addr-displacement))
- && (data < (code_end_addr-displacement))) {
+ if ((data >= (void*)(code_start_addr-displacement))
+ && (data < (void*)(code_end_addr-displacement))) {
/* function header */
if ((d4 == 0x5e)
&& (((unsigned)p - 4 - 4*HeaderValue(*((unsigned *)p-1))) ==
/* Check for a 32 bit word that looks like an absolute
reference to within the constant vector. Constant references
will be aligned. */
- if ((data >= (constants_start_addr-displacement))
- && (data < (constants_end_addr-displacement))
+ if ((data >= (void*)(constants_start_addr-displacement))
+ && (data < (void*)(constants_end_addr-displacement))
&& (((unsigned)data & 0x3) == 0)) {
/* Mov eax,m32 */
if (d1 == 0xa1) {
/* x86-64 uses pc-relative addressing instead of this kludge */
#ifndef LISP_FEATURE_X86_64
long nheader_words, ncode_words, nwords;
- void *constants_start_addr, *constants_end_addr;
- void *code_start_addr, *code_end_addr;
+ 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;
+ os_vm_address_t old_addr = (os_vm_address_t)old_code;
+ os_vm_size_t displacement = code_addr - old_addr;
lispobj fixups = NIL;
- unsigned long displacement =
- (unsigned long)new_code - (unsigned long)old_code;
struct vector *fixups_vector;
ncode_words = fixnum_value(new_code->code_size);
/* FSHOW((stderr,
"/compiled code object at %x: header words = %d, code words = %d\n",
new_code, nheader_words, ncode_words)); */
- constants_start_addr = (void *)new_code + 5*N_WORD_BYTES;
- constants_end_addr = (void *)new_code + nheader_words*N_WORD_BYTES;
- code_start_addr = (void *)new_code + nheader_words*N_WORD_BYTES;
- code_end_addr = (void *)new_code + nwords*N_WORD_BYTES;
+ constants_start_addr = code_addr + 5*N_WORD_BYTES;
+ constants_end_addr = code_addr + nheader_words*N_WORD_BYTES;
+ code_start_addr = code_addr + nheader_words*N_WORD_BYTES;
+ code_end_addr = code_addr + nwords*N_WORD_BYTES;
/*
FSHOW((stderr,
"/const start = %x, end = %x\n",
long length = fixnum_value(fixups_vector->length);
long i;
for (i = 0; i < length; i++) {
- unsigned long offset = fixups_vector->data[i];
+ long offset = fixups_vector->data[i];
/* Now check the current value of offset. */
- unsigned long old_value =
- *(unsigned long *)((unsigned long)code_start_addr + offset);
+ os_vm_address_t old_value = *(os_vm_address_t *)(code_start_addr + offset);
/* If it's within the old_code object then it must be an
* absolute fixup (relative ones are not saved) */
- if ((old_value >= (unsigned long)old_code)
- && (old_value < ((unsigned long)old_code
- + nwords*N_WORD_BYTES)))
+ if ((old_value >= old_addr)
+ && (old_value < (old_addr + nwords*N_WORD_BYTES)))
/* So add the dispacement. */
- *(unsigned long *)((unsigned long)code_start_addr + offset) =
+ *(os_vm_address_t *)(code_start_addr + offset) =
old_value + displacement;
else
/* It is outside the old code object so it must be a
* relative fixup (absolute fixups are not saved). So
* subtract the displacement. */
- *(unsigned long *)((unsigned long)code_start_addr + offset) =
+ *(os_vm_address_t *)(code_start_addr + offset) =
old_value - displacement;
}
} else {
static void
scavenge_newspace_generation(generation_index_t generation)
{
- long i;
+ size_t i;
/* the new_areas array currently being written to by gc_alloc() */
struct new_area (*current_new_areas)[] = &new_areas_1;
- long current_new_areas_index;
+ size_t current_new_areas_index;
/* the new_areas created by the previous scavenge cycle */
struct new_area (*previous_new_areas)[] = NULL;
- long previous_new_areas_index;
+ size_t previous_new_areas_index;
/* Flush the current regions updating the tables. */
gc_alloc_update_all_page_tables();
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,
for_each_thread(th) {
void **ptr;
void **esp=(void **)-1;
-#ifdef LISP_FEATURE_SB_THREAD
+ 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)
long i,free;
if(th==arch_os_get_current_thread()) {
/* Somebody is going to burn in hell for this, but casting
}
}
}
-#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);
}
collect_garbage(generation_index_t last_gen)
{
generation_index_t gen = 0, i;
- int raise;
+ int raise, more = 0;
int gen_to_wp;
/* The largest value of last_free_page seen since the time
* remap_free_pages was called. */
do {
/* Collect the generation. */
- if (gen >= gencgc_oldest_gen_to_gc) {
- /* Never raise the oldest generation. */
+ if (more || (gen >= gencgc_oldest_gen_to_gc)) {
+ /* Never raise the oldest generation. Never raise the extra generation
+ * collected due to more-flag. */
raise = 0;
+ more = 0;
} else {
raise =
(gen < last_gen)
|| (generations[gen].num_gc >= generations[gen].number_of_gcs_before_promotion);
+ /* If we would not normally raise this one, but we're
+ * running low on space in comparison to the object-sizes
+ * we've been seeing, raise it and collect the next one
+ * too. */
+ if (!raise && gen == last_gen) {
+ more = (2*large_allocation) >= (dynamic_space_size - bytes_allocated);
+ raise = more;
+ }
}
if (gencgc_verbose > 1) {
gen++;
} while ((gen <= gencgc_oldest_gen_to_gc)
&& ((gen < last_gen)
- || ((gen <= gencgc_oldest_gen_to_gc)
- && raise
+ || more
+ || (raise
&& (generations[gen].bytes_allocated
> generations[gen].gc_trigger)
&& (generation_average_age(gen)
update_dynamic_space_free_pointer();
- auto_gc_trigger = bytes_allocated + bytes_consed_between_gcs;
+ /* 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))
+ auto_gc_trigger = bytes_allocated + bytes_consed_between_gcs;
+ else
+ auto_gc_trigger = bytes_allocated + (dynamic_space_size - bytes_allocated)/2;
+
if(gencgc_verbose)
fprintf(stderr,"Next gc when %"OS_VM_SIZE_FMT" bytes have been consed\n",
auto_gc_trigger);
}
gc_active_p = 0;
+ large_allocation = 0;
log_generation_stats(gc_logfile, "=== GC End ===");
SHOW("returning from collect_garbage");
generations[i].num_gc = 0;
generations[i].cum_sum_bytes_allocated = 0;
/* the tune-able parameters */
- generations[i].bytes_consed_between_gc = bytes_consed_between_gcs;
+ generations[i].bytes_consed_between_gc
+ = bytes_consed_between_gcs/(os_vm_size_t)HIGHEST_NORMAL_GENERATION;
generations[i].number_of_gcs_before_promotion = 1;
generations[i].minimum_age_before_gc = 0.75;
}
#endif
void *new_obj;
void *new_free_pointer;
+ os_vm_size_t trigger_bytes = 0;
gc_assert(nbytes>0);
/* Must be inside a PA section. */
gc_assert(get_pseudo_atomic_atomic(thread));
+ if (nbytes > large_allocation)
+ large_allocation = nbytes;
+
/* maybe we can do this quickly ... */
new_free_pointer = region->free_pointer + nbytes;
if (new_free_pointer <= region->end_addr) {
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 > 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. */
* 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
/* PPC calls alloc() from a trap or from pa_alloc(),
#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) {