X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;h=a67748aba81d777df13b3bee71bdf6006adf6ffa;hb=0e2c926fea68a32c8ec58f12daa0c2b5befef1d4;hp=a90c60df42548bb3c756aa5215b7b780e29e1975;hpb=23f1e2ef66bcc31ca7ea765a82a97998119aa4d5;p=sbcl.git diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index a90c60d..a67748a 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -26,6 +26,7 @@ #include #include +#include #include "runtime.h" #include "sbcl.h" #include "os.h" @@ -36,11 +37,20 @@ #include "lispregs.h" #include "arch.h" #include "gc.h" -#include "gencgc.h" +#include "gc-internal.h" +#include "thread.h" +#include "genesis/vector.h" +#include "genesis/weak-pointer.h" +#include "genesis/simple-fun.h" + +#ifdef LISP_FEATURE_SB_THREAD +#include +#include /* threading is presently linux-only */ +#endif -/* a function defined externally in assembly language, called from - * this file */ +/* assembly language stub that executes trap_PendingInterrupt */ void do_pending_interrupt(void); + /* * GC parameters @@ -76,19 +86,7 @@ unsigned large_object_size = 4 * 4096; * debugging */ -#define gc_abort() lose("GC invariant lost, file \"%s\", line %d", \ - __FILE__, __LINE__) -/* FIXME: In CMU CL, this was "#if 0" with no explanation. Find out - * how much it costs to make it "#if 1". If it's not too expensive, - * keep it. */ -#if 1 -#define gc_assert(ex) do { \ - if (!(ex)) gc_abort(); \ -} while (0) -#else -#define gc_assert(ex) -#endif /* the verbosity level. All non-error messages are disabled at level 0; * and only a few rare messages are printed at level 1. */ @@ -131,16 +129,19 @@ boolean gencgc_zero_check_during_free_heap = 0; /* the total bytes allocated. These are seen by Lisp DYNAMIC-USAGE. */ unsigned long bytes_allocated = 0; -static unsigned long auto_gc_trigger = 0; +extern unsigned long bytes_consed_between_gcs; /* gc-common.c */ +unsigned long auto_gc_trigger = 0; /* the source and destination generations. These are set before a GC starts * scavenging. */ -static int from_space; -static int new_space; +int from_space; +int new_space; + /* FIXME: It would be nice to use this symbolic constant instead of * bare 4096 almost everywhere. We could also use an assertion that * it's equal to getpagesize(). */ + #define PAGE_BYTES 4096 /* An array of page structures is statically allocated. @@ -152,6 +153,7 @@ struct page page_table[NUM_PAGES]; * is needed. */ static void *heap_base = NULL; + /* Calculate the start address for the given page number. */ inline void * page_address(int page_num) @@ -221,11 +223,15 @@ struct generation { * added, in which case a GC could be a waste of time */ double min_av_mem_age; }; +/* the number of actual generations. (The number of 'struct + * generation' objects is one more than this, because one object + * serves as scratch when GC'ing.) */ +#define NUM_GENERATIONS 6 /* an array of generation structures. There needs to be one more * generation structure than actual generations as the oldest * generation is temporarily raised then lowered. */ -static struct generation generations[NUM_GENERATIONS+1]; +struct generation generations[NUM_GENERATIONS+1]; /* the oldest generation that is will currently be GCed by default. * Valid values are: 0, 1, ... (NUM_GENERATIONS-1) @@ -246,7 +252,16 @@ unsigned int gencgc_oldest_gen_to_gc = NUM_GENERATIONS-1; * search of the heap. XX Gencgc obviously needs to be better * integrated with the Lisp code. */ static int last_free_page; -static int last_used_page = 0; + +/* This lock is to prevent multiple threads from simultaneously + * allocating new regions which overlap each other. Note that the + * majority of GC is single-threaded, but alloc() may be called from + * >1 thread at a time and must be thread-safe. This lock must be + * seized before all accesses to generations[] or to parts of + * page_table[] that other threads may want to see */ + +static lispobj free_pages_lock=0; + /* * miscellaneous heap functions @@ -356,7 +371,7 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ /* Count the number of boxed pages within the given * generation. */ - if (page_table[j].allocated == BOXED_PAGE) { + if (page_table[j].allocated & BOXED_PAGE) { if (page_table[j].large_object) large_boxed_cnt++; else @@ -365,7 +380,7 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ /* Count the number of unboxed pages within the given * generation. */ - if (page_table[j].allocated == UNBOXED_PAGE) { + if (page_table[j].allocated & UNBOXED_PAGE) { if (page_table[j].large_object) large_unboxed_cnt++; else @@ -447,10 +462,6 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ struct alloc_region boxed_region; struct alloc_region unboxed_region; -/* XX hack. Current Lisp code uses the following. Need copying in/out. */ -void *current_region_free_pointer; -void *current_region_end_addr; - /* The generation currently being allocated to. */ static int gc_alloc_generation; @@ -482,10 +493,7 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) { int first_page; int last_page; - int region_size; - int restart_page; int bytes_found; - int num_pages; int i; /* @@ -498,103 +506,18 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) gc_assert((alloc_region->first_page == 0) && (alloc_region->last_page == -1) && (alloc_region->free_pointer == alloc_region->end_addr)); - + get_spinlock(&free_pages_lock,alloc_region); if (unboxed) { - restart_page = + first_page = generations[gc_alloc_generation].alloc_unboxed_start_page; } else { - restart_page = + first_page = generations[gc_alloc_generation].alloc_start_page; } - - /* Search for a contiguous free region of at least nbytes with the - * given properties: boxed/unboxed, generation. */ - do { - first_page = restart_page; - - /* First search for a page with at least 32 bytes free, which is - * not write-protected, and which is not marked dont_move. - * - * FIXME: This looks extremely similar, perhaps identical, to - * code in gc_alloc_large(). It should be shared somehow. */ - while ((first_page < NUM_PAGES) - && (page_table[first_page].allocated != FREE_PAGE) /* not free page */ - && ((unboxed && - (page_table[first_page].allocated != UNBOXED_PAGE)) - || (!unboxed && - (page_table[first_page].allocated != BOXED_PAGE)) - || (page_table[first_page].large_object != 0) - || (page_table[first_page].gen != gc_alloc_generation) - || (page_table[first_page].bytes_used >= (4096-32)) - || (page_table[first_page].write_protected != 0) - || (page_table[first_page].dont_move != 0))) - first_page++; - /* Check for a failure. */ - if (first_page >= NUM_PAGES) { - fprintf(stderr, - "Argh! gc_alloc_new_region failed on first_page, nbytes=%d.\n", - nbytes); - print_generation_stats(1); - lose(NULL); - } - - gc_assert(page_table[first_page].write_protected == 0); - - /* - FSHOW((stderr, - "/first_page=%d bytes_used=%d\n", - first_page, page_table[first_page].bytes_used)); - */ - - /* Now search forward to calculate the available region size. It - * tries to keeps going until nbytes are found and the number of - * pages is greater than some level. This helps keep down the - * number of pages in a region. */ - last_page = first_page; - bytes_found = 4096 - page_table[first_page].bytes_used; - num_pages = 1; - while (((bytes_found < nbytes) || (num_pages < 2)) - && (last_page < (NUM_PAGES-1)) - && (page_table[last_page+1].allocated == FREE_PAGE)) { - last_page++; - num_pages++; - bytes_found += 4096; - gc_assert(page_table[last_page].write_protected == 0); - } - - region_size = (4096 - page_table[first_page].bytes_used) + last_page=gc_find_freeish_pages(&first_page,nbytes,unboxed,alloc_region); + bytes_found=(4096 - page_table[first_page].bytes_used) + 4096*(last_page-first_page); - gc_assert(bytes_found == region_size); - - /* - FSHOW((stderr, - "/last_page=%d bytes_found=%d num_pages=%d\n", - last_page, bytes_found, num_pages)); - */ - - restart_page = last_page + 1; - } while ((restart_page < NUM_PAGES) && (bytes_found < nbytes)); - - /* Check for a failure. */ - if ((restart_page >= NUM_PAGES) && (bytes_found < nbytes)) { - fprintf(stderr, - "Argh! gc_alloc_new_region() failed on restart_page, nbytes=%d.\n", - nbytes); - print_generation_stats(1); - lose(NULL); - } - - /* - FSHOW((stderr, - "/gc_alloc_new_region() gen %d: %d bytes: pages %d to %d: addr=%x\n", - gc_alloc_generation, - bytes_found, - first_page, - last_page, - page_address(first_page))); - */ - /* Set up the alloc_region. */ alloc_region->first_page = first_page; alloc_region->last_page = last_page; @@ -603,20 +526,6 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) alloc_region->free_pointer = alloc_region->start_addr; alloc_region->end_addr = alloc_region->start_addr + bytes_found; - if (gencgc_zero_check) { - int *p; - for (p = (int *)alloc_region->start_addr; - p < (int *)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.", p); - } - } - } - /* Set up the pages. */ /* The first page may have already been in use. */ @@ -634,6 +543,8 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) gc_assert(page_table[first_page].allocated == UNBOXED_PAGE); else gc_assert(page_table[first_page].allocated == BOXED_PAGE); + page_table[first_page].allocated |= OPEN_REGION_PAGE; + gc_assert(page_table[first_page].gen == gc_alloc_generation); gc_assert(page_table[first_page].large_object == 0); @@ -648,18 +559,34 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) * broken before!) */ page_table[i].first_object_offset = alloc_region->start_addr - page_address(i); + page_table[i].allocated |= OPEN_REGION_PAGE ; } - /* 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*4096)); - if (last_page+1 > last_used_page) - last_used_page = last_page+1; + (lispobj)(((char *)heap_base) + last_free_page*4096), + 0); + } + free_pages_lock=0; + + /* we can do this after releasing free_pages_lock */ + if (gencgc_zero_check) { + int *p; + for (p = (int *)alloc_region->start_addr; + p < (int *)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.", p); + } } } +} + /* If the record_new_objects flag is 2 then all new regions created * are recorded. * @@ -732,12 +659,11 @@ add_new_area(int first_page, int offset, int size) (*new_areas)[i].size, first_page, offset, - size));*/ + size);*/ (*new_areas)[i].size += size; return; } } - /*FSHOW((stderr, "/add_new_area S1 %d %d %d\n", i, c, new_area_start));*/ (*new_areas)[new_areas_index].page = first_page; (*new_areas)[new_areas_index].offset = offset; @@ -784,8 +710,9 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) next_page = first_page+1; - /* Skip if no bytes were allocated. */ + get_spinlock(&free_pages_lock,alloc_region); if (alloc_region->free_pointer != alloc_region->start_addr) { + /* some bytes were allocated in the region */ orig_first_page_bytes_used = page_table[first_page].bytes_used; gc_assert(alloc_region->start_addr == (page_address(first_page) + page_table[first_page].bytes_used)); @@ -798,6 +725,7 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) * first_object_offset. */ if (page_table[first_page].bytes_used == 0) gc_assert(page_table[first_page].first_object_offset == 0); + page_table[first_page].allocated &= ~(OPEN_REGION_PAGE); if (unboxed) gc_assert(page_table[first_page].allocated == UNBOXED_PAGE); @@ -823,6 +751,7 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) * first_object_offset pointer to the start of the region, and set * the bytes_used. */ while (more) { + page_table[next_page].allocated &= ~(OPEN_REGION_PAGE); if (unboxed) gc_assert(page_table[next_page].allocated == UNBOXED_PAGE); else @@ -874,6 +803,7 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) } else { /* There are no bytes allocated. Unallocate the first_page if * there are 0 bytes_used. */ + page_table[first_page].allocated &= ~(OPEN_REGION_PAGE); if (page_table[first_page].bytes_used == 0) page_table[first_page].allocated = FREE_PAGE; } @@ -884,27 +814,19 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) page_table[next_page].allocated = FREE_PAGE; next_page++; } - - /* Reset the alloc_region. */ - alloc_region->first_page = 0; - alloc_region->last_page = -1; - alloc_region->start_addr = page_address(0); - alloc_region->free_pointer = page_address(0); - alloc_region->end_addr = page_address(0); + free_pages_lock=0; + /* alloc_region is per-thread, we're ok to do this unlocked */ + gc_set_region_empty(alloc_region); } static inline void *gc_quick_alloc(int nbytes); /* Allocate a possibly large object. */ -static void * +void * gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region) { int first_page; int last_page; - int region_size; - int restart_page; - int bytes_found; - int num_pages; int orig_first_page_bytes_used; int byte_cnt; int more; @@ -924,116 +846,30 @@ gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region) */ /* If the object is small, and there is room in the current region - then allocation it in the current region. */ + then allocate it in the current region. */ if (!large && ((alloc_region->end_addr-alloc_region->free_pointer) >= nbytes)) return gc_quick_alloc(nbytes); - /* Search for a contiguous free region of at least nbytes. If it's a - large object then align it on a page boundary by searching for a - free page. */ - /* To allow the allocation of small objects without the danger of using a page in the current boxed region, the search starts after the current boxed free region. XX could probably keep a page index ahead of the current region and bumped up here to save a lot of re-scanning. */ + + get_spinlock(&free_pages_lock,alloc_region); + if (unboxed) { - restart_page = + first_page = generations[gc_alloc_generation].alloc_large_unboxed_start_page; } else { - restart_page = generations[gc_alloc_generation].alloc_large_start_page; + first_page = generations[gc_alloc_generation].alloc_large_start_page; } - if (restart_page <= alloc_region->last_page) { - restart_page = alloc_region->last_page+1; - } - - do { - first_page = restart_page; - - if (large) - while ((first_page < NUM_PAGES) - && (page_table[first_page].allocated != FREE_PAGE)) - first_page++; - else - /* FIXME: This looks extremely similar, perhaps identical, - * to code in gc_alloc_new_region(). It should be shared - * somehow. */ - while ((first_page < NUM_PAGES) - && (page_table[first_page].allocated != FREE_PAGE) - && ((unboxed && - (page_table[first_page].allocated != UNBOXED_PAGE)) - || (!unboxed && - (page_table[first_page].allocated != BOXED_PAGE)) - || (page_table[first_page].large_object != 0) - || (page_table[first_page].gen != gc_alloc_generation) - || (page_table[first_page].bytes_used >= (4096-32)) - || (page_table[first_page].write_protected != 0) - || (page_table[first_page].dont_move != 0))) - first_page++; - - if (first_page >= NUM_PAGES) { - fprintf(stderr, - "Argh! gc_alloc_large failed (first_page), nbytes=%d.\n", - nbytes); - print_generation_stats(1); - lose(NULL); - } - - gc_assert(page_table[first_page].write_protected == 0); - - /* - FSHOW((stderr, - "/first_page=%d bytes_used=%d\n", - first_page, page_table[first_page].bytes_used)); - */ - - last_page = first_page; - bytes_found = 4096 - page_table[first_page].bytes_used; - num_pages = 1; - while ((bytes_found < nbytes) - && (last_page < (NUM_PAGES-1)) - && (page_table[last_page+1].allocated == FREE_PAGE)) { - last_page++; - num_pages++; - bytes_found += 4096; - gc_assert(page_table[last_page].write_protected == 0); - } - - region_size = (4096 - page_table[first_page].bytes_used) - + 4096*(last_page-first_page); - - gc_assert(bytes_found == region_size); - - /* - FSHOW((stderr, - "/last_page=%d bytes_found=%d num_pages=%d\n", - last_page, bytes_found, num_pages)); - */ - - restart_page = last_page + 1; - } while ((restart_page < NUM_PAGES) && (bytes_found < nbytes)); - - /* Check for a failure */ - if ((restart_page >= NUM_PAGES) && (bytes_found < nbytes)) { - fprintf(stderr, - "Argh! gc_alloc_large failed (restart_page), nbytes=%d.\n", - nbytes); - print_generation_stats(1); - lose(NULL); + if (first_page <= alloc_region->last_page) { + first_page = alloc_region->last_page+1; } - /* - if (large) - FSHOW((stderr, - "/gc_alloc_large() gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n", - gc_alloc_generation, - nbytes, - bytes_found, - first_page, - last_page, - page_address(first_page))); - */ + last_page=gc_find_freeish_pages(&first_page,nbytes,unboxed,0); gc_assert(first_page > alloc_region->last_page); if (unboxed) @@ -1119,39 +955,134 @@ gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region) if (last_page+1 > last_free_page) { last_free_page = last_page+1; SetSymbolValue(ALLOCATION_POINTER, - (lispobj)(((char *)heap_base) + last_free_page*4096)); - if (last_page+1 > last_used_page) - last_used_page = last_page+1; + (lispobj)(((char *)heap_base) + last_free_page*4096),0); } + free_pages_lock=0; return((void *)(page_address(first_page)+orig_first_page_bytes_used)); } -/* Allocate bytes from the boxed_region. First checks whether there is - * room. If not then call gc_alloc_new_region() to find a new region - * with enough space. Return a pointer to the start of the region. */ -static void * -gc_alloc(int nbytes) +int +gc_find_freeish_pages(int *restart_page_ptr, int nbytes, int unboxed, struct alloc_region *alloc_region) +{ + /* if alloc_region is 0, we assume this is for a potentially large + object */ + int first_page; + int last_page; + int region_size; + int restart_page=*restart_page_ptr; + int bytes_found; + int num_pages; + int large = !alloc_region && (nbytes >= large_object_size); + + gc_assert(free_pages_lock); + /* Search for a contiguous free space of at least nbytes. If it's a + large object then align it on a page boundary by searching for a + free page. */ + + /* To allow the allocation of small objects without the danger of + using a page in the current boxed region, the search starts after + the current boxed free region. XX could probably keep a page + index ahead of the current region and bumped up here to save a + lot of re-scanning. */ + + do { + first_page = restart_page; + if (large) + while ((first_page < NUM_PAGES) + && (page_table[first_page].allocated != FREE_PAGE)) + first_page++; + else + while (first_page < NUM_PAGES) { + if(page_table[first_page].allocated == FREE_PAGE) + break; + /* I don't know why we need the gen=0 test, but it + * breaks randomly if that's omitted -dan 2003.02.26 + */ + if((page_table[first_page].allocated == + (unboxed ? UNBOXED_PAGE : BOXED_PAGE)) && + (page_table[first_page].large_object == 0) && + (gc_alloc_generation == 0) && + (page_table[first_page].gen == gc_alloc_generation) && + (page_table[first_page].bytes_used < (4096-32)) && + (page_table[first_page].write_protected == 0) && + (page_table[first_page].dont_move == 0)) + break; + first_page++; + } + + if (first_page >= NUM_PAGES) { + fprintf(stderr, + "Argh! gc_find_free_space failed (first_page), nbytes=%d.\n", + nbytes); + print_generation_stats(1); + lose(NULL); + } + + gc_assert(page_table[first_page].write_protected == 0); + + last_page = first_page; + bytes_found = 4096 - page_table[first_page].bytes_used; + num_pages = 1; + while (((bytes_found < nbytes) + || (alloc_region && (num_pages < 2))) + && (last_page < (NUM_PAGES-1)) + && (page_table[last_page+1].allocated == FREE_PAGE)) { + last_page++; + num_pages++; + bytes_found += 4096; + gc_assert(page_table[last_page].write_protected == 0); + } + + region_size = (4096 - page_table[first_page].bytes_used) + + 4096*(last_page-first_page); + + gc_assert(bytes_found == region_size); + restart_page = last_page + 1; + } while ((restart_page < NUM_PAGES) && (bytes_found < nbytes)); + + /* Check for a failure */ + if ((restart_page >= NUM_PAGES) && (bytes_found < nbytes)) { + fprintf(stderr, + "Argh! gc_find_freeish_pages failed (restart_page), nbytes=%d.\n", + nbytes); + print_generation_stats(1); + lose(NULL); + } + *restart_page_ptr=first_page; + return last_page; +} + +/* Allocate bytes. All the rest of the special-purpose allocation + * functions will eventually call this (instead of just duplicating + * parts of its code) */ + +void * +gc_alloc_with_region(int nbytes,int unboxed_p, struct alloc_region *my_region, + int quick_p) { void *new_free_pointer; /* FSHOW((stderr, "/gc_alloc %d\n", nbytes)); */ /* Check whether there is room in the current alloc region. */ - new_free_pointer = boxed_region.free_pointer + nbytes; + new_free_pointer = my_region->free_pointer + nbytes; - if (new_free_pointer <= boxed_region.end_addr) { + if (new_free_pointer <= my_region->end_addr) { /* If so then allocate from the current alloc region. */ - void *new_obj = boxed_region.free_pointer; - boxed_region.free_pointer = new_free_pointer; - - /* Check whether the alloc region is almost empty. */ - if ((boxed_region.end_addr - boxed_region.free_pointer) <= 32) { - /* If so finished with the current region. */ - gc_alloc_update_page_tables(0, &boxed_region); + void *new_obj = my_region->free_pointer; + my_region->free_pointer = new_free_pointer; + + /* Unless a `quick' alloc was requested, check whether the + alloc region is almost empty. */ + if (!quick_p && + (my_region->end_addr - my_region->free_pointer) <= 32) { + /* If so, finished with the current region. */ + gc_alloc_update_page_tables(unboxed_p, my_region); /* Set up a new region. */ - gc_alloc_new_region(32, 0, &boxed_region); + gc_alloc_new_region(32 /*bytes*/, unboxed_p, my_region); } + return((void *)new_obj); } @@ -1160,34 +1091,33 @@ gc_alloc(int nbytes) /* If there some room left in the current region, enough to be worth * saving, then allocate a large object. */ /* FIXME: "32" should be a named parameter. */ - if ((boxed_region.end_addr-boxed_region.free_pointer) > 32) - return gc_alloc_large(nbytes, 0, &boxed_region); + if ((my_region->end_addr-my_region->free_pointer) > 32) + return gc_alloc_large(nbytes, unboxed_p, my_region); /* Else find a new region. */ /* Finished with the current region. */ - gc_alloc_update_page_tables(0, &boxed_region); + gc_alloc_update_page_tables(unboxed_p, my_region); /* Set up a new region. */ - gc_alloc_new_region(nbytes, 0, &boxed_region); + gc_alloc_new_region(nbytes, unboxed_p, my_region); /* Should now be enough room. */ /* Check whether there is room in the current region. */ - new_free_pointer = boxed_region.free_pointer + nbytes; + new_free_pointer = my_region->free_pointer + nbytes; - if (new_free_pointer <= boxed_region.end_addr) { + if (new_free_pointer <= my_region->end_addr) { /* If so then allocate from the current region. */ - void *new_obj = boxed_region.free_pointer; - boxed_region.free_pointer = new_free_pointer; - + void *new_obj = my_region->free_pointer; + my_region->free_pointer = new_free_pointer; /* Check whether the current region is almost empty. */ - if ((boxed_region.end_addr - boxed_region.free_pointer) <= 32) { + if ((my_region->end_addr - my_region->free_pointer) <= 32) { /* If so find, finished with the current region. */ - gc_alloc_update_page_tables(0, &boxed_region); + gc_alloc_update_page_tables(unboxed_p, my_region); /* Set up a new region. */ - gc_alloc_new_region(32, 0, &boxed_region); + gc_alloc_new_region(32, unboxed_p, my_region); } return((void *)new_obj); @@ -1198,250 +1128,92 @@ gc_alloc(int nbytes) return((void *) NIL); /* dummy value: return something ... */ } +void * +gc_general_alloc(int nbytes,int unboxed_p,int quick_p) +{ + struct alloc_region *my_region = + unboxed_p ? &unboxed_region : &boxed_region; + return gc_alloc_with_region(nbytes,unboxed_p, my_region,quick_p); +} + + + +static void * +gc_alloc(int nbytes,int unboxed_p) +{ + /* this is the only function that the external interface to + * allocation presently knows how to call: Lisp code will never + * allocate large objects, or to unboxed space, or `quick'ly. + * Any of that stuff will only ever happen inside of GC */ + return gc_general_alloc(nbytes,unboxed_p,0); +} + /* Allocate space from the boxed_region. If there is not enough free * space then call gc_alloc to do the job. A pointer to the start of - * the region is returned. */ + * the object is returned. */ static inline void * gc_quick_alloc(int nbytes) { - void *new_free_pointer; - - /* Check whether there is room in the current region. */ - new_free_pointer = boxed_region.free_pointer + nbytes; - - if (new_free_pointer <= boxed_region.end_addr) { - /* Allocate from the current region. */ - void *new_obj = boxed_region.free_pointer; - boxed_region.free_pointer = new_free_pointer; - return((void *)new_obj); - } else { - /* Let full gc_alloc() handle it. */ - return gc_alloc(nbytes); - } + return gc_general_alloc(nbytes,ALLOC_BOXED,ALLOC_QUICK); } -/* Allocate space for the boxed object. If it is a large object then - * do a large alloc else allocate from the current region. If there is - * not enough free space then call gc_alloc() to do the job. A pointer - * to the start of the region is returned. */ +/* Allocate space for the possibly large boxed object. If it is a + * large object then do a large alloc else use gc_quick_alloc. Note + * that gc_quick_alloc will eventually fall through to + * gc_general_alloc which may allocate the object in a large way + * anyway, but based on decisions about the free space in the current + * region, not the object size itself */ + static inline void * gc_quick_alloc_large(int nbytes) { - void *new_free_pointer; - if (nbytes >= large_object_size) - return gc_alloc_large(nbytes, 0, &boxed_region); + return gc_alloc_large(nbytes, ALLOC_BOXED, &boxed_region); + else + return gc_general_alloc(nbytes,ALLOC_BOXED,ALLOC_QUICK); +} - /* Check whether there is room in the current region. */ - new_free_pointer = boxed_region.free_pointer + nbytes; - - if (new_free_pointer <= boxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = boxed_region.free_pointer; - boxed_region.free_pointer = new_free_pointer; - return((void *)new_obj); - } else { - /* Let full gc_alloc() handle it. */ - return gc_alloc(nbytes); - } -} - -static void * +static inline void * gc_alloc_unboxed(int nbytes) { - void *new_free_pointer; - - /* - FSHOW((stderr, "/gc_alloc_unboxed() %d\n", nbytes)); - */ - - /* Check whether there is room in the current region. */ - new_free_pointer = unboxed_region.free_pointer + nbytes; - - if (new_free_pointer <= unboxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = unboxed_region.free_pointer; - unboxed_region.free_pointer = new_free_pointer; - - /* Check whether the current region is almost empty. */ - if ((unboxed_region.end_addr - unboxed_region.free_pointer) <= 32) { - /* If so finished with the current region. */ - gc_alloc_update_page_tables(1, &unboxed_region); - - /* Set up a new region. */ - gc_alloc_new_region(32, 1, &unboxed_region); - } - - return((void *)new_obj); - } - - /* Else not enough free space in the current region. */ - - /* If there is a bit of room left in the current region then - allocate a large object. */ - if ((unboxed_region.end_addr-unboxed_region.free_pointer) > 32) - return gc_alloc_large(nbytes,1,&unboxed_region); - - /* Else find a new region. */ - - /* Finished with the current region. */ - gc_alloc_update_page_tables(1, &unboxed_region); - - /* Set up a new region. */ - gc_alloc_new_region(nbytes, 1, &unboxed_region); - - /* (There should now be enough room.) */ - - /* Check whether there is room in the current region. */ - new_free_pointer = unboxed_region.free_pointer + nbytes; - - if (new_free_pointer <= unboxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = unboxed_region.free_pointer; - unboxed_region.free_pointer = new_free_pointer; - - /* Check whether the current region is almost empty. */ - if ((unboxed_region.end_addr - unboxed_region.free_pointer) <= 32) { - /* If so find, finished with the current region. */ - gc_alloc_update_page_tables(1, &unboxed_region); - - /* Set up a new region. */ - gc_alloc_new_region(32, 1, &unboxed_region); - } - - return((void *)new_obj); - } - - /* shouldn't happen? */ - gc_assert(0); - return((void *) NIL); /* dummy value: return something ... */ + return gc_general_alloc(nbytes,ALLOC_UNBOXED,0); } static inline void * gc_quick_alloc_unboxed(int nbytes) { - void *new_free_pointer; - - /* Check whether there is room in the current region. */ - new_free_pointer = unboxed_region.free_pointer + nbytes; - - if (new_free_pointer <= unboxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = unboxed_region.free_pointer; - unboxed_region.free_pointer = new_free_pointer; - - return((void *)new_obj); - } else { - /* Let general gc_alloc_unboxed() handle it. */ - return gc_alloc_unboxed(nbytes); - } + return gc_general_alloc(nbytes,ALLOC_UNBOXED,ALLOC_QUICK); } /* Allocate space for the object. If it is a large object then do a * large alloc else allocate from the current region. If there is not * enough free space then call general gc_alloc_unboxed() to do the job. * - * A pointer to the start of the region is returned. */ + * A pointer to the start of the object is returned. */ static inline void * gc_quick_alloc_large_unboxed(int nbytes) { - void *new_free_pointer; - if (nbytes >= large_object_size) - return gc_alloc_large(nbytes,1,&unboxed_region); - - /* Check whether there is room in the current region. */ - new_free_pointer = unboxed_region.free_pointer + nbytes; - if (new_free_pointer <= unboxed_region.end_addr) { - /* Allocate from the current region. */ - void *new_obj = unboxed_region.free_pointer; - unboxed_region.free_pointer = new_free_pointer; - return((void *)new_obj); - } else { - /* Let full gc_alloc() handle it. */ - return gc_alloc_unboxed(nbytes); - } + return gc_alloc_large(nbytes,ALLOC_UNBOXED,&unboxed_region); + else + return gc_quick_alloc_unboxed(nbytes); } /* * scavenging/transporting routines derived from gc.c in CMU CL ca. 18b */ -static int (*scavtab[256])(lispobj *where, lispobj object); -static lispobj (*transother[256])(lispobj object); -static int (*sizetab[256])(lispobj *where); - -static struct weak_pointer *weak_pointers; - -#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) - -/* - * predicates - */ - -static inline boolean -from_space_p(lispobj obj) -{ - int page_index=(void*)obj - heap_base; - return ((page_index >= 0) - && ((page_index = ((unsigned int)page_index)/4096) < NUM_PAGES) - && (page_table[page_index].gen == from_space)); -} - -static inline boolean -new_space_p(lispobj obj) -{ - int page_index = (void*)obj - heap_base; - return ((page_index >= 0) - && ((page_index = ((unsigned int)page_index)/4096) < NUM_PAGES) - && (page_table[page_index].gen == new_space)); -} - -/* - * copying objects - */ - -/* to copy a boxed object */ -static inline lispobj -copy_object(lispobj object, int nwords) -{ - int tag; - lispobj *new; - lispobj *source, *dest; - - 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(nwords*4); - - dest = new; - source = (lispobj *) native_pointer(object); - - /* Copy the object. */ - while (nwords > 0) { - dest[0] = source[0]; - dest[1] = source[1]; - dest += 2; - source += 2; - nwords -= 2; - } - - /* Return Lisp pointer of new object. */ - return ((lispobj) new) | tag; -} +extern int (*scavtab[256])(lispobj *where, lispobj object); +extern lispobj (*transother[256])(lispobj object); +extern int (*sizetab[256])(lispobj *where); -/* to copy a large boxed object. If the object is in a large object +/* Copy a large boxed object. If the object is in a large object * region then it is simply promoted, else it is copied. If it's large * enough then it's copied to a large object region. * * Vectors may have shrunk. If the object is not copied the space * needs to be reclaimed, and the page_tables corrected. */ -static lispobj +lispobj copy_large_object(lispobj object, int nwords) { int tag; @@ -1453,9 +1225,6 @@ copy_large_object(lispobj object, int nwords) gc_assert(from_space_p(object)); gc_assert((nwords & 0x01) == 0); - if ((nwords > 1024*1024) && gencgc_verbose) { - FSHOW((stderr, "/copy_large_object: %d bytes\n", nwords*4)); - } /* Check whether it's a large object. */ first_page = find_page_index((void *)object); @@ -1507,7 +1276,7 @@ copy_large_object(lispobj object, int nwords) gc_assert(page_table[next_page].bytes_used >= remaining_bytes); page_table[next_page].gen = new_space; - gc_assert(page_table[next_page].allocated = BOXED_PAGE); + gc_assert(page_table[next_page].allocated == BOXED_PAGE); /* Adjust the bytes_used. */ old_bytes_used = page_table[next_page].bytes_used; @@ -1523,7 +1292,7 @@ copy_large_object(lispobj object, int nwords) page_table[next_page].large_object && (page_table[next_page].first_object_offset == -(next_page - first_page)*4096)) { - /* Checks out OK, free the page. Don't need to both zeroing + /* Checks out OK, free the page. Don't need to bother zeroing * pages as this should have been done before shrinking the * object. These pages shouldn't be write-protected as they * should be zero filled. */ @@ -1536,9 +1305,6 @@ copy_large_object(lispobj object, int nwords) next_page++; } - if ((bytes_freed > 0) && gencgc_verbose) - FSHOW((stderr, "/copy_large_boxed bytes_freed=%d\n", bytes_freed)); - generations[from_space].bytes_allocated -= 4*nwords + bytes_freed; generations[new_space].bytes_allocated += 4*nwords; bytes_allocated -= bytes_freed; @@ -1572,7 +1338,7 @@ copy_large_object(lispobj object, int nwords) } /* to copy unboxed objects */ -static inline lispobj +lispobj copy_unboxed_object(lispobj object, int nwords) { int tag; @@ -1616,7 +1382,7 @@ copy_unboxed_object(lispobj object, int nwords) * * KLUDGE: There's a lot of cut-and-paste duplication between this * function and copy_large_object(..). -- WHN 20000619 */ -static lispobj +lispobj copy_large_unboxed_object(lispobj object, int nwords) { int tag; @@ -1734,108 +1500,18 @@ copy_large_unboxed_object(lispobj object, int nwords) return ((lispobj) new) | tag; } } - -/* - * scavenging - */ -/* FIXME: Most calls end up going to some trouble to compute an - * 'n_words' value for this function. The system might be a little - * simpler if this function used an 'end' parameter instead. */ -static void -scavenge(lispobj *start, long n_words) -{ - lispobj *end = start + n_words; - lispobj *object_ptr; - int n_words_scavenged; - - for (object_ptr = start; - object_ptr < end; - object_ptr += n_words_scavenged) { - lispobj object = *object_ptr; - - gc_assert(object != 0x01); /* not a forwarding pointer */ - - if (is_lisp_pointer(object)) { - if (from_space_p(object)) { - /* It currently points to old space. Check for a - * forwarding pointer. */ - lispobj *ptr = (lispobj *)native_pointer(object); - lispobj first_word = *ptr; - if (first_word == 0x01) { - /* Yes, there's a forwarding pointer. */ - *object_ptr = ptr[1]; - n_words_scavenged = 1; - } else { - /* Scavenge that pointer. */ - n_words_scavenged = - (scavtab[widetag_of(object)])(object_ptr, object); - } - } else { - /* It points somewhere other than oldspace. Leave it - * alone. */ - n_words_scavenged = 1; - } - } else if ((object & 3) == 0) { - /* It's a fixnum: really easy.. */ - n_words_scavenged = 1; - } else { - /* It's some sort of header object or another. */ - n_words_scavenged = - (scavtab[widetag_of(object)])(object_ptr, object); - } - } - gc_assert(object_ptr == end); -} + + /* * code and code-related objects */ - -/* FIXME: (1) Shouldn't this be defined in sbcl.h? */ -#define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG) - +/* static lispobj trans_fun_header(lispobj object); static lispobj trans_boxed(lispobj object); - -static int -scav_fun_pointer(lispobj *where, lispobj object) -{ - lispobj *first_pointer; - lispobj copy; - - gc_assert(is_lisp_pointer(object)); - - /* Object is a pointer into from space - no a FP. */ - first_pointer = (lispobj *) native_pointer(object); - - /* must transport object -- object may point to either a function - * header, a closure function header, or to a closure header. */ - - switch (widetag_of(*first_pointer)) { - case SIMPLE_FUN_HEADER_WIDETAG: - case CLOSURE_FUN_HEADER_WIDETAG: - copy = trans_fun_header(object); - break; - default: - copy = trans_boxed(object); - break; - } - - if (copy != object) { - /* Set forwarding pointer */ - first_pointer[0] = 0x01; - first_pointer[1] = copy; - } - - gc_assert(is_lisp_pointer(copy)); - gc_assert(!from_space_p(copy)); - - *where = copy; - - return 1; -} +*/ /* Scan a x86 compiled code object, looking for possible fixups that * have been missed after a move. @@ -2016,8 +1692,8 @@ sniff_code_object(struct code *code, unsigned displacement) } } -static void -apply_code_fixups(struct code *old_code, struct code *new_code) +void +gencgc_apply_code_fixups(struct code *old_code, struct code *new_code) { int nheader_words, ncode_words, nwords; void *constants_start_addr, *constants_end_addr; @@ -2113,590 +1789,50 @@ apply_code_fixups(struct code *old_code, struct code *new_code) } } -static struct code * -trans_code(struct code *code) -{ - struct code *new_code; - lispobj l_code, l_new_code; - int nheader_words, ncode_words, nwords; - unsigned long displacement; - lispobj fheaderl, *prev_pointer; - - /* FSHOW((stderr, - "\n/transporting code object located at 0x%08x\n", - (unsigned long) code)); */ - - /* If object has already been transported, just return pointer. */ - if (*((lispobj *)code) == 0x01) - return (struct code*)(((lispobj *)code)[1]); - - gc_assert(widetag_of(code->header) == CODE_HEADER_WIDETAG); - - /* Prepare to transport the code vector. */ - l_code = (lispobj) code | OTHER_POINTER_LOWTAG; - - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(code->header); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); - - l_new_code = copy_large_object(l_code, nwords); - new_code = (struct code *) native_pointer(l_new_code); - - /* may not have been moved.. */ - if (new_code == code) - return new_code; - - displacement = l_new_code - l_code; - - /* - FSHOW((stderr, - "/old code object at 0x%08x, new code object at 0x%08x\n", - (unsigned long) code, - (unsigned long) new_code)); - FSHOW((stderr, "/Code object is %d words long.\n", nwords)); - */ - - /* Set forwarding pointer. */ - ((lispobj *)code)[0] = 0x01; - ((lispobj *)code)[1] = l_new_code; - - /* Set forwarding pointers for all the function headers in the - * code object. Also fix all self pointers. */ - - fheaderl = code->entry_points; - prev_pointer = &new_code->entry_points; - - while (fheaderl != NIL) { - struct simple_fun *fheaderp, *nfheaderp; - lispobj nfheaderl; - - fheaderp = (struct simple_fun *) native_pointer(fheaderl); - gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG); - - /* Calculate the new function pointer and the new - * function header. */ - nfheaderl = fheaderl + displacement; - nfheaderp = (struct simple_fun *) native_pointer(nfheaderl); - - /* Set forwarding pointer. */ - ((lispobj *)fheaderp)[0] = 0x01; - ((lispobj *)fheaderp)[1] = nfheaderl; - - /* Fix self pointer. */ - nfheaderp->self = nfheaderl + FUN_RAW_ADDR_OFFSET; - - *prev_pointer = nfheaderl; - - fheaderl = fheaderp->next; - prev_pointer = &nfheaderp->next; - } - - apply_code_fixups(code, new_code); - - return new_code; -} - -static int -scav_code_header(lispobj *where, lispobj object) -{ - struct code *code; - int n_header_words, n_code_words, n_words; - lispobj entry_point; /* tagged pointer to entry point */ - struct simple_fun *function_ptr; /* untagged pointer to entry point */ - - code = (struct code *) where; - n_code_words = fixnum_value(code->code_size); - n_header_words = HeaderValue(object); - n_words = n_code_words + n_header_words; - n_words = CEILING(n_words, 2); - - /* Scavenge the boxed section of the code data block. */ - scavenge(where + 1, n_header_words - 1); - - /* Scavenge the boxed section of each function object in the - * code data block. */ - for (entry_point = code->entry_points; - entry_point != NIL; - entry_point = function_ptr->next) { - - gc_assert(is_lisp_pointer(entry_point)); - - function_ptr = (struct simple_fun *) native_pointer(entry_point); - gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG); - - scavenge(&function_ptr->name, 1); - scavenge(&function_ptr->arglist, 1); - scavenge(&function_ptr->type, 1); - } - - return n_words; -} static lispobj -trans_code_header(lispobj object) +trans_boxed_large(lispobj object) { - struct code *ncode; - - ncode = trans_code((struct code *) native_pointer(object)); - return (lispobj) ncode | OTHER_POINTER_LOWTAG; -} + lispobj header; + unsigned long length; -static int -size_code_header(lispobj *where) -{ - struct code *code; - int nheader_words, ncode_words, nwords; + gc_assert(is_lisp_pointer(object)); - code = (struct code *) where; - - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(code->header); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); + header = *((lispobj *) native_pointer(object)); + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return nwords; + return copy_large_object(object, length); } -static int -scav_return_pc_header(lispobj *where, lispobj object) -{ - lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x", - (unsigned long) where, - (unsigned long) object); - return 0; /* bogus return value to satisfy static type checking */ -} static lispobj -trans_return_pc_header(lispobj object) +trans_unboxed_large(lispobj object) { - struct simple_fun *return_pc; - unsigned long offset; - struct code *code, *ncode; - - SHOW("/trans_return_pc_header: Will this work?"); - - return_pc = (struct simple_fun *) native_pointer(object); - offset = HeaderValue(return_pc->header) * 4; + lispobj header; + unsigned long length; - /* Transport the whole code object. */ - code = (struct code *) ((unsigned long) return_pc - offset); - ncode = trans_code(code); - return ((lispobj) ncode + offset) | OTHER_POINTER_LOWTAG; -} + gc_assert(is_lisp_pointer(object)); -/* On the 386, closures hold a pointer to the raw address instead of the - * function object. */ -#ifdef __i386__ -static int -scav_closure_header(lispobj *where, lispobj object) -{ - struct closure *closure; - lispobj fun; - - closure = (struct closure *)where; - fun = closure->fun - FUN_RAW_ADDR_OFFSET; - scavenge(&fun, 1); - /* The function may have moved so update the raw address. But - * don't write unnecessarily. */ - if (closure->fun != fun + FUN_RAW_ADDR_OFFSET) - closure->fun = fun + FUN_RAW_ADDR_OFFSET; - - return 2; -} -#endif + header = *((lispobj *) native_pointer(object)); + length = HeaderValue(header) + 1; + length = CEILING(length, 2); -static int -scav_fun_header(lispobj *where, lispobj object) -{ - lose("attempted to scavenge a function header where=0x%08x object=0x%08x", - (unsigned long) where, - (unsigned long) object); - return 0; /* bogus return value to satisfy static type checking */ + return copy_large_unboxed_object(object, length); } -static lispobj -trans_fun_header(lispobj object) -{ - struct simple_fun *fheader; - unsigned long offset; - struct code *code, *ncode; - - fheader = (struct simple_fun *) native_pointer(object); - offset = HeaderValue(fheader->header) * 4; - - /* Transport the whole code object. */ - code = (struct code *) ((unsigned long) fheader - offset); - ncode = trans_code(code); - - return ((lispobj) ncode + offset) | FUN_POINTER_LOWTAG; -} /* - * instances + * vector-like objects */ -static int -scav_instance_pointer(lispobj *where, lispobj object) -{ - lispobj copy, *first_pointer; - - /* Object is a pointer into from space - not a FP. */ - copy = trans_boxed(object); - - gc_assert(copy != object); - - first_pointer = (lispobj *) native_pointer(object); - - /* Set forwarding pointer. */ - first_pointer[0] = 0x01; - first_pointer[1] = copy; - *where = copy; - - return 1; -} - -/* - * lists and conses - */ -static lispobj trans_list(lispobj object); +/* FIXME: What does this mean? */ +int gencgc_hash = 1; static int -scav_list_pointer(lispobj *where, lispobj object) -{ - lispobj first, *first_pointer; - - gc_assert(is_lisp_pointer(object)); - - /* Object is a pointer into from space - not FP. */ - - first = trans_list(object); - gc_assert(first != object); - - first_pointer = (lispobj *) native_pointer(object); - - /* Set forwarding pointer */ - first_pointer[0] = 0x01; - first_pointer[1] = first; - - gc_assert(is_lisp_pointer(first)); - gc_assert(!from_space_p(first)); - *where = first; - return 1; -} - -static lispobj -trans_list(lispobj object) -{ - lispobj new_list_pointer; - struct cons *cons, *new_cons; - lispobj cdr; - - gc_assert(from_space_p(object)); - - cons = (struct cons *) native_pointer(object); - - /* Copy 'object'. */ - new_cons = (struct cons *) gc_quick_alloc(sizeof(struct cons)); - new_cons->car = cons->car; - new_cons->cdr = cons->cdr; /* updated later */ - new_list_pointer = (lispobj)new_cons | lowtag_of(object); - - /* Grab the cdr before it is clobbered. */ - cdr = cons->cdr; - - /* Set forwarding pointer (clobbers start of list). */ - cons->car = 0x01; - cons->cdr = new_list_pointer; - - /* Try to linearize the list in the cdr direction to help reduce - * paging. */ - while (1) { - lispobj new_cdr; - struct cons *cdr_cons, *new_cdr_cons; - - if (lowtag_of(cdr) != LIST_POINTER_LOWTAG || !from_space_p(cdr) - || (*((lispobj *)native_pointer(cdr)) == 0x01)) - break; - - cdr_cons = (struct cons *) native_pointer(cdr); - - /* Copy 'cdr'. */ - new_cdr_cons = (struct cons*) gc_quick_alloc(sizeof(struct cons)); - new_cdr_cons->car = cdr_cons->car; - new_cdr_cons->cdr = cdr_cons->cdr; - new_cdr = (lispobj)new_cdr_cons | lowtag_of(cdr); - - /* Grab the cdr before it is clobbered. */ - cdr = cdr_cons->cdr; - - /* Set forwarding pointer. */ - cdr_cons->car = 0x01; - cdr_cons->cdr = new_cdr; - - /* Update the cdr of the last cons copied into new space to - * keep the newspace scavenge from having to do it. */ - new_cons->cdr = new_cdr; - - new_cons = new_cdr_cons; - } - - return new_list_pointer; -} - - -/* - * scavenging and transporting other pointers - */ - -static int -scav_other_pointer(lispobj *where, lispobj object) -{ - lispobj first, *first_pointer; - - gc_assert(is_lisp_pointer(object)); - - /* Object is a pointer into from space - not FP. */ - first_pointer = (lispobj *) native_pointer(object); - - first = (transother[widetag_of(*first_pointer)])(object); - - if (first != object) { - /* Set forwarding pointer. */ - first_pointer[0] = 0x01; - first_pointer[1] = first; - *where = first; - } - - gc_assert(is_lisp_pointer(first)); - gc_assert(!from_space_p(first)); - - return 1; -} - -/* - * immediate, boxed, and unboxed objects - */ - -static int -size_pointer(lispobj *where) -{ - return 1; -} - -static int -scav_immediate(lispobj *where, lispobj object) -{ - return 1; -} - -static lispobj -trans_immediate(lispobj object) -{ - lose("trying to transport an immediate"); - return NIL; /* bogus return value to satisfy static type checking */ -} - -static int -size_immediate(lispobj *where) -{ - return 1; -} - - -static int -scav_boxed(lispobj *where, lispobj object) -{ - return 1; -} - -static lispobj -trans_boxed(lispobj object) -{ - lispobj header; - unsigned long length; - - gc_assert(is_lisp_pointer(object)); - - header = *((lispobj *) native_pointer(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); - - return copy_object(object, length); -} - -static lispobj -trans_boxed_large(lispobj object) -{ - lispobj header; - unsigned long length; - - gc_assert(is_lisp_pointer(object)); - - header = *((lispobj *) native_pointer(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); - - return copy_large_object(object, length); -} - -static int -size_boxed(lispobj *where) -{ - lispobj header; - unsigned long length; - - header = *where; - length = HeaderValue(header) + 1; - length = CEILING(length, 2); - - return length; -} - -static int -scav_fdefn(lispobj *where, lispobj object) -{ - struct fdefn *fdefn; - - fdefn = (struct fdefn *)where; - - /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n", - fdefn->fun, fdefn->raw_addr)); */ - - if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) == fdefn->raw_addr) { - scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1); - - /* Don't write unnecessarily. */ - if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)) - fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET); - - return sizeof(struct fdefn) / sizeof(lispobj); - } else { - return 1; - } -} - -static int -scav_unboxed(lispobj *where, lispobj object) -{ - unsigned long length; - - length = HeaderValue(object) + 1; - length = CEILING(length, 2); - - return length; -} - -static lispobj -trans_unboxed(lispobj object) -{ - lispobj header; - unsigned long length; - - - gc_assert(is_lisp_pointer(object)); - - header = *((lispobj *) native_pointer(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); - - return copy_unboxed_object(object, length); -} - -static lispobj -trans_unboxed_large(lispobj object) -{ - lispobj header; - unsigned long length; - - - gc_assert(is_lisp_pointer(object)); - - header = *((lispobj *) native_pointer(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); - - return copy_large_unboxed_object(object, length); -} - -static int -size_unboxed(lispobj *where) -{ - lispobj header; - unsigned long length; - - header = *where; - length = HeaderValue(header) + 1; - length = CEILING(length, 2); - - return length; -} - -/* - * vector-like objects - */ - -#define NWORDS(x,y) (CEILING((x),(y)) / (y)) - -static int -scav_string(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - /* NOTE: Strings contain one more byte of data than the length */ - /* slot indicates. */ - - vector = (struct vector *) where; - length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); - - return nwords; -} - -static lispobj -trans_string(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - /* NOTE: A string contains one more byte of data (a terminating - * '\0' to help when interfacing with C functions) than indicated - * by the length slot. */ - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_string(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - /* NOTE: A string contains one more byte of data (a terminating - * '\0' to help when interfacing with C functions) than indicated - * by the length slot. */ - - vector = (struct vector *) where; - length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); - - return nwords; -} - -/* FIXME: What does this mean? */ -int gencgc_hash = 1; - -static int -scav_vector(lispobj *where, lispobj object) +scav_vector(lispobj *where, lispobj object) { unsigned int kv_length; lispobj *kv_vector; @@ -2879,562 +2015,28 @@ scav_vector(lispobj *where, lispobj object) break; } prior = next; - next = next_vector[next]; - } - } - } - } - } - } - } - return (CEILING(kv_length + 2, 2)); -} - -static lispobj -trans_vector(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); - - return copy_large_object(object, nwords); -} - -static int -size_vector(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); - - return nwords; -} - - -static int -scav_vector_bit(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_bit(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_vector_bit(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); - - return nwords; -} - - -static int -scav_vector_unsigned_byte_2(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_unsigned_byte_2(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_vector_unsigned_byte_2(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); - - return nwords; -} - - -static int -scav_vector_unsigned_byte_4(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_unsigned_byte_4(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_vector_unsigned_byte_4(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); - - return nwords; -} - -static int -scav_vector_unsigned_byte_8(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_unsigned_byte_8(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_vector_unsigned_byte_8(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); - - return nwords; -} - - -static int -scav_vector_unsigned_byte_16(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_unsigned_byte_16(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_vector_unsigned_byte_16(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); - - return nwords; -} - -static int -scav_vector_unsigned_byte_32(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_unsigned_byte_32(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_vector_unsigned_byte_32(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); - - return nwords; -} - -static int -scav_vector_single_float(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_single_float(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_vector_single_float(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); - - return nwords; -} - -static int -scav_vector_double_float(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_double_float(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_vector_double_float(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); - - return nwords; -} - -#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG -static int -scav_vector_long_float(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 3 + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_long_float(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 3 + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_vector_long_float(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 3 + 2, 2); - - return nwords; -} -#endif - - -#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG -static int -scav_vector_complex_single_float(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_complex_single_float(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_vector_complex_single_float(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); - - return nwords; -} -#endif - -#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG -static int -scav_vector_complex_double_float(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 4 + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_complex_double_float(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 4 + 2, 2); - - return copy_large_unboxed_object(object, nwords); -} - -static int -size_vector_complex_double_float(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 4 + 2, 2); - - return nwords; -} -#endif - - -#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG -static int -scav_vector_complex_long_float(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 6 + 2, 2); - - return nwords; -} - -static lispobj -trans_vector_complex_long_float(lispobj object) -{ - struct vector *vector; - int length, nwords; - - gc_assert(is_lisp_pointer(object)); - - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 6 + 2, 2); - - return copy_large_unboxed_object(object, nwords); + next = next_vector[next]; + } + } + } + } + } + } + } + return (CEILING(kv_length + 2, 2)); } -static int -size_vector_complex_long_float(lispobj *where) -{ - struct vector *vector; - int length, nwords; - - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 6 + 2, 2); - - return nwords; -} -#endif /* * weak pointers */ -/* XX This is a hack adapted from cgc.c. These don't work too well with the - * gencgc as a list of the weak pointers is maintained within the - * objects which causes writes to the pages. A limited attempt is made - * to avoid unnecessary writes, but this needs a re-think. */ - +/* XX This is a hack adapted from cgc.c. These don't work too + * efficiently with the gencgc as a list of the weak pointers is + * maintained within the objects which causes writes to the pages. A + * limited attempt is made to avoid unnecessary writes, but this needs + * a re-think. */ #define WEAK_POINTER_NWORDS \ CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2) @@ -3472,396 +2074,6 @@ scav_weak_pointer(lispobj *where, lispobj object) return WEAK_POINTER_NWORDS; } -static lispobj -trans_weak_pointer(lispobj object) -{ - lispobj copy; - /* struct weak_pointer *wp; */ - - gc_assert(is_lisp_pointer(object)); - -#if defined(DEBUG_WEAK) - FSHOW((stderr, "Transporting weak pointer from 0x%08x\n", object)); -#endif - - /* Need to remember where all the weak pointers are that have */ - /* been transported so they can be fixed up in a post-GC pass. */ - - copy = copy_object(object, WEAK_POINTER_NWORDS); - /* wp = (struct weak_pointer *) native_pointer(copy);*/ - - - /* Push the weak pointer onto the list of weak pointers. */ - /* wp->next = weak_pointers; - * weak_pointers = wp;*/ - - return copy; -} - -static int -size_weak_pointer(lispobj *where) -{ - return WEAK_POINTER_NWORDS; -} - -void scan_weak_pointers(void) -{ - struct weak_pointer *wp; - for (wp = weak_pointers; wp != NULL; wp = wp->next) { - lispobj value = wp->value; - lispobj *first_pointer; - - first_pointer = (lispobj *)native_pointer(value); - - if (is_lisp_pointer(value) && from_space_p(value)) { - /* Now, we need to check whether the object has been forwarded. If - * it has been, the weak pointer is still good and needs to be - * updated. Otherwise, the weak pointer needs to be nil'ed - * out. */ - if (first_pointer[0] == 0x01) { - wp->value = first_pointer[1]; - } else { - /* Break it. */ - wp->value = NIL; - wp->broken = T; - } - } - } -} - -/* - * initialization - */ - -static int -scav_lose(lispobj *where, lispobj object) -{ - lose("no scavenge function for object 0x%08x (widetag 0x%x)", - (unsigned long)object, - widetag_of(*(lispobj*)native_pointer(object))); - return 0; /* bogus return value to satisfy static type checking */ -} - -static lispobj -trans_lose(lispobj object) -{ - lose("no transport function for object 0x%08x (widetag 0x%x)", - (unsigned long)object, - widetag_of(*(lispobj*)native_pointer(object))); - return NIL; /* bogus return value to satisfy static type checking */ -} - -static int -size_lose(lispobj *where) -{ - lose("no size function for object at 0x%08x (widetag 0x%x)", - (unsigned long)where, - widetag_of(where)); - return 1; /* bogus return value to satisfy static type checking */ -} - -static void -gc_init_tables(void) -{ - int i; - - /* Set default value in all slots of scavenge table. */ - for (i = 0; i < 256; i++) { /* FIXME: bare constant length, ick! */ - scavtab[i] = scav_lose; - } - - /* For each type which can be selected by the lowtag alone, set - * multiple entries in our widetag scavenge table (one for each - * possible value of the high bits). - * - * FIXME: bare constant 32 and 3 here, ick! */ - for (i = 0; i < 32; i++) { - scavtab[EVEN_FIXNUM_LOWTAG|(i<<3)] = scav_immediate; - scavtab[FUN_POINTER_LOWTAG|(i<<3)] = scav_fun_pointer; - /* skipping OTHER_IMMEDIATE_0_LOWTAG */ - scavtab[LIST_POINTER_LOWTAG|(i<<3)] = scav_list_pointer; - scavtab[ODD_FIXNUM_LOWTAG|(i<<3)] = scav_immediate; - scavtab[INSTANCE_POINTER_LOWTAG|(i<<3)] = scav_instance_pointer; - /* skipping OTHER_IMMEDIATE_1_LOWTAG */ - scavtab[OTHER_POINTER_LOWTAG|(i<<3)] = scav_other_pointer; - } - - /* Other-pointer types (those selected by all eight bits of the - * tag) get one entry each in the scavenge table. */ - scavtab[BIGNUM_WIDETAG] = scav_unboxed; - scavtab[RATIO_WIDETAG] = scav_boxed; - scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed; - scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed; -#ifdef LONG_FLOAT_WIDETAG - scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed; -#endif - scavtab[COMPLEX_WIDETAG] = scav_boxed; -#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG - scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed; -#endif -#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG - scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed; -#endif -#ifdef COMPLEX_LONG_FLOAT_WIDETAG - scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed; -#endif - scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed; - scavtab[SIMPLE_STRING_WIDETAG] = scav_string; - scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit; - scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector; - scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] = - scav_vector_unsigned_byte_2; - scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] = - scav_vector_unsigned_byte_4; - scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] = - scav_vector_unsigned_byte_8; - scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] = - scav_vector_unsigned_byte_16; - scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] = - scav_vector_unsigned_byte_32; -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG - scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8; -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG - scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] = - scav_vector_unsigned_byte_16; -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG - scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] = - scav_vector_unsigned_byte_32; -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG - scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] = - scav_vector_unsigned_byte_32; -#endif - scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float; - scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float; -#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG - scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float; -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG - scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] = - scav_vector_complex_single_float; -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG - scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] = - scav_vector_complex_double_float; -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG - scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] = - scav_vector_complex_long_float; -#endif - scavtab[COMPLEX_STRING_WIDETAG] = scav_boxed; - scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed; - scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed; - scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed; - scavtab[CODE_HEADER_WIDETAG] = scav_code_header; - /*scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;*/ - /*scavtab[CLOSURE_FUN_HEADER_WIDETAG] = scav_fun_header;*/ - /*scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;*/ -#ifdef __i386__ - scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header; - scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header; -#else - scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed; - scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed; -#endif - scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed; - scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed; - scavtab[BASE_CHAR_WIDETAG] = scav_immediate; - scavtab[SAP_WIDETAG] = scav_unboxed; - scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate; - scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer; - scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed; - scavtab[FDEFN_WIDETAG] = scav_fdefn; - - /* transport other table, initialized same way as scavtab */ - for (i = 0; i < 256; i++) - transother[i] = trans_lose; - transother[BIGNUM_WIDETAG] = trans_unboxed; - transother[RATIO_WIDETAG] = trans_boxed; - transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed; - transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed; -#ifdef LONG_FLOAT_WIDETAG - transother[LONG_FLOAT_WIDETAG] = trans_unboxed; -#endif - transother[COMPLEX_WIDETAG] = trans_boxed; -#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG - transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed; -#endif -#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG - transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed; -#endif -#ifdef COMPLEX_LONG_FLOAT_WIDETAG - transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed; -#endif - transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed_large; - transother[SIMPLE_STRING_WIDETAG] = trans_string; - transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit; - transother[SIMPLE_VECTOR_WIDETAG] = trans_vector; - transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] = - trans_vector_unsigned_byte_2; - transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] = - trans_vector_unsigned_byte_4; - transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] = - trans_vector_unsigned_byte_8; - transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] = - trans_vector_unsigned_byte_16; - transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] = - trans_vector_unsigned_byte_32; -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG - transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = - trans_vector_unsigned_byte_8; -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG - transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] = - trans_vector_unsigned_byte_16; -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG - transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] = - trans_vector_unsigned_byte_32; -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG - transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] = - trans_vector_unsigned_byte_32; -#endif - transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = - trans_vector_single_float; - transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = - trans_vector_double_float; -#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG - transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = - trans_vector_long_float; -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG - transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] = - trans_vector_complex_single_float; -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG - transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] = - trans_vector_complex_double_float; -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG - transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] = - trans_vector_complex_long_float; -#endif - transother[COMPLEX_STRING_WIDETAG] = trans_boxed; - transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed; - transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed; - transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed; - transother[CODE_HEADER_WIDETAG] = trans_code_header; - transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header; - transother[CLOSURE_FUN_HEADER_WIDETAG] = trans_fun_header; - transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header; - transother[CLOSURE_HEADER_WIDETAG] = trans_boxed; - transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed; - transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed; - transother[SYMBOL_HEADER_WIDETAG] = trans_boxed; - transother[BASE_CHAR_WIDETAG] = trans_immediate; - transother[SAP_WIDETAG] = trans_unboxed; - transother[UNBOUND_MARKER_WIDETAG] = trans_immediate; - transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer; - transother[INSTANCE_HEADER_WIDETAG] = trans_boxed; - transother[FDEFN_WIDETAG] = trans_boxed; - - /* size table, initialized the same way as scavtab */ - for (i = 0; i < 256; i++) - sizetab[i] = size_lose; - for (i = 0; i < 32; i++) { - sizetab[EVEN_FIXNUM_LOWTAG|(i<<3)] = size_immediate; - sizetab[FUN_POINTER_LOWTAG|(i<<3)] = size_pointer; - /* skipping OTHER_IMMEDIATE_0_LOWTAG */ - sizetab[LIST_POINTER_LOWTAG|(i<<3)] = size_pointer; - sizetab[ODD_FIXNUM_LOWTAG|(i<<3)] = size_immediate; - sizetab[INSTANCE_POINTER_LOWTAG|(i<<3)] = size_pointer; - /* skipping OTHER_IMMEDIATE_1_LOWTAG */ - sizetab[OTHER_POINTER_LOWTAG|(i<<3)] = size_pointer; - } - sizetab[BIGNUM_WIDETAG] = size_unboxed; - sizetab[RATIO_WIDETAG] = size_boxed; - sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed; - sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed; -#ifdef LONG_FLOAT_WIDETAG - sizetab[LONG_FLOAT_WIDETAG] = size_unboxed; -#endif - sizetab[COMPLEX_WIDETAG] = size_boxed; -#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG - sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed; -#endif -#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG - sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed; -#endif -#ifdef COMPLEX_LONG_FLOAT_WIDETAG - sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed; -#endif - sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed; - sizetab[SIMPLE_STRING_WIDETAG] = size_string; - sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit; - sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector; - sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] = - size_vector_unsigned_byte_2; - sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] = - size_vector_unsigned_byte_4; - sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] = - size_vector_unsigned_byte_8; - sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] = - size_vector_unsigned_byte_16; - sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] = - size_vector_unsigned_byte_32; -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG - sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8; -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG - sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] = - size_vector_unsigned_byte_16; -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG - sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] = - size_vector_unsigned_byte_32; -#endif -#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG - sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] = - size_vector_unsigned_byte_32; -#endif - sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float; - sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float; -#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG - sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float; -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG - sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] = - size_vector_complex_single_float; -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG - sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] = - size_vector_complex_double_float; -#endif -#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG - sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] = - size_vector_complex_long_float; -#endif - sizetab[COMPLEX_STRING_WIDETAG] = size_boxed; - sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed; - sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed; - sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed; - sizetab[CODE_HEADER_WIDETAG] = size_code_header; -#if 0 - /* We shouldn't see these, so just lose if it happens. */ - sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header; - sizetab[CLOSURE_FUN_HEADER_WIDETAG] = size_function_header; - sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header; -#endif - sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed; - sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed; - sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed; - sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed; - sizetab[BASE_CHAR_WIDETAG] = size_immediate; - sizetab[SAP_WIDETAG] = size_unboxed; - sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate; - sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer; - sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed; - sizetab[FDEFN_WIDETAG] = size_boxed; -} /* Scan an area looking for an object which encloses the given pointer. * Return the object start on success or NULL on failure. */ @@ -3901,7 +2113,7 @@ static lispobj* search_read_only_space(lispobj *pointer) { lispobj* start = (lispobj*)READ_ONLY_SPACE_START; - lispobj* end = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER); + lispobj* end = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0); if ((pointer < start) || (pointer >= end)) return NULL; return (search_space(start, (pointer+2)-start, pointer)); @@ -3911,7 +2123,7 @@ static lispobj * search_static_space(lispobj *pointer) { lispobj* start = (lispobj*)STATIC_SPACE_START; - lispobj* end = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER); + lispobj* end = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER,0); if ((pointer < start) || (pointer >= end)) return NULL; return (search_space(start, (pointer+2)-start, pointer)); @@ -3935,7 +2147,8 @@ search_dynamic_space(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? */ + * 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) { @@ -3962,21 +2175,7 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) /* Check that the object pointed to is consistent with the pointer * low tag. - * - * FIXME: It's not safe to rely on the result from this check - * before an object is initialized. Thus, if we were interrupted - * just as an object had been allocated but not initialized, the - * GC relying on this result could bogusly reclaim the memory. - * However, we can't really afford to do without this check. So - * we should make it safe somehow. - * (1) Perhaps just review the code to make sure - * that WITHOUT-GCING or WITHOUT-INTERRUPTS or some such - * thing is wrapped around critical sections where allocated - * memory type bits haven't been set. - * (2) Perhaps find some other hack to protect against this, e.g. - * recording the result of the last call to allocate-lisp-memory, - * and returning true from this function when *pointer is - * a reference to that result. */ + */ switch (lowtag_of((lispobj)pointer)) { case FUN_POINTER_LOWTAG: /* Start_addr should be the enclosing code object, or a closure @@ -4119,6 +2318,7 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) #endif case SIMPLE_STRING_WIDETAG: case SIMPLE_BIT_VECTOR_WIDETAG: + case SIMPLE_ARRAY_NIL_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: @@ -4202,6 +2402,7 @@ maybe_adjust_large_object(lispobj *where) case BIGNUM_WIDETAG: case SIMPLE_STRING_WIDETAG: case SIMPLE_BIT_VECTOR_WIDETAG: + case SIMPLE_ARRAY_NIL_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: @@ -4354,7 +2555,7 @@ preserve_pointer(void *addr) /* Skip if already marked dont_move. */ || (page_table[addr_page_index].dont_move != 0)) return; - + gc_assert(!(page_table[addr_page_index].allocated & OPEN_REGION_PAGE)); /* (Now that we know that addr_page_index is in range, it's * safe to index into page_table[] with it.) */ region_allocation = page_table[addr_page_index].allocated; @@ -4371,15 +2572,22 @@ preserve_pointer(void *addr) * (or, as a special case which also requires dont_move, a return * address referring to something in a CodeObject). This is * expensive but important, since it vastly reduces the - * probability that random garbage will be bogusly interpreter as + * probability that random garbage will be bogusly interpreted as * a pointer which prevents a page from moving. */ - if (!possibly_valid_dynamic_space_pointer(addr)) + if (!(possibly_valid_dynamic_space_pointer(addr))) return; + first_page = addr_page_index; /* Work backwards to find a page with a first_object_offset of 0. * The pages should be contiguous with all bytes used in the same * gen. Assumes the first_object_offset is negative or zero. */ - first_page = addr_page_index; + + /* this is probably needlessly conservative. The first object in + * the page may not even be the one we were passed a pointer to: + * if this is the case, we will write-protect all the previous + * object's pages too. + */ + while (page_table[first_page].first_object_offset != 0) { --first_page; /* Do some checks. */ @@ -4474,7 +2682,7 @@ update_page_write_prot(int page) /* Skip if it's already write-protected or an unboxed page. */ if (page_table[page].write_protected - || (page_table[page].allocated == UNBOXED_PAGE)) + || (page_table[page].allocated & UNBOXED_PAGE)) return (0); /* Scan the page for pointers to younger generations or the @@ -4562,7 +2770,7 @@ scavenge_generation(int generation) #endif for (i = 0; i < last_free_page; i++) { - if ((page_table[i].allocated == BOXED_PAGE) + if ((page_table[i].allocated & BOXED_PAGE) && (page_table[i].bytes_used != 0) && (page_table[i].gen == generation)) { int last_page; @@ -4581,7 +2789,7 @@ scavenge_generation(int generation) * block. */ if ((page_table[last_page].bytes_used < 4096) /* Or it is 4096 and is the last in the block */ - || (page_table[last_page+1].allocated != BOXED_PAGE) + || (!(page_table[last_page+1].allocated & BOXED_PAGE)) || (page_table[last_page+1].bytes_used == 0) || (page_table[last_page+1].gen != generation) || (page_table[last_page+1].first_object_offset == 0)) @@ -4679,8 +2887,8 @@ scavenge_newspace_generation_one_scan(int generation) FSHOW((stderr, "/starting one full scan of newspace generation %d\n", generation)); - for (i = 0; i < last_free_page; i++) { + /* note that this skips over open regions when it encounters them */ if ((page_table[i].allocated == BOXED_PAGE) && (page_table[i].bytes_used != 0) && (page_table[i].gen == generation) @@ -4703,7 +2911,7 @@ scavenge_newspace_generation_one_scan(int generation) * contiguous block */ if ((page_table[last_page].bytes_used < 4096) /* Or it is 4096 and is the last in the block */ - || (page_table[last_page+1].allocated != BOXED_PAGE) + || (!(page_table[last_page+1].allocated & BOXED_PAGE)) || (page_table[last_page+1].bytes_used == 0) || (page_table[last_page+1].gen != generation) || (page_table[last_page+1].first_object_offset == 0)) @@ -4768,8 +2976,7 @@ scavenge_newspace_generation(int generation) int previous_new_areas_index; /* Flush the current regions updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); + gc_alloc_update_all_page_tables(); /* Turn on the recording of new areas by gc_alloc(). */ new_areas = current_new_areas; @@ -4786,8 +2993,7 @@ scavenge_newspace_generation(int generation) record_new_objects = 2; /* Flush the current regions updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); + gc_alloc_update_all_page_tables(); /* Grab new_areas_index. */ current_new_areas_index = new_areas_index; @@ -4834,8 +3040,7 @@ scavenge_newspace_generation(int generation) record_new_objects = 2; /* Flush the current regions updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); + gc_alloc_update_all_page_tables(); } else { @@ -4847,13 +3052,11 @@ scavenge_newspace_generation(int generation) int offset = (*previous_new_areas)[i].offset; int size = (*previous_new_areas)[i].size / 4; gc_assert((*previous_new_areas)[i].size % 4 == 0); - scavenge(page_address(page)+offset, size); } /* Flush the current regions updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); + gc_alloc_update_all_page_tables(); } current_new_areas_index = new_areas_index; @@ -5040,7 +3243,7 @@ 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)start && - (unsigned)start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); + (unsigned)start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0)); while (words > 0) { size_t count = 1; @@ -5050,10 +3253,10 @@ verify_space(lispobj *start, size_t words) int page_index = find_page_index((void*)thing); int to_readonly_space = (READ_ONLY_SPACE_START <= thing && - thing < SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); + thing < SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0)); int to_static_space = (STATIC_SPACE_START <= thing && - thing < SymbolValue(STATIC_SPACE_FREE_POINTER)); + thing < SymbolValue(STATIC_SPACE_FREE_POINTER,0)); /* Does it point to the dynamic space? */ if (page_index != -1) { @@ -5075,9 +3278,17 @@ verify_space(lispobj *start, size_t words) /* Does it point to a plausible object? This check slows * it down a lot (so it's commented out). * - * FIXME: Add a variable to enable this dynamically. */ - /* if (!possibly_valid_dynamic_space_pointer((lispobj *)thing)) { - * lose("ptr %x to invalid object %x", thing, start); */ + * "a lot" is serious: it ate 50 minutes cpu time on + * my duron 950 before I came back from lunch and + * killed it. + * + * FIXME: Add a variable to enable this + * dynamically. */ + /* + if (!possibly_valid_dynamic_space_pointer((lispobj *)thing)) { + lose("ptr %x to invalid object %x", thing, start); + } + */ } else { /* Verify that it points to another valid space. */ if (!to_readonly_space && !to_static_space @@ -5183,6 +3394,7 @@ verify_space(lispobj *start, size_t words) #endif case SIMPLE_STRING_WIDETAG: case SIMPLE_BIT_VECTOR_WIDETAG: + case SIMPLE_ARRAY_NIL_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: @@ -5239,18 +3451,20 @@ verify_gc(void) * to grep for all foo_size and rename the appropriate ones to * foo_count. */ int read_only_space_size = - (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) + (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0) - (lispobj*)READ_ONLY_SPACE_START; int static_space_size = - (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER) + (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER,0) - (lispobj*)STATIC_SPACE_START; + struct thread *th; + for_each_thread(th) { int binding_stack_size = - (lispobj*)SymbolValue(BINDING_STACK_POINTER) - - (lispobj*)BINDING_STACK_START; - + (lispobj*)SymbolValue(BINDING_STACK_POINTER,th) + - (lispobj*)th->binding_stack_start; + verify_space(th->binding_stack_start, binding_stack_size); + } verify_space((lispobj*)READ_ONLY_SPACE_START, read_only_space_size); verify_space((lispobj*)STATIC_SPACE_START , static_space_size); - verify_space((lispobj*)BINDING_STACK_START , binding_stack_size); } static void @@ -5330,13 +3544,9 @@ void gencgc_verify_zero_fill(void) { /* Flush the alloc regions updating the tables. */ - boxed_region.free_pointer = current_region_free_pointer; - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); + gc_alloc_update_all_page_tables(); SHOW("verifying zero fill"); verify_zero_fill(); - current_region_free_pointer = boxed_region.free_pointer; - current_region_end_addr = boxed_region.end_addr; } static void @@ -5392,7 +3602,7 @@ garbage_collect_generation(int generation, int raise) unsigned long bytes_freed; unsigned long i; unsigned long static_space_size; - + struct thread *th; gc_assert(generation <= (NUM_GENERATIONS-1)); /* The oldest generation can't be raised. */ @@ -5434,11 +3644,30 @@ garbage_collect_generation(int generation, int raise) * be un-protected anyway before unmapping later. */ unprotect_oldspace(); - /* Scavenge the stack's conservative roots. */ - { + /* Scavenge the stacks' conservative roots. */ + for_each_thread(th) { void **ptr; - for (ptr = (void **)CONTROL_STACK_END - 1; +#ifdef LISP_FEATURE_SB_THREAD + struct user_regs_struct regs; + if(ptrace(PTRACE_GETREGS,th->pid,0,®s)){ + /* probably doesn't exist any more. */ + fprintf(stderr,"child pid %d, %s\n",th->pid,strerror(errno)); + perror("PTRACE_GETREGS"); + } + preserve_pointer(regs.ebx); + preserve_pointer(regs.ecx); + preserve_pointer(regs.edx); + preserve_pointer(regs.esi); + preserve_pointer(regs.edi); + preserve_pointer(regs.ebp); + preserve_pointer(regs.eax); +#endif + for (ptr = th->control_stack_end; +#ifdef LISP_FEATURE_SB_THREAD + ptr > regs.esp; +#else ptr > (void **)&raise; +#endif ptr--) { preserve_pointer(*ptr); } @@ -5460,18 +3689,31 @@ garbage_collect_generation(int generation, int raise) /* Scavenge the Lisp functions of the interrupt handlers, taking * care to avoid SIG_DFL and SIG_IGN. */ + for_each_thread(th) { + struct interrupt_data *data=th->interrupt_data; for (i = 0; i < NSIG; i++) { - union interrupt_handler handler = interrupt_handlers[i]; + union interrupt_handler handler = data->interrupt_handlers[i]; if (!ARE_SAME_HANDLER(handler.c, SIG_IGN) && !ARE_SAME_HANDLER(handler.c, SIG_DFL)) { - scavenge((lispobj *)(interrupt_handlers + i), 1); + scavenge((lispobj *)(data->interrupt_handlers + i), 1); + } + } + } + /* Scavenge the binding stacks. */ + { + struct thread *th; + for_each_thread(th) { + long len= (lispobj *)SymbolValue(BINDING_STACK_POINTER,th) - + th->binding_stack_start; + scavenge((lispobj *) th->binding_stack_start,len); +#ifdef LISP_FEATURE_SB_THREAD + /* do the tls as well */ + len=fixnum_value(SymbolValue(FREE_TLS_INDEX,0)) - + (sizeof (struct thread))/(sizeof (lispobj)); + scavenge((lispobj *) (th+1),len); +#endif } } - - /* Scavenge the binding stack. */ - scavenge((lispobj *) BINDING_STACK_START, - (lispobj *)SymbolValue(BINDING_STACK_POINTER) - - (lispobj *)BINDING_STACK_START); /* The original CMU CL code had scavenge-read-only-space code * controlled by the Lisp-level variable @@ -5494,7 +3736,7 @@ garbage_collect_generation(int generation, int raise) /* Scavenge static space. */ static_space_size = - (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER) - + (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0) - (lispobj *)STATIC_SPACE_START; if (gencgc_verbose > 1) { FSHOW((stderr, @@ -5534,8 +3776,7 @@ garbage_collect_generation(int generation, int raise) scavenge_newspace_generation_one_scan(new_space); /* Flush the current regions, updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); + gc_alloc_update_all_page_tables(); bytes_allocated = bytes_allocated - old_bytes_allocated; @@ -5549,8 +3790,7 @@ garbage_collect_generation(int generation, int raise) scan_weak_pointers(); /* Flush the current regions, updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); + gc_alloc_update_all_page_tables(); /* Free the pages in oldspace, but not those marked dont_move. */ bytes_freed = free_oldspace(); @@ -5607,18 +3847,19 @@ update_x86_dynamic_space_free_pointer(void) last_free_page = last_page+1; SetSymbolValue(ALLOCATION_POINTER, - (lispobj)(((char *)heap_base) + last_free_page*4096)); + (lispobj)(((char *)heap_base) + last_free_page*4096),0); return 0; /* dummy value: return something ... */ } -/* GC all generations below last_gen, raising their objects to the - * next generation until all generations below last_gen are empty. - * Then if last_gen is due for a GC then GC it. In the special case - * that last_gen==NUM_GENERATIONS, the last generation is always - * GC'ed. The valid range for last_gen is: 0,1,...,NUM_GENERATIONS. +/* 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 + * last_gen==NUM_GENERATIONS (the scratch generation? eh?) we GC that + * too. The valid range for last_gen is: 0,1,...,NUM_GENERATIONS. * - * The oldest generation to be GCed will always be - * gencgc_oldest_gen_to_gc, partly ignoring last_gen if necessary. */ + * 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(unsigned last_gen) { @@ -5627,8 +3868,6 @@ collect_garbage(unsigned last_gen) int gen_to_wp; int i; - boxed_region.free_pointer = current_region_free_pointer; - FSHOW((stderr, "/entering collect_garbage(%d)\n", last_gen)); if (last_gen > NUM_GENERATIONS) { @@ -5639,12 +3878,11 @@ collect_garbage(unsigned last_gen) } /* Flush the alloc regions updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); + gc_alloc_update_all_page_tables(); /* Verify the new objects created by Lisp code. */ if (pre_verify_gen_0) { - SHOW((stderr, "pre-checking generation 0\n")); + FSHOW((stderr, "pre-checking generation 0\n")); verify_generation(0); } @@ -5731,14 +3969,10 @@ collect_garbage(unsigned last_gen) gc_alloc_generation = 0; update_x86_dynamic_space_free_pointer(); - - /* This is now done by Lisp SCRUB-CONTROL-STACK in Lisp SUB-GC, so - * we needn't do it here: */ - /* zero_stack();*/ - - current_region_free_pointer = boxed_region.free_pointer; - current_region_end_addr = boxed_region.end_addr; - + auto_gc_trigger = bytes_allocated + bytes_consed_between_gcs; + if(gencgc_verbose) + fprintf(stderr,"Next gc when %d bytes have been consed\n", + auto_gc_trigger); SHOW("returning from collect_garbage"); } @@ -5815,26 +4049,12 @@ gc_free_heap(void) /* Initialize gc_alloc(). */ gc_alloc_generation = 0; - boxed_region.first_page = 0; - boxed_region.last_page = -1; - boxed_region.start_addr = page_address(0); - boxed_region.free_pointer = page_address(0); - boxed_region.end_addr = page_address(0); - unboxed_region.first_page = 0; - unboxed_region.last_page = -1; - unboxed_region.start_addr = page_address(0); - unboxed_region.free_pointer = page_address(0); - unboxed_region.end_addr = page_address(0); - -#if 0 /* Lisp PURIFY is currently running on the C stack so don't do this. */ - zero_stack(); -#endif - last_free_page = 0; - SetSymbolValue(ALLOCATION_POINTER, (lispobj)((char *)heap_base)); + gc_set_region_empty(&boxed_region); + gc_set_region_empty(&unboxed_region); - current_region_free_pointer = boxed_region.free_pointer; - current_region_end_addr = boxed_region.end_addr; + last_free_page = 0; + SetSymbolValue(ALLOCATION_POINTER, (lispobj)((char *)heap_base),0); if (verify_after_free_heap) { /* Check whether purify has left any bad pointers. */ @@ -5850,6 +4070,9 @@ gc_init(void) int i; gc_init_tables(); + scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector; + scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer; + transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed_large; heap_base = (void*)DYNAMIC_SPACE_START; @@ -5883,25 +4106,13 @@ gc_init(void) generations[i].min_av_mem_age = 0.75; } - /* Initialize gc_alloc. - * - * FIXME: identical with code in gc_free_heap(), should be shared */ + /* Initialize gc_alloc. */ gc_alloc_generation = 0; - boxed_region.first_page = 0; - boxed_region.last_page = -1; - boxed_region.start_addr = page_address(0); - boxed_region.free_pointer = page_address(0); - boxed_region.end_addr = page_address(0); - unboxed_region.first_page = 0; - unboxed_region.last_page = -1; - unboxed_region.start_addr = page_address(0); - unboxed_region.free_pointer = page_address(0); - unboxed_region.end_addr = page_address(0); + gc_set_region_empty(&boxed_region); + gc_set_region_empty(&unboxed_region); last_free_page = 0; - current_region_free_pointer = boxed_region.free_pointer; - current_region_end_addr = boxed_region.end_addr; } /* Pick up the dynamic space from after a core load. @@ -5909,12 +4120,12 @@ gc_init(void) * The ALLOCATION_POINTER points to the end of the dynamic space. * * XX A scan is needed to identify the closest first objects for pages. */ -void +static void gencgc_pickup_dynamic(void) { int page = 0; int addr = DYNAMIC_SPACE_START; - int alloc_ptr = SymbolValue(ALLOCATION_POINTER); + int alloc_ptr = SymbolValue(ALLOCATION_POINTER,0); /* Initialize the first region. */ do { @@ -5931,13 +4142,18 @@ gencgc_pickup_dynamic(void) generations[0].bytes_allocated = 4096*page; bytes_allocated = 4096*page; - current_region_free_pointer = boxed_region.free_pointer; - current_region_end_addr = boxed_region.end_addr; } + +void +gc_initialize_pointers(void) +{ + gencgc_pickup_dynamic(); +} + + -/* a counter for how deep we are in alloc(..) calls */ -int alloc_entered = 0; +extern boolean maybe_gc_pending ; /* alloc(..) is the external interface for memory allocation. It * allocates to generation 0. It is not called from within the garbage * collector as it is only external uses that need the check for heap @@ -5948,167 +4164,59 @@ int alloc_entered = 0; * (E.g. the most significant word of a 2-word bignum in MOVE-FROM-UNSIGNED.) * * The check for a GC trigger is only performed when the current - * region is full, so in most cases it's not needed. Further MAYBE-GC - * is only called once because Lisp will remember "need to collect - * garbage" and get around to it when it can. */ + * region is full, so in most cases it's not needed. */ + char * alloc(int nbytes) { + struct thread *th=arch_os_get_current_thread(); + struct alloc_region *region= + th ? &(th->alloc_region) : &boxed_region; + void *new_obj; + void *new_free_pointer; + /* Check for alignment allocation problems. */ - gc_assert((((unsigned)current_region_free_pointer & 0x7) == 0) + gc_assert((((unsigned)region->free_pointer & 0x7) == 0) && ((nbytes & 0x7) == 0)); - - if (SymbolValue(PSEUDO_ATOMIC_ATOMIC)) {/* if already in a pseudo atomic */ - - void *new_free_pointer; - - retry1: - if (alloc_entered) { - SHOW("alloc re-entered in already-pseudo-atomic case"); - } - ++alloc_entered; - - /* Check whether there is room in the current region. */ - new_free_pointer = current_region_free_pointer + nbytes; - - /* FIXME: Shouldn't we be doing some sort of lock here, to - * keep from getting screwed if an interrupt service routine - * allocates memory between the time we calculate new_free_pointer - * and the time we write it back to current_region_free_pointer? - * Perhaps I just don't understand pseudo-atomics.. - * - * Perhaps I don't. It looks as though what happens is if we - * were interrupted any time during the pseudo-atomic - * interval (which includes now) we discard the allocated - * memory and try again. So, at least we don't return - * a memory area that was allocated out from underneath us - * by code in an ISR. - * Still, that doesn't seem to prevent - * current_region_free_pointer from getting corrupted: - * We read current_region_free_pointer. - * They read current_region_free_pointer. - * They write current_region_free_pointer. - * We write current_region_free_pointer, scribbling over - * whatever they wrote. */ - - if (new_free_pointer <= boxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = current_region_free_pointer; - current_region_free_pointer = new_free_pointer; - alloc_entered--; - return((void *)new_obj); - } - - if (auto_gc_trigger && bytes_allocated > auto_gc_trigger) { - /* Double the trigger. */ - auto_gc_trigger *= 2; - alloc_entered--; - /* Exit the pseudo-atomic. */ - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0)); - if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED) != 0) { - /* Handle any interrupts that occurred during - * gc_alloc(..). */ - do_pending_interrupt(); - } - funcall0(SymbolFunction(MAYBE_GC)); - /* Re-enter the pseudo-atomic. */ - SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0)); - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1)); - goto retry1; - } - /* Call gc_alloc(). */ - boxed_region.free_pointer = current_region_free_pointer; - { - void *new_obj = gc_alloc(nbytes); - current_region_free_pointer = boxed_region.free_pointer; - current_region_end_addr = boxed_region.end_addr; - alloc_entered--; - return (new_obj); - } - } else { - void *result; - void *new_free_pointer; - - retry2: - /* At least wrap this allocation in a pseudo atomic to prevent - * gc_alloc() from being re-entered. */ - SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0)); - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1)); - - if (alloc_entered) - SHOW("alloc re-entered in not-already-pseudo-atomic case"); - ++alloc_entered; - - /* Check whether there is room in the current region. */ - new_free_pointer = current_region_free_pointer + nbytes; - - if (new_free_pointer <= boxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = current_region_free_pointer; - current_region_free_pointer = new_free_pointer; - alloc_entered--; - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0)); - if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED)) { - /* Handle any interrupts that occurred during - * gc_alloc(..). */ - do_pending_interrupt(); - goto retry2; - } - - return((void *)new_obj); - } - - /* KLUDGE: There's lots of code around here shared with the - * the other branch. Is there some way to factor out the - * duplicate code? -- WHN 19991129 */ - if (auto_gc_trigger && bytes_allocated > auto_gc_trigger) { - /* Double the trigger. */ - auto_gc_trigger *= 2; - alloc_entered--; - /* Exit the pseudo atomic. */ - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0)); - if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED) != 0) { - /* Handle any interrupts that occurred during - * gc_alloc(..); */ - do_pending_interrupt(); - } - funcall0(SymbolFunction(MAYBE_GC)); - goto retry2; - } - - /* Else call gc_alloc(). */ - boxed_region.free_pointer = current_region_free_pointer; - result = gc_alloc(nbytes); - current_region_free_pointer = boxed_region.free_pointer; - current_region_end_addr = boxed_region.end_addr; - - alloc_entered--; - SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0)); - if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED) != 0) { - /* Handle any interrupts that occurred during gc_alloc(..). */ - do_pending_interrupt(); - goto retry2; + 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)) { + register u32 fs; + fprintf(stderr, "fatal error in thread 0x%x, pid=%d\n", + th,getpid()); + __asm__("movl %fs,%0" : "=r" (fs) : ); + fprintf(stderr, "fs is %x, th->tls_cookie=%x (should be identical)\n", + debug_get_fs(),th->tls_cookie); + lose("If you see this message before 2003.05.01, mail details to sbcl-devel\n"); } - - return result; +#else + gc_assert(SymbolValue(PSEUDO_ATOMIC_ATOMIC,th)); +#endif + + /* maybe we can do this quickly ... */ + new_free_pointer = region->free_pointer + nbytes; + if (new_free_pointer <= region->end_addr) { + new_obj = (void*)(region->free_pointer); + region->free_pointer = new_free_pointer; + return(new_obj); /* yup */ } -} - -/* - * noise to manipulate the gc trigger stuff - */ - -void -set_auto_gc_trigger(os_vm_size_t dynamic_usage) -{ - auto_gc_trigger += dynamic_usage; + + /* 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) { + /* set things up so that GC happens when we finish the PA + * section. */ + maybe_gc_pending=1; + SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1),th); + } + new_obj = gc_alloc_with_region(nbytes,0,region,0); + return (new_obj); } -void -clear_auto_gc_trigger(void) -{ - auto_gc_trigger = 0; -} /* Find the code object for the given pc, or return NULL on failure. * @@ -6148,6 +4256,7 @@ void unhandled_sigmemoryfault(void); * Return true if this signal is a normal generational GC thing that * we were able to handle, or false if it was abnormal and control * should fall through to the general SIGSEGV/SIGBUS/whatever logic. */ + int gencgc_handle_wp_violation(void* fault_addr) { @@ -6169,23 +4278,26 @@ gencgc_handle_wp_violation(void* fault_addr) return 0; } else { - - /* The only acceptable reason for an signal like this from the - * heap is that the generational GC write-protected the page. */ - if (page_table[page_index].write_protected != 1) { - lose("access failure in heap page not marked as write-protected"); + if (page_table[page_index].write_protected) { + /* Unprotect the page. */ + os_protect(page_address(page_index), PAGE_BYTES, OS_VM_PROT_ALL); + page_table[page_index].write_protected_cleared = 1; + page_table[page_index].write_protected = 0; + } else { + /* The only acceptable reason for this signal on a heap + * access is that GENCGC write-protected the page. + * However, if two CPUs hit a wp page near-simultaneously, + * we had better not have the second one lose here if it + * 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"); + + /* Don't worry, we can handle it. */ + return 1; } - - /* Unprotect the page. */ - os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); - page_table[page_index].write_protected = 0; - page_table[page_index].write_protected_cleared = 1; - - /* Don't worry, we can handle it. */ - return 1; } } - /* This is to be called when we catch a SIGSEGV/SIGBUS, determine that * it's not just a case of the program hitting the write barrier, and * are about to let Lisp deal with it. It's basically just a @@ -6193,3 +4305,23 @@ gencgc_handle_wp_violation(void* fault_addr) void unhandled_sigmemoryfault() {} + +gc_alloc_update_all_page_tables(void) +{ + /* Flush the alloc regions updating the tables. */ + struct thread *th; + for_each_thread(th) + gc_alloc_update_page_tables(0, &th->alloc_region); + gc_alloc_update_page_tables(1, &unboxed_region); + gc_alloc_update_page_tables(0, &boxed_region); +} +void +gc_set_region_empty(struct alloc_region *region) +{ + region->first_page = 0; + region->last_page = -1; + region->start_addr = page_address(0); + region->free_pointer = page_address(0); + region->end_addr = page_address(0); +} +