#include "genesis/simple-fun.h"
#include "save.h"
#include "genesis/hash-table.h"
+#include "genesis/instance.h"
+#include "genesis/layout.h"
/* forward declarations */
page_index_t gc_find_freeish_pages(long *restart_page_ptr, long nbytes,
* that don't have pointers to younger generations? */
boolean enable_page_protection = 1;
-/* Should we unmap a page and re-mmap it to have it zero filled? */
-#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__sun)
-/* comment from cmucl-2.4.8: This can waste a lot of swap on FreeBSD
- * so don't unmap there.
- *
- * The CMU CL comment didn't specify a version, but was probably an
- * old version of FreeBSD (pre-4.0), so this might no longer be true.
- * OTOH, if it is true, this behavior might exist on OpenBSD too, so
- * for now we don't unmap there either. -- WHN 2001-04-07 */
-/* Apparently this flag is required to be 0 for SunOS/x86, as there
- * are reports of heap corruption otherwise. */
-boolean gencgc_unmap_zero = 0;
-#else
-boolean gencgc_unmap_zero = 1;
-#endif
-
/* the minimum size (in bytes) for a large object*/
unsigned long large_object_size = 4 * PAGE_BYTES;
* contained a pagetable entry).
*/
boolean gencgc_partial_pickup = 0;
+
+/* If defined, free pages are read-protected to ensure that nothing
+ * accesses them.
+ */
+
+/* #define READ_PROTECT_FREE_PAGES */
+
\f
/*
* GC structures and variables
/ ((double)generations[gen].bytes_allocated);
}
-void fpu_save(int *); /* defined in x86-assem.S */
-void fpu_restore(int *); /* defined in x86-assem.S */
/* The verbose argument controls how much to print: 0 for normal
* level of detail; 1 for debugging. */
static void
print_generation_stats(int verbose) /* FIXME: should take FILE argument */
{
generation_index_t i, gens;
- int fpu_state[27];
+
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+#define FPU_STATE_SIZE 27
+ int fpu_state[FPU_STATE_SIZE];
+#elif defined(LISP_FEATURE_PPC)
+#define FPU_STATE_SIZE 32
+ long long fpu_state[FPU_STATE_SIZE];
+#endif
/* This code uses the FP instructions which may be set up for Lisp
* so they need to be saved and reset for C. */
/* Print the heap stats. */
fprintf(stderr,
- " Gen Boxed Unboxed LB LUB !move Alloc Waste Trig WP GCs Mem-age\n");
+ " Gen StaPg UbSta LaSta LUbSt Boxed Unboxed LB LUB !move Alloc Waste Trig WP GCs Mem-age\n");
for (i = 0; i < gens; i++) {
page_index_t j;
gc_assert(generations[i].bytes_allocated
== count_generation_bytes_allocated(i));
fprintf(stderr,
- " %1d: %5ld %5ld %5ld %5ld %5ld %8ld %5ld %8ld %4ld %3d %7.4f\n",
+ " %1d: %5ld %5ld %5ld %5ld %5ld %5ld %5ld %5ld %8ld %5ld %8ld %4ld %3d %7.4f\n",
i,
+ generations[i].alloc_start_page,
+ generations[i].alloc_unboxed_start_page,
+ generations[i].alloc_large_start_page,
+ generations[i].alloc_large_unboxed_start_page,
boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt,
pinned_cnt,
generations[i].bytes_allocated,
fpu_restore(fpu_state);
}
\f
-/*
- * allocation routines
+
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+void fast_bzero(void*, size_t); /* in <arch>-assem.S */
+#endif
+
+/* Zero the pages from START to END (inclusive), but use mmap/munmap instead
+ * if zeroing it ourselves, i.e. in practice give the memory back to the
+ * OS. Generally done after a large GC.
+ */
+void zero_pages_with_mmap(page_index_t start, page_index_t end) {
+ int i;
+ void *addr = (void *) page_address(start), *new_addr;
+ size_t length = PAGE_BYTES*(1+end-start);
+
+ if (start > end)
+ return;
+
+ os_invalidate(addr, length);
+ new_addr = os_validate(addr, length);
+ if (new_addr == NULL || new_addr != addr) {
+ lose("remap_free_pages: page moved, 0x%08x ==> 0x%08x", start, new_addr);
+ }
+
+ for (i = start; i <= end; i++) {
+ page_table[i].need_to_zero = 0;
+ }
+}
+
+/* Zero the pages from START to END (inclusive). Generally done just after
+ * a new region has been allocated.
+ */
+static void
+zero_pages(page_index_t start, page_index_t end) {
+ if (start > end)
+ return;
+
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+ fast_bzero(page_address(start), PAGE_BYTES*(1+end-start));
+#else
+ bzero(page_address(start), PAGE_BYTES*(1+end-start));
+#endif
+
+}
+
+/* Zero the pages from START to END (inclusive), except for those
+ * pages that are known to already zeroed. Mark all pages in the
+ * ranges as non-zeroed.
*/
+static void
+zero_dirty_pages(page_index_t start, page_index_t end) {
+ page_index_t i;
+
+ for (i = start; i <= end; i++) {
+ if (page_table[i].need_to_zero == 1) {
+ zero_pages(start, end);
+ break;
+ }
+ }
+
+ for (i = start; i <= end; i++) {
+ page_table[i].need_to_zero = 1;
+ }
+}
+
/*
* To support quick and inline allocation, regions of memory can be
/* Bump up last_free_page. */
if (last_page+1 > last_free_page) {
last_free_page = last_page+1;
- SetSymbolValue(ALLOCATION_POINTER,
- (lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES),
- 0);
+ /* do we only want to call this on special occasions? like for boxed_region? */
+ set_alloc_pointer((lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES));
}
thread_mutex_unlock(&free_pages_lock);
* (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.", p);
+ 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),
+ OS_VM_PROT_ALL);
+#endif
+
+ /* If the first page was only partial, don't check whether it's
+ * zeroed (it won't be) and don't zero it (since the parts that
+ * we're interested in are guaranteed to be zeroed).
+ */
+ if (page_table[first_page].bytes_used) {
+ first_page++;
+ }
+
+ zero_dirty_pages(first_page, last_page);
}
/* If the record_new_objects flag is 2 then all new regions created
/* Bump up last_free_page */
if (last_page+1 > last_free_page) {
last_free_page = last_page+1;
- SetSymbolValue(ALLOCATION_POINTER,
- (lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES),0);
+ set_alloc_pointer((lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES));
}
thread_mutex_unlock(&free_pages_lock);
- return((void *)(page_address(first_page)+orig_first_page_bytes_used));
+#ifdef READ_PROTECT_FREE_PAGES
+ os_protect(page_address(first_page),
+ PAGE_BYTES*(1+last_page-first_page),
+ OS_VM_PROT_ALL);
+#endif
+
+ zero_dirty_pages(first_page, last_page);
+
+ return page_address(first_page);
}
static page_index_t gencgc_alloc_start_page = -1;
"Argh! gc_find_free_space failed (first_page), nbytes=%ld.\n",
nbytes);
print_generation_stats(1);
- lose(NULL);
+ lose("\n");
}
gc_assert(page_table[first_page].write_protected == 0);
"Argh! gc_find_freeish_pages failed (restart_page), nbytes=%ld.\n",
nbytes);
print_generation_stats(1);
- lose(NULL);
+ lose("\n");
}
*restart_page_ptr=first_page;
/* FIXME: What does this mean? */
int gencgc_hash = 1;
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+
static long
scav_vector(lispobj *where, lispobj object)
{
/* Scavenge element 0, which may be a hash-table structure. */
scavenge(where+2, 1);
if (!is_lisp_pointer(where[2])) {
- lose("no pointer at %x in hash table", where[2]);
+ lose("no pointer at %x in hash table\n", where[2]);
}
hash_table = (struct hash_table *)native_pointer(where[2]);
/*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/
if (widetag_of(hash_table->header) != INSTANCE_HEADER_WIDETAG) {
- lose("hash table not instance (%x at %x)",
+ lose("hash table not instance (%x at %x)\n",
hash_table->header,
hash_table);
}
* the hash table code reserves for marking empty slots. */
scavenge(where+3, 1);
if (!is_lisp_pointer(where[3])) {
- lose("not empty-hash-table-slot symbol pointer: %x", where[3]);
+ lose("not empty-hash-table-slot symbol pointer: %x\n", where[3]);
}
empty_symbol = where[3];
/* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/
if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) !=
SYMBOL_HEADER_WIDETAG) {
- lose("not a symbol where empty-hash-table-slot symbol expected: %x",
+ lose("not a symbol where empty-hash-table-slot symbol expected: %x\n",
*(lispobj *)native_pointer(empty_symbol));
}
/* Cross-check the kv_vector. */
if (where != (lispobj *)native_pointer(hash_table->table)) {
- lose("hash_table table!=this table %x", hash_table->table);
+ lose("hash_table table!=this table %x\n", hash_table->table);
}
/* WEAK-P */
length = fixnum_value(((lispobj *)native_pointer(index_vector_obj))[1]);
/*FSHOW((stderr, "/length = %d\n", length));*/
} else {
- lose("invalid index_vector %x", index_vector_obj);
+ lose("invalid index_vector %x\n", index_vector_obj);
}
}
next_vector_length = fixnum_value(((lispobj *)native_pointer(next_vector_obj))[1]);
/*FSHOW((stderr, "/next_vector_length = %d\n", next_vector_length));*/
} else {
- lose("invalid next_vector %x", next_vector_obj);
+ lose("invalid next_vector %x\n", next_vector_obj);
}
}
return (CEILING(kv_length + 2, 2));
}
+#else
+
+static long
+scav_vector(lispobj *where, lispobj object)
+{
+ if (HeaderValue(object) == subtype_VectorValidHashing) {
+ *where =
+ (subtype_VectorMustRehash<<N_WIDETAG_BITS) | SIMPLE_VECTOR_WIDETAG;
+ }
+ return 1;
+}
+
+#endif
\f
/*
return 1;
}
+#if 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
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.
*
*
* 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)
{
/* Check that the page is now static. */
gc_assert(page_table[addr_page_index].dont_move != 0);
}
+
+#endif
+
\f
/* If the given page is not write-protected, then scan it for pointers
* to younger generations or the top temp. generation, if no
return (wp_it);
}
-/* Scavenge a generation.
- *
- * This will not resolve all pointers when generation is the new
- * space, as new objects may be added which are not checked here - use
- * scavenge_newspace generation.
+/* Scavenge all generations from FROM to TO, inclusive, except for
+ * new_space which needs special handling, as new objects may be
+ * added which are not checked here - use scavenge_newspace generation.
*
* Write-protected pages should not have any pointers to the
* from_space so do need scavenging; thus write-protected pages are
* pointers as the objects contain a link to the next and are written
* if a weak pointer is scavenged. Still it's a useful check. */
static void
-scavenge_generation(generation_index_t generation)
+scavenge_generations(generation_index_t from, generation_index_t to)
{
page_index_t i;
int num_wp = 0;
#endif
for (i = 0; i < last_free_page; i++) {
+ generation_index_t generation = page_table[i].gen;
if ((page_table[i].allocated & BOXED_PAGE_FLAG)
&& (page_table[i].bytes_used != 0)
- && (page_table[i].gen == generation)) {
+ && (generation != new_space)
+ && (generation >= from)
+ && (generation <= to)) {
page_index_t last_page,j;
int write_protected=1;
num_wp += update_page_write_prot(j);
}
}
+ if ((gencgc_verbose > 1) && (num_wp != 0)) {
+ FSHOW((stderr,
+ "/write protected %d pages within generation %d\n",
+ num_wp, generation));
+ }
}
i = last_page;
}
}
- if ((gencgc_verbose > 1) && (num_wp != 0)) {
- FSHOW((stderr,
- "/write protected %d pages within generation %d\n",
- num_wp, generation));
- }
#if SC_GEN_CK
/* Check that none of the write_protected pages in this generation
page_table[i].bytes_used,
page_table[i].first_object_offset,
page_table[i].dont_move));
- lose("write to protected page %d in scavenge_generation()", i);
+ lose("write to protected page %d in scavenge_generation()\n", i);
}
}
#endif
&& (page_table[i].gen == generation)
&& (page_table[i].write_protected_cleared != 0)
&& (page_table[i].dont_move == 0)) {
- lose("write protected page %d written to in scavenge_newspace_generation\ngeneration=%d dont_move=%d",
+ lose("write protected page %d written to in scavenge_newspace_generation\ngeneration=%d dont_move=%d\n",
i, generation, page_table[i].dont_move);
}
}
&& (page_table[last_page].bytes_used != 0)
&& (page_table[last_page].gen == from_space));
- /* Zero pages from first_page to (last_page-1).
- *
- * FIXME: Why not use os_zero(..) function instead of
- * hand-coding this again? (Check other gencgc_unmap_zero
- * stuff too. */
- if (gencgc_unmap_zero) {
- void *page_start, *addr;
-
- page_start = (void *)page_address(first_page);
-
- os_invalidate(page_start, PAGE_BYTES*(last_page-first_page));
- addr = os_validate(page_start, PAGE_BYTES*(last_page-first_page));
- if (addr == NULL || addr != page_start) {
- lose("free_oldspace: page moved, 0x%08x ==> 0x%08x",page_start,
- addr);
- }
- } else {
- long *page_start;
-
- page_start = (long *)page_address(first_page);
- memset(page_start, 0,PAGE_BYTES*(last_page-first_page));
- }
-
+#ifdef READ_PROTECT_FREE_PAGES
+ os_protect(page_address(first_page),
+ PAGE_BYTES*(last_page-first_page),
+ OS_VM_PROT_NONE);
+#endif
first_page = last_page;
-
} while (first_page < last_free_page);
bytes_allocated -= bytes_freed;
}
#endif
-extern long undefined_tramp;
+#if defined(LISP_FEATURE_PPC)
+extern int closure_tramp;
+extern int undefined_tramp;
+#else
+extern int undefined_tramp;
+#endif
static void
verify_space(lispobj *start, size_t words)
* page. XX Could check the offset too. */
if ((page_table[page_index].allocated != FREE_PAGE_FLAG)
&& (page_table[page_index].bytes_used == 0))
- lose ("Ptr %x @ %x sees free page.", thing, start);
+ lose ("Ptr %x @ %x 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.", thing, start);
+ lose("Ptr %x @ %x 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",
+ lose("ptr to dynamic space %x from RO space %x\n",
thing, start);
}
/* Does it point to a plausible object? This check slows
* dynamically. */
/*
if (!possibly_valid_dynamic_space_pointer((lispobj *)thing)) {
- lose("ptr %x to invalid object %x", thing, start);
+ lose("ptr %x to invalid object %x\n", thing, start);
}
*/
} else {
/* Verify that it points to another valid space. */
- if (!to_readonly_space && !to_static_space
- && (thing != (unsigned long)&undefined_tramp)) {
- lose("Ptr %x @ %x sees junk.", thing, start);
+ if (!to_readonly_space && !to_static_space &&
+#if defined(LISP_FEATURE_PPC)
+ !((thing == &closure_tramp) ||
+ (thing == &undefined_tramp))
+#else
+ thing != (unsigned long)&undefined_tramp
+#endif
+ ) {
+ lose("Ptr %x @ %x sees junk.\n", thing, start);
}
}
} else {
case SINGLE_FLOAT_WIDETAG:
#endif
case UNBOUND_MARKER_WIDETAG:
- case INSTANCE_HEADER_WIDETAG:
case FDEFN_WIDETAG:
count = 1;
break;
+ case INSTANCE_HEADER_WIDETAG:
+ {
+ lispobj nuntagged;
+ long ntotal = HeaderValue(thing);
+ lispobj layout = ((struct instance *)start)->slots[0];
+ if (!layout) {
+ count = 1;
+ break;
+ }
+ nuntagged = ((struct layout *)native_pointer(layout))->n_untagged_slots;
+ verify_space(start + 1, ntotal - fixnum_value(nuntagged));
+ count = ntotal + 1;
+ break;
+ }
case CODE_HEADER_WIDETAG:
{
lispobj object = *start;
break;
default:
+ FSHOW((stderr,
+ "/Unhandled widetag 0x%x at 0x%x\n",
+ widetag_of(*start), start));
+ fflush(stderr);
gc_abort();
}
}
struct thread *th;
for_each_thread(th) {
long binding_stack_size =
- (lispobj*)SymbolValue(BINDING_STACK_POINTER,th)
+ (lispobj*)get_binding_stack_pointer(th)
- (lispobj*)th->binding_stack_start;
verify_space(th->binding_stack_start, binding_stack_size);
}
long i;
for (i = 0; i < size; i++) {
if (start_addr[i] != 0) {
- lose("free page not zero at %x", start_addr + i);
+ lose("free page not zero at %x\n", start_addr + i);
}
}
} else {
long i;
for (i = 0; i < size; i++) {
if (start_addr[i] != 0) {
- lose("free region not zero at %x", start_addr + i);
+ lose("free region not zero at %x\n", start_addr + i);
}
}
}
static void
write_protect_generation_pages(generation_index_t generation)
{
- page_index_t i;
+ page_index_t start;
gc_assert(generation < SCRATCH_GENERATION);
- for (i = 0; i < last_free_page; i++)
- if ((page_table[i].allocated == BOXED_PAGE_FLAG)
- && (page_table[i].bytes_used != 0)
- && !page_table[i].dont_move
- && (page_table[i].gen == generation)) {
+ for (start = 0; start < last_free_page; start++) {
+ if ((page_table[start].allocated == BOXED_PAGE_FLAG)
+ && (page_table[start].bytes_used != 0)
+ && !page_table[start].dont_move
+ && (page_table[start].gen == generation)) {
void *page_start;
+ page_index_t last;
- page_start = (void *)page_address(i);
+ /* Note the page as protected in the page tables. */
+ page_table[start].write_protected = 1;
+
+ for (last = start + 1; last < last_free_page; last++) {
+ if ((page_table[last].allocated != BOXED_PAGE_FLAG)
+ || (page_table[last].bytes_used == 0)
+ || page_table[last].dont_move
+ || (page_table[last].gen != generation))
+ break;
+ page_table[last].write_protected = 1;
+ }
+
+ page_start = (void *)page_address(start);
os_protect(page_start,
- PAGE_BYTES,
+ PAGE_BYTES * (last - start),
OS_VM_PROT_READ | OS_VM_PROT_EXECUTE);
- /* Note the page as protected in the page tables. */
- page_table[i].write_protected = 1;
+ start = last;
}
+ }
if (gencgc_verbose > 1) {
FSHOW((stderr,
}
}
+static void
+scavenge_control_stack()
+{
+ 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);
+
+ control_stack_size = current_control_stack_pointer - control_stack;
+ scavenge(control_stack, control_stack_size);
+}
+
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+/* 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<<N_LOWTAG_BITS)-1)) <= lip) {
+ offset = lip - reg;
+ if (offset < lip_offset) {
+ lip_offset = offset;
+ lip_register_pair = index;
+ }
+ }
+ }
+#endif /* reg_LIP */
+
+ /* Compute the PC's offset from the start of the CODE */
+ /* register. */
+ pc_code_offset = *os_context_pc_addr(context) - *os_context_register_addr(context, reg_CODE);
+#ifdef ARCH_HAS_NPC_REGISTER
+ npc_code_offset = *os_context_npc_addr(context) - *os_context_register_addr(context, reg_CODE);
+#endif /* ARCH_HAS_NPC_REGISTER */
+
+#ifdef ARCH_HAS_LINK_REGISTER
+ lr_code_offset =
+ *os_context_lr_addr(context) -
+ *os_context_register_addr(context, reg_CODE);
+#endif
+
+ /* Scanvenge all boxed registers in the context. */
+ for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
+ int index;
+ lispobj foo;
+
+ index = boxed_registers[i];
+ foo = *os_context_register_addr(context, index);
+ scavenge(&foo, 1);
+ *os_context_register_addr(context, index) = foo;
+
+ scavenge((lispobj*) &(*os_context_register_addr(context, index)), 1);
+ }
+
+#ifdef reg_LIP
+ /* Fix the LIP */
+
+ /*
+ * But what happens if lip_register_pair is -1? *os_context_register_addr on Solaris
+ * (see solaris_register_address in solaris-os.c) will return
+ * &context->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
+
/* Garbage collect a generation. If raise is 0 then the remains of the
* generation are not raised to the next generation. */
static void
* initiates GC. If you ever call GC from inside an altstack
* handler, you will lose. */
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
/* And if we're saving a core, there's no point in being conservative. */
if (conservative_stack) {
for_each_thread(th) {
}
}
}
+#endif
+
#ifdef QSHOW
if (gencgc_verbose > 1) {
long num_dont_move_pages = count_dont_move_pages();
/* Scavenge all the rest of the roots. */
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+ /*
+ * If not x86, we need to scavenge the interrupt context(s) and the
+ * control stack.
+ */
+ scavenge_interrupt_contexts();
+ scavenge_control_stack();
+#endif
+
/* Scavenge the Lisp functions of the interrupt handlers, taking
* care to avoid SIG_DFL and SIG_IGN. */
for (i = 0; i < NSIG; i++) {
{
struct thread *th;
for_each_thread(th) {
- long len= (lispobj *)SymbolValue(BINDING_STACK_POINTER,th) -
+ long len= (lispobj *)get_binding_stack_pointer(th) -
th->binding_stack_start;
scavenge((lispobj *) th->binding_stack_start,len);
#ifdef LISP_FEATURE_SB_THREAD
/* All generations but the generation being GCed need to be
* scavenged. The new_space generation needs special handling as
* objects may be moved in - it is handled separately below. */
- for (i = 0; i <= PSEUDO_STATIC_GENERATION; i++) {
- if ((i != generation) && (i != new_space)) {
- scavenge_generation(i);
- }
- }
+ scavenge_generations(generation+1, PSEUDO_STATIC_GENERATION);
/* Finally scavenge the new_space generation. Keep going until no
* more objects are moved into the new generation */
bytes_allocated = bytes_allocated - old_bytes_allocated;
if (bytes_allocated != 0) {
- lose("Rescan of new_space allocated %d more bytes.",
+ lose("Rescan of new_space allocated %d more bytes.\n",
bytes_allocated);
}
}
last_free_page = last_page+1;
- SetSymbolValue(ALLOCATION_POINTER,
- (lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES),0);
+ set_alloc_pointer((lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES));
return 0; /* dummy value: return something ... */
}
+static void
+remap_free_pages (page_index_t from, page_index_t to)
+{
+ page_index_t first_page, last_page;
+
+ for (first_page = from; first_page <= to; first_page++) {
+ if (page_table[first_page].allocated != FREE_PAGE_FLAG ||
+ page_table[first_page].need_to_zero == 0) {
+ continue;
+ }
+
+ last_page = first_page + 1;
+ while (page_table[last_page].allocated == FREE_PAGE_FLAG &&
+ last_page < to &&
+ page_table[last_page].need_to_zero == 1) {
+ last_page++;
+ }
+
+ zero_pages_with_mmap(first_page, last_page-1);
+
+ first_page = last_page;
+ }
+}
+
+generation_index_t small_generation_limit = 1;
+
/* GC all generations newer than last_gen, raising the objects in each
* to the next older generation - we finish when all generations below
* last_gen are empty. Then if last_gen is due for a GC, or if
*
* We stop collecting at gencgc_oldest_gen_to_gc, even if this is less than
* last_gen (oh, and note that by default it is NUM_GENERATIONS-1) */
-
void
collect_garbage(generation_index_t last_gen)
{
generation_index_t gen = 0, i;
int raise;
int gen_to_wp;
+ /* The largest value of last_free_page seen since the time
+ * remap_free_pages was called. */
+ static page_index_t high_water_mark = 0;
FSHOW((stderr, "/entering collect_garbage(%d)\n", last_gen));
/* Check that they are all empty. */
for (i = 0; i < gen_to_wp; i++) {
if (generations[i].bytes_allocated)
- lose("trying to write-protect gen. %d when gen. %d nonempty",
+ lose("trying to write-protect gen. %d when gen. %d nonempty\n",
gen_to_wp, i);
}
write_protect_generation_pages(gen_to_wp);
gc_assert((boxed_region.free_pointer - boxed_region.start_addr) == 0);
gc_alloc_generation = 0;
+ /* Save the high-water mark before updating last_free_page */
+ if (last_free_page > high_water_mark)
+ high_water_mark = last_free_page;
+
update_dynamic_space_free_pointer();
+
auto_gc_trigger = bytes_allocated + bytes_consed_between_gcs;
if(gencgc_verbose)
fprintf(stderr,"Next gc when %ld bytes have been consed\n",
auto_gc_trigger);
+
+ /* If we did a big GC (arbitrarily defined as gen > 1), release memory
+ * back to the OS.
+ */
+ if (gen > small_generation_limit) {
+ if (last_free_page > high_water_mark)
+ high_water_mark = last_free_page;
+ remap_free_pages(0, high_water_mark);
+ high_water_mark = 0;
+ }
+
SHOW("returning from collect_garbage");
}
page_table[page].allocated = FREE_PAGE_FLAG;
page_table[page].bytes_used = 0;
+#ifndef LISP_FEATURE_WIN32 /* Pages already zeroed on win32? Not sure about this change. */
/* Zero the page. */
page_start = (void *)page_address(page);
os_invalidate(page_start,PAGE_BYTES);
addr = os_validate(page_start,PAGE_BYTES);
if (addr == NULL || addr != page_start) {
- lose("gc_free_heap: page moved, 0x%08x ==> 0x%08x",
+ lose("gc_free_heap: page moved, 0x%08x ==> 0x%08x\n",
page_start,
addr);
}
+#else
+ page_table[page].write_protected = 0;
+#endif
} else if (gencgc_zero_check_during_free_heap) {
/* Double-check that the page is zero filled. */
long *page_start;
page_start = (long *)page_address(page);
for (i=0; i<1024; i++) {
if (page_start[i] != 0) {
- lose("free region not zero at %x", page_start + i);
+ lose("free region not zero at %x\n", page_start + i);
}
}
}
gc_set_region_empty(&unboxed_region);
last_free_page = 0;
- SetSymbolValue(ALLOCATION_POINTER, (lispobj)((char *)heap_base),0);
+ set_alloc_pointer((lispobj)((char *)heap_base));
if (verify_after_free_heap) {
/* Check whether purify has left any bad pointers. */
gencgc_pickup_dynamic(void)
{
page_index_t page = 0;
- long alloc_ptr = SymbolValue(ALLOCATION_POINTER,0);
+ long alloc_ptr = get_alloc_pointer();
lispobj *prev=(lispobj *)page_address(page);
generation_index_t gen = PSEUDO_STATIC_GENERATION;
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) {
first=gc_search_space(prev,(ptr+2)-prev,ptr);
void *new_obj;
void *new_free_pointer;
gc_assert(nbytes>0);
+
/* Check for alignment allocation problems. */
gc_assert((((unsigned long)region->free_pointer & LOWTAG_MASK) == 0)
&& ((nbytes & LOWTAG_MASK) == 0));
+
#if 0
if(all_threads)
/* there are a few places in the C code that allocate data in the
* heap before Lisp starts. This is before interrupts are enabled,
* so we don't need to check for pseudo-atomic */
#ifdef LISP_FEATURE_SB_THREAD
- if(!SymbolValue(PSEUDO_ATOMIC_ATOMIC,th)) {
+ if(!get_psuedo_atomic_atomic(th)) {
register u32 fs;
fprintf(stderr, "fatal error in thread 0x%x, tid=%ld\n",
th,th->os_thread);
lose("If you see this message before 2004.01.31, mail details to sbcl-devel\n");
}
#else
- gc_assert(SymbolValue(PSEUDO_ATOMIC_ATOMIC,th));
+ gc_assert(get_pseudo_atomic_atomic(th));
#endif
#endif
* we should GC in the near future
*/
if (auto_gc_trigger && bytes_allocated > auto_gc_trigger) {
- gc_assert(fixnum_value(SymbolValue(PSEUDO_ATOMIC_ATOMIC,thread)));
+ gc_assert(get_pseudo_atomic_atomic(thread));
/* 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)
- arch_set_pseudo_atomic_interrupted(0);
+ set_pseudo_atomic_interrupted(0);
}
}
new_obj = gc_alloc_with_region(nbytes,0,region,0);
* does this test after the first one has already set wp=0
*/
if(page_table[page_index].write_protected_cleared != 1)
- lose("fault in heap page not marked as write-protected");
+ lose("fault in heap page %d not marked as write-protected\nboxed_region.first_page: %d, boxed_region.last_page %d\n",
+ page_index, boxed_region.first_page, boxed_region.last_page);
}
/* Don't worry, we can handle it. */
return 1;
region->end_addr = page_address(0);
}
+static void
+zero_all_free_pages()
+{
+ page_index_t i;
+
+ for (i = 0; i < last_free_page; i++) {
+ if (page_table[i].allocated == FREE_PAGE_FLAG) {
+#ifdef READ_PROTECT_FREE_PAGES
+ os_protect(page_address(i),
+ PAGE_BYTES,
+ OS_VM_PROT_ALL);
+#endif
+ zero_pages(i, i);
+ }
+ }
+}
+
/* Things to do before doing a final GC before saving a core (without
* purify).
*
* function being set to the value of the static symbol
* SB!VM:RESTART-LISP-FUNCTION */
void
-gc_and_save(char *filename)
+gc_and_save(char *filename, int prepend_runtime)
{
- FILE *file = open_core_for_saving(filename);
- if (!file) {
- perror(filename);
- return;
- }
+ FILE *file;
+ void *runtime_bytes = NULL;
+ size_t runtime_size;
+
+ file = prepare_to_save(filename, prepend_runtime, &runtime_bytes, &runtime_size);
+ if (file == NULL)
+ return;
+
conservative_stack = 0;
/* The filename might come from Lisp, and be moved by the now
gencgc_alloc_start_page = -1;
collect_garbage(HIGHEST_NORMAL_GENERATION+1);
- save_to_filehandle(file, filename, SymbolValue(RESTART_LISP_FUNCTION,0));
+ if (prepend_runtime)
+ save_runtime_to_filehandle(file, runtime_bytes, runtime_size);
+
+ /* The dumper doesn't know that pages need to be zeroed before use. */
+ zero_all_free_pages();
+ save_to_filehandle(file, filename, SymbolValue(RESTART_LISP_FUNCTION,0),
+ prepend_runtime);
/* Oops. Save still managed to fail. Since we've mangled the stack
* beyond hope, there's not much we can do.
* (beyond FUNCALLing RESTART_LISP_FUNCTION, but I suspect that's
* going to be rather unsatisfactory too... */
- lose("Attempt to save core after non-conservative GC failed.");
+ lose("Attempt to save core after non-conservative GC failed.\n");
}
projects / sbcl.git / blobdiff