X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;h=2af538d15b3d0ce3bbbc7e999313d1a1c0b91b1e;hb=3bb2fb5b9ecdeebecaded4ac6e5af0f653be8867;hp=7c1eeab3648e3ee98360caf0efb86b40a2bfc51f;hpb=3bd7a97d1b11a2b0aee086ef211cae807f3dfc35;p=sbcl.git diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 7c1eeab..2af538d 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -26,6 +26,9 @@ #include #include +#include +#include +#include #include "runtime.h" #include "sbcl.h" #include "os.h" @@ -36,11 +39,15 @@ #include "lispregs.h" #include "arch.h" #include "gc.h" -#include "gencgc.h" - -/* a function defined externally in assembly language, called from - * this file */ +#include "gc-internal.h" +#include "genesis/vector.h" +#include "genesis/weak-pointer.h" +#include "genesis/simple-fun.h" +#include "genesis/static-symbols.h" +#include "genesis/symbol.h" +/* assembly language stub that executes trap_PendingInterrupt */ void do_pending_interrupt(void); + /* * GC parameters @@ -76,19 +83,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. */ @@ -135,12 +130,14 @@ static 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 +149,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 +219,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 +248,6 @@ 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; /* * miscellaneous heap functions @@ -356,7 +357,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 +366,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 +448,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 +479,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; /* @@ -500,101 +494,16 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) && (alloc_region->free_pointer == alloc_region->end_addr)); 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; @@ -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,6 +559,7 @@ 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. */ @@ -655,8 +567,6 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) 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; } } @@ -732,12 +642,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; @@ -798,6 +707,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 +733,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 +785,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; } @@ -885,26 +797,17 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) 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); + 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 +827,28 @@ 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. */ + 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) @@ -1120,38 +935,131 @@ gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region) 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; } 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); + + /* 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_genration == 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 +1068,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 +1105,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); - - /* 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); - } + return gc_alloc_large(nbytes, ALLOC_BOXED, &boxed_region); + else + return gc_general_alloc(nbytes,ALLOC_BOXED,ALLOC_QUICK); } -static void * +static inline void * gc_alloc_unboxed(int nbytes) { - void *new_free_pointer; - - /* - FSHOW((stderr, "/gc_alloc_unboxed() %d\n", nbytes)); - */ + return gc_general_alloc(nbytes,ALLOC_UNBOXED,0); +} - /* Check whether there is room in the current region. */ - new_free_pointer = unboxed_region.free_pointer + nbytes; +static inline void * +gc_quick_alloc_unboxed(int nbytes) +{ + return gc_general_alloc(nbytes,ALLOC_UNBOXED,ALLOC_QUICK); +} - 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; +/* 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 object is returned. */ +static inline void * +gc_quick_alloc_large_unboxed(int nbytes) +{ + if (nbytes >= large_object_size) + 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 + */ - /* 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); +extern int (*scavtab[256])(lispobj *where, lispobj object); +extern lispobj (*transother[256])(lispobj object); +extern int (*sizetab[256])(lispobj *where); - /* 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 ... */ -} - -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); - } -} - -/* 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. */ -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); - } -} - -/* - * 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 = LowtagOf(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; -} - -/* 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 +1202,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 +1253,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 +1269,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 +1282,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; @@ -1549,7 +1292,7 @@ copy_large_object(lispobj object, int nwords) return(object); } else { /* Get tag of object. */ - tag = LowtagOf(object); + tag = lowtag_of(object); /* Allocate space. */ new = gc_quick_alloc_large(nwords*4); @@ -1572,7 +1315,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; @@ -1584,7 +1327,7 @@ copy_unboxed_object(lispobj object, int nwords) gc_assert((nwords & 0x01) == 0); /* Get tag of object. */ - tag = LowtagOf(object); + tag = lowtag_of(object); /* Allocate space. */ new = gc_quick_alloc_unboxed(nwords*4); @@ -1616,7 +1359,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; @@ -1713,7 +1456,7 @@ copy_large_unboxed_object(lispobj object, int nwords) } else { /* Get tag of object. */ - tag = LowtagOf(object); + tag = lowtag_of(object); /* Allocate space. */ new = gc_quick_alloc_large_unboxed(nwords*4); @@ -1734,107 +1477,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[TypeOf(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[TypeOf(object)])(object_ptr, object); - } - } - gc_assert(object_ptr == end); -} + + /* * code and code-related objects */ - -#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer) - -static lispobj trans_function_header(lispobj object); +/* +static lispobj trans_fun_header(lispobj object); static lispobj trans_boxed(lispobj object); - -static int -scav_function_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 (TypeOf(*first_pointer)) { - case type_FunctionHeader: - case type_ClosureFunctionHeader: - copy = trans_function_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. @@ -1857,15 +1511,6 @@ sniff_code_object(struct code *code, unsigned displacement) if (!check_code_fixups) return; - /* It's ok if it's byte compiled code. The trace table offset will - * be a fixnum if it's x86 compiled code - check. */ - if (code->trace_table_offset & 0x3) { - FSHOW((stderr, "/Sniffing byte compiled code object at %x.\n", code)); - return; - } - - /* Else it's x86 machine code. */ - ncode_words = fixnum_value(code->code_size); nheader_words = HeaderValue(*(lispobj *)code); nwords = ncode_words + nheader_words; @@ -2024,8 +1669,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; @@ -2034,14 +1679,6 @@ apply_code_fixups(struct code *old_code, struct code *new_code) unsigned displacement = (unsigned)new_code - (unsigned)old_code; struct vector *fixups_vector; - /* It's OK if it's byte compiled code. The trace table offset will - * be a fixnum if it's x86 compiled code - check. */ - if (new_code->trace_table_offset & 0x3) { -/* FSHOW((stderr, "/byte compiled code object at %x\n", new_code)); */ - return; - } - - /* Else it's x86 machine code. */ ncode_words = fixnum_value(new_code->code_size); nheader_words = HeaderValue(*(lispobj *)new_code); nwords = ncode_words + nheader_words; @@ -2067,7 +1704,7 @@ apply_code_fixups(struct code *old_code, struct code *new_code) /* It will be 0 or the unbound-marker if there are no fixups, and * will be an other pointer if it is valid. */ - if ((fixups == 0) || (fixups == type_UnboundMarker) || + if ((fixups == 0) || (fixups == UNBOUND_MARKER_WIDETAG) || !is_lisp_pointer(fixups)) { /* Check for possible errors. */ if (check_code_fixups) @@ -2095,7 +1732,8 @@ apply_code_fixups(struct code *old_code, struct code *new_code) /*SHOW("got fixups");*/ - if (TypeOf(fixups_vector->header) == type_SimpleArrayUnsignedByte32) { + if (widetag_of(fixups_vector->header) == + SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) { /* Got the fixups for the code block. Now work through the vector, and apply a fixup at each address. */ int length = fixnum_value(fixups_vector->length); @@ -2128,588 +1766,47 @@ 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(TypeOf(code->header) == type_CodeHeader); - - /* Prepare to transport the code vector. */ - l_code = (lispobj) code | type_OtherPointer; - - 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 function *fheaderp, *nfheaderp; - lispobj nfheaderl; - - fheaderp = (struct function *) native_pointer(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); - - /* Calculate the new function pointer and the new */ - /* function header. */ - nfheaderl = fheaderl + displacement; - nfheaderp = (struct function *) native_pointer(nfheaderl); - - /* Set forwarding pointer. */ - ((lispobj *)fheaderp)[0] = 0x01; - ((lispobj *)fheaderp)[1] = nfheaderl; - - /* Fix self pointer. */ - nfheaderp->self = nfheaderl + RAW_ADDR_OFFSET; - - *prev_pointer = nfheaderl; - - fheaderl = fheaderp->next; - prev_pointer = &nfheaderp->next; - } - - /* sniff_code_object(new_code,displacement);*/ - 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 function *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 function *) native_pointer(entry_point); - gc_assert(TypeOf(function_ptr->header) == type_FunctionHeader); - - 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 | type_OtherPointer; -} + 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 function *return_pc; - unsigned long offset; - struct code *code, *ncode; - - SHOW("/trans_return_pc_header: Will this work?"); - - return_pc = (struct function *) 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) | type_OtherPointer; -} + 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->function - RAW_ADDR_OFFSET; - scavenge(&fun, 1); - /* The function may have moved so update the raw address. But - * don't write unnecessarily. */ - if (closure->function != fun + RAW_ADDR_OFFSET) - closure->function = fun + RAW_ADDR_OFFSET; - - return 2; -} -#endif + header = *((lispobj *) native_pointer(object)); + length = HeaderValue(header) + 1; + length = CEILING(length, 2); -static int -scav_function_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_function_header(lispobj object) -{ - struct function *fheader; - unsigned long offset; - struct code *code, *ncode; - - fheader = (struct function *) 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) | type_FunctionPointer; -} /* - * 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); - -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 | LowtagOf(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 (LowtagOf(cdr) != type_ListPointer || !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 | LowtagOf(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[TypeOf(*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->function, fdefn->raw_addr)); */ - - if ((char *)(fdefn->function + 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->function + RAW_ADDR_OFFSET)) - fdefn->raw_addr = (char *)(fdefn->function + 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; +/* FIXME: What does this mean? */ +int gencgc_hash = 1; static int scav_vector(lispobj *where, lispobj object) @@ -2734,7 +1831,8 @@ scav_vector(lispobj *where, lispobj object) if (!gencgc_hash) { /* This is set for backward compatibility. FIXME: Do we need * this any more? */ - *where = (subtype_VectorMustRehash << type_Bits) | type_SimpleVector; + *where = + (subtype_VectorMustRehash<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 type_SimpleArrayLongFloat -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 type_SimpleArrayComplexSingleFloat -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 type_SimpleArrayComplexDoubleFloat -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 + if (is_lisp_pointer(hash_vector_obj) && + (widetag_of(*(lispobj *)native_pointer(hash_vector_obj)) + == SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG)) { + hash_vector = ((unsigned int *)native_pointer(hash_vector_obj)) + 2; + /*FSHOW((stderr, "/hash_vector = %x\n", hash_vector));*/ + gc_assert(fixnum_value(((unsigned int *)native_pointer(hash_vector_obj))[1]) + == next_vector_length); + } else { + hash_vector = NULL; + /*FSHOW((stderr, "/no hash_vector: %x\n", hash_vector_obj));*/ + } + } + /* These lengths could be different as the index_vector can be a + * different length from the others, a larger index_vector could help + * reduce collisions. */ + gc_assert(next_vector_length*2 == kv_length); -#ifdef type_SimpleArrayComplexLongFloat -static int -scav_vector_complex_long_float(lispobj *where, lispobj object) -{ - struct vector *vector; - int length, nwords; + /* now all set up.. */ - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 6 + 2, 2); + /* Work through the KV vector. */ + { + int i; + for (i = 1; i < next_vector_length; i++) { + lispobj old_key = kv_vector[2*i]; + unsigned int old_index = (old_key & 0x1fffffff)%length; - return nwords; -} + /* Scavenge the key and value. */ + scavenge(&kv_vector[2*i],2); -static lispobj -trans_vector_complex_long_float(lispobj object) -{ - struct vector *vector; - int length, nwords; + /* Check whether the key has moved and is EQ based. */ + { + lispobj new_key = kv_vector[2*i]; + unsigned int new_index = (new_key & 0x1fffffff)%length; - gc_assert(is_lisp_pointer(object)); + if ((old_index != new_index) && + ((!hash_vector) || (hash_vector[i] == 0x80000000)) && + ((new_key != empty_symbol) || + (kv_vector[2*i] != empty_symbol))) { - vector = (struct vector *) native_pointer(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 6 + 2, 2); + /*FSHOW((stderr, + "* EQ key %d moved from %x to %x; index %d to %d\n", + i, old_key, new_key, old_index, new_index));*/ - return copy_large_unboxed_object(object, nwords); -} + if (index_vector[old_index] != 0) { + /*FSHOW((stderr, "/P1 %d\n", index_vector[old_index]));*/ -static int -size_vector_complex_long_float(lispobj *where) -{ - struct vector *vector; - int length, nwords; + /* Unlink the key from the old_index chain. */ + if (index_vector[old_index] == i) { + /*FSHOW((stderr, "/P2a %d\n", next_vector[i]));*/ + index_vector[old_index] = next_vector[i]; + /* Link it into the needing rehash chain. */ + next_vector[i] = fixnum_value(hash_table[11]); + hash_table[11] = make_fixnum(i); + /*SHOW("P2");*/ + } else { + unsigned prior = index_vector[old_index]; + unsigned next = next_vector[prior]; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 6 + 2, 2); + /*FSHOW((stderr, "/P3a %d %d\n", prior, next));*/ - return nwords; + while (next != 0) { + /*FSHOW((stderr, "/P3b %d %d\n", prior, next));*/ + if (next == i) { + /* Unlink it. */ + next_vector[prior] = next_vector[next]; + /* Link it into the needing rehash + * chain. */ + next_vector[next] = + fixnum_value(hash_table[11]); + hash_table[11] = make_fixnum(next); + /*SHOW("/P3");*/ + break; + } + prior = next; + next = next_vector[next]; + } + } + } + } + } + } + } + return (CEILING(kv_length + 2, 2)); } -#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) @@ -3484,363 +2051,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); - - /* - FSHOW((stderr, "/weak pointer at 0x%08x\n", (unsigned long) wp)); - FSHOW((stderr, "/value: 0x%08x\n", (unsigned long) 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. */ - SHOW("broken"); - wp->value = NIL; - wp->broken = T; - } - } - } -} - -/* - * initialization - */ - -static int -scav_lose(lispobj *where, lispobj object) -{ - lose("no scavenge function for object 0x%08x", (unsigned long) 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", (unsigned long) 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", (unsigned long) 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 low 3 bits of the tag - * alone, set multiple entries in our 8-bit scavenge table (one for each - * possible value of the high 5 bits). */ - for (i = 0; i < 32; i++) { /* FIXME: bare constant length, ick! */ - scavtab[type_EvenFixnum|(i<<3)] = scav_immediate; - scavtab[type_FunctionPointer|(i<<3)] = scav_function_pointer; - /* OtherImmediate0 */ - scavtab[type_ListPointer|(i<<3)] = scav_list_pointer; - scavtab[type_OddFixnum|(i<<3)] = scav_immediate; - scavtab[type_InstancePointer|(i<<3)] = scav_instance_pointer; - /* OtherImmediate1 */ - scavtab[type_OtherPointer|(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[type_Bignum] = scav_unboxed; - scavtab[type_Ratio] = scav_boxed; - scavtab[type_SingleFloat] = scav_unboxed; - scavtab[type_DoubleFloat] = scav_unboxed; -#ifdef type_LongFloat - scavtab[type_LongFloat] = scav_unboxed; -#endif - scavtab[type_Complex] = scav_boxed; -#ifdef type_ComplexSingleFloat - scavtab[type_ComplexSingleFloat] = scav_unboxed; -#endif -#ifdef type_ComplexDoubleFloat - scavtab[type_ComplexDoubleFloat] = scav_unboxed; -#endif -#ifdef type_ComplexLongFloat - scavtab[type_ComplexLongFloat] = scav_unboxed; -#endif - scavtab[type_SimpleArray] = scav_boxed; - scavtab[type_SimpleString] = scav_string; - scavtab[type_SimpleBitVector] = scav_vector_bit; - scavtab[type_SimpleVector] = scav_vector; - scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2; - scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4; - scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8; - scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16; - scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32; -#ifdef type_SimpleArraySignedByte8 - scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8; -#endif -#ifdef type_SimpleArraySignedByte16 - scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16; -#endif -#ifdef type_SimpleArraySignedByte30 - scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32; -#endif -#ifdef type_SimpleArraySignedByte32 - scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32; -#endif - scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float; - scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float; -#ifdef type_SimpleArrayLongFloat - scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float; -#endif -#ifdef type_SimpleArrayComplexSingleFloat - scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float; -#endif -#ifdef type_SimpleArrayComplexDoubleFloat - scavtab[type_SimpleArrayComplexDoubleFloat] = scav_vector_complex_double_float; -#endif -#ifdef type_SimpleArrayComplexLongFloat - scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float; -#endif - scavtab[type_ComplexString] = scav_boxed; - scavtab[type_ComplexBitVector] = scav_boxed; - scavtab[type_ComplexVector] = scav_boxed; - scavtab[type_ComplexArray] = scav_boxed; - scavtab[type_CodeHeader] = scav_code_header; - /*scavtab[type_FunctionHeader] = scav_function_header;*/ - /*scavtab[type_ClosureFunctionHeader] = scav_function_header;*/ - /*scavtab[type_ReturnPcHeader] = scav_return_pc_header;*/ -#ifdef __i386__ - scavtab[type_ClosureHeader] = scav_closure_header; - scavtab[type_FuncallableInstanceHeader] = scav_closure_header; - scavtab[type_ByteCodeFunction] = scav_closure_header; - scavtab[type_ByteCodeClosure] = scav_closure_header; -#else - scavtab[type_ClosureHeader] = scav_boxed; - scavtab[type_FuncallableInstanceHeader] = scav_boxed; - scavtab[type_ByteCodeFunction] = scav_boxed; - scavtab[type_ByteCodeClosure] = scav_boxed; -#endif - scavtab[type_ValueCellHeader] = scav_boxed; - scavtab[type_SymbolHeader] = scav_boxed; - scavtab[type_BaseChar] = scav_immediate; - scavtab[type_Sap] = scav_unboxed; - scavtab[type_UnboundMarker] = scav_immediate; - scavtab[type_WeakPointer] = scav_weak_pointer; - scavtab[type_InstanceHeader] = scav_boxed; - scavtab[type_Fdefn] = scav_fdefn; - - /* transport other table, initialized same way as scavtab */ - for (i = 0; i < 256; i++) - transother[i] = trans_lose; - transother[type_Bignum] = trans_unboxed; - transother[type_Ratio] = trans_boxed; - transother[type_SingleFloat] = trans_unboxed; - transother[type_DoubleFloat] = trans_unboxed; -#ifdef type_LongFloat - transother[type_LongFloat] = trans_unboxed; -#endif - transother[type_Complex] = trans_boxed; -#ifdef type_ComplexSingleFloat - transother[type_ComplexSingleFloat] = trans_unboxed; -#endif -#ifdef type_ComplexDoubleFloat - transother[type_ComplexDoubleFloat] = trans_unboxed; -#endif -#ifdef type_ComplexLongFloat - transother[type_ComplexLongFloat] = trans_unboxed; -#endif - transother[type_SimpleArray] = trans_boxed_large; - transother[type_SimpleString] = trans_string; - transother[type_SimpleBitVector] = trans_vector_bit; - transother[type_SimpleVector] = trans_vector; - transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2; - transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4; - transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8; - transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16; - transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32; -#ifdef type_SimpleArraySignedByte8 - transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8; -#endif -#ifdef type_SimpleArraySignedByte16 - transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16; -#endif -#ifdef type_SimpleArraySignedByte30 - transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32; -#endif -#ifdef type_SimpleArraySignedByte32 - transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32; -#endif - transother[type_SimpleArraySingleFloat] = trans_vector_single_float; - transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float; -#ifdef type_SimpleArrayLongFloat - transother[type_SimpleArrayLongFloat] = trans_vector_long_float; -#endif -#ifdef type_SimpleArrayComplexSingleFloat - transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float; -#endif -#ifdef type_SimpleArrayComplexDoubleFloat - transother[type_SimpleArrayComplexDoubleFloat] = trans_vector_complex_double_float; -#endif -#ifdef type_SimpleArrayComplexLongFloat - transother[type_SimpleArrayComplexLongFloat] = trans_vector_complex_long_float; -#endif - transother[type_ComplexString] = trans_boxed; - transother[type_ComplexBitVector] = trans_boxed; - transother[type_ComplexVector] = trans_boxed; - transother[type_ComplexArray] = trans_boxed; - transother[type_CodeHeader] = trans_code_header; - transother[type_FunctionHeader] = trans_function_header; - transother[type_ClosureFunctionHeader] = trans_function_header; - transother[type_ReturnPcHeader] = trans_return_pc_header; - transother[type_ClosureHeader] = trans_boxed; - transother[type_FuncallableInstanceHeader] = trans_boxed; - transother[type_ByteCodeFunction] = trans_boxed; - transother[type_ByteCodeClosure] = trans_boxed; - transother[type_ValueCellHeader] = trans_boxed; - transother[type_SymbolHeader] = trans_boxed; - transother[type_BaseChar] = trans_immediate; - transother[type_Sap] = trans_unboxed; - transother[type_UnboundMarker] = trans_immediate; - transother[type_WeakPointer] = trans_weak_pointer; - transother[type_InstanceHeader] = trans_boxed; - transother[type_Fdefn] = 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[type_EvenFixnum|(i<<3)] = size_immediate; - sizetab[type_FunctionPointer|(i<<3)] = size_pointer; - /* OtherImmediate0 */ - sizetab[type_ListPointer|(i<<3)] = size_pointer; - sizetab[type_OddFixnum|(i<<3)] = size_immediate; - sizetab[type_InstancePointer|(i<<3)] = size_pointer; - /* OtherImmediate1 */ - sizetab[type_OtherPointer|(i<<3)] = size_pointer; - } - sizetab[type_Bignum] = size_unboxed; - sizetab[type_Ratio] = size_boxed; - sizetab[type_SingleFloat] = size_unboxed; - sizetab[type_DoubleFloat] = size_unboxed; -#ifdef type_LongFloat - sizetab[type_LongFloat] = size_unboxed; -#endif - sizetab[type_Complex] = size_boxed; -#ifdef type_ComplexSingleFloat - sizetab[type_ComplexSingleFloat] = size_unboxed; -#endif -#ifdef type_ComplexDoubleFloat - sizetab[type_ComplexDoubleFloat] = size_unboxed; -#endif -#ifdef type_ComplexLongFloat - sizetab[type_ComplexLongFloat] = size_unboxed; -#endif - sizetab[type_SimpleArray] = size_boxed; - sizetab[type_SimpleString] = size_string; - sizetab[type_SimpleBitVector] = size_vector_bit; - sizetab[type_SimpleVector] = size_vector; - sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2; - sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4; - sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8; - sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16; - sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32; -#ifdef type_SimpleArraySignedByte8 - sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8; -#endif -#ifdef type_SimpleArraySignedByte16 - sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16; -#endif -#ifdef type_SimpleArraySignedByte30 - sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32; -#endif -#ifdef type_SimpleArraySignedByte32 - sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32; -#endif - sizetab[type_SimpleArraySingleFloat] = size_vector_single_float; - sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float; -#ifdef type_SimpleArrayLongFloat - sizetab[type_SimpleArrayLongFloat] = size_vector_long_float; -#endif -#ifdef type_SimpleArrayComplexSingleFloat - sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float; -#endif -#ifdef type_SimpleArrayComplexDoubleFloat - sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float; -#endif -#ifdef type_SimpleArrayComplexLongFloat - sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float; -#endif - sizetab[type_ComplexString] = size_boxed; - sizetab[type_ComplexBitVector] = size_boxed; - sizetab[type_ComplexVector] = size_boxed; - sizetab[type_ComplexArray] = size_boxed; - sizetab[type_CodeHeader] = size_code_header; -#if 0 - /* We shouldn't see these, so just lose if it happens. */ - sizetab[type_FunctionHeader] = size_function_header; - sizetab[type_ClosureFunctionHeader] = size_function_header; - sizetab[type_ReturnPcHeader] = size_return_pc_header; -#endif - sizetab[type_ClosureHeader] = size_boxed; - sizetab[type_FuncallableInstanceHeader] = size_boxed; - sizetab[type_ValueCellHeader] = size_boxed; - sizetab[type_SymbolHeader] = size_boxed; - sizetab[type_BaseChar] = size_immediate; - sizetab[type_Sap] = size_unboxed; - sizetab[type_UnboundMarker] = size_immediate; - sizetab[type_WeakPointer] = size_weak_pointer; - sizetab[type_InstanceHeader] = size_boxed; - sizetab[type_Fdefn] = size_boxed; -} /* Scan an area looking for an object which encloses the given pointer. * Return the object start on success or NULL on failure. */ @@ -3854,11 +2064,11 @@ search_space(lispobj *start, size_t words, lispobj *pointer) /* If thing is an immediate then this is a cons. */ if (is_lisp_pointer(thing) || ((thing & 3) == 0) /* fixnum */ - || (TypeOf(thing) == type_BaseChar) - || (TypeOf(thing) == type_UnboundMarker)) + || (widetag_of(thing) == BASE_CHAR_WIDETAG) + || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG)) count = 2; else - count = (sizetab[TypeOf(thing)])(start); + count = (sizetab[widetag_of(thing)])(start); /* Check whether the pointer is within this object. */ if ((pointer >= start) && (pointer < (start+count))) { @@ -3928,7 +2138,7 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) /* We need to allow raw pointers into Code objects for return * addresses. This will also pick up pointers to functions in code * objects. */ - if (TypeOf(*start_addr) == type_CodeHeader) { + if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) { /* XXX could do some further checks here */ return 1; } @@ -3956,20 +2166,18 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) * 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 (LowtagOf((lispobj)pointer)) { - case type_FunctionPointer: + switch (lowtag_of((lispobj)pointer)) { + case FUN_POINTER_LOWTAG: /* Start_addr should be the enclosing code object, or a closure * header. */ - switch (TypeOf(*start_addr)) { - case type_CodeHeader: + switch (widetag_of(*start_addr)) { + case CODE_HEADER_WIDETAG: /* This case is probably caught above. */ break; - case type_ClosureHeader: - case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: + case CLOSURE_HEADER_WIDETAG: + case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: if ((unsigned)pointer != - ((unsigned)start_addr+type_FunctionPointer)) { + ((unsigned)start_addr+FUN_POINTER_LOWTAG)) { if (gencgc_verbose) FSHOW((stderr, "/Wf2: %x %x %x\n", @@ -3985,9 +2193,9 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) return 0; } break; - case type_ListPointer: + case LIST_POINTER_LOWTAG: if ((unsigned)pointer != - ((unsigned)start_addr+type_ListPointer)) { + ((unsigned)start_addr+LIST_POINTER_LOWTAG)) { if (gencgc_verbose) FSHOW((stderr, "/Wl1: %x %x %x\n", @@ -3997,12 +2205,12 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) /* Is it plausible cons? */ if ((is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0) /* fixnum */ - || (TypeOf(start_addr[0]) == type_BaseChar) - || (TypeOf(start_addr[0]) == type_UnboundMarker)) + || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG) + || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG)) && (is_lisp_pointer(start_addr[1]) || ((start_addr[1] & 3) == 0) /* fixnum */ - || (TypeOf(start_addr[1]) == type_BaseChar) - || (TypeOf(start_addr[1]) == type_UnboundMarker))) + || (widetag_of(start_addr[1]) == BASE_CHAR_WIDETAG) + || (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG))) break; else { if (gencgc_verbose) @@ -4011,16 +2219,16 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) pointer, start_addr, *start_addr)); return 0; } - case type_InstancePointer: + case INSTANCE_POINTER_LOWTAG: if ((unsigned)pointer != - ((unsigned)start_addr+type_InstancePointer)) { + ((unsigned)start_addr+INSTANCE_POINTER_LOWTAG)) { if (gencgc_verbose) FSHOW((stderr, "/Wi1: %x %x %x\n", pointer, start_addr, *start_addr)); return 0; } - if (TypeOf(start_addr[0]) != type_InstanceHeader) { + if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) { if (gencgc_verbose) FSHOW((stderr, "/Wi2: %x %x %x\n", @@ -4028,9 +2236,9 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) return 0; } break; - case type_OtherPointer: + case OTHER_POINTER_LOWTAG: if ((unsigned)pointer != - ((int)start_addr+type_OtherPointer)) { + ((int)start_addr+OTHER_POINTER_LOWTAG)) { if (gencgc_verbose) FSHOW((stderr, "/Wo1: %x %x %x\n", @@ -4045,9 +2253,9 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) pointer, start_addr, *start_addr)); return 0; } - switch (TypeOf(start_addr[0])) { - case type_UnboundMarker: - case type_BaseChar: + switch (widetag_of(start_addr[0])) { + case UNBOUND_MARKER_WIDETAG: + case BASE_CHAR_WIDETAG: if (gencgc_verbose) FSHOW((stderr, "*Wo3: %x %x %x\n", @@ -4055,17 +2263,15 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) return 0; /* only pointed to by function pointers? */ - case type_ClosureHeader: - case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: + case CLOSURE_HEADER_WIDETAG: + case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: if (gencgc_verbose) FSHOW((stderr, "*Wo4: %x %x %x\n", pointer, start_addr, *start_addr)); return 0; - case type_InstanceHeader: + case INSTANCE_HEADER_WIDETAG: if (gencgc_verbose) FSHOW((stderr, "*Wo5: %x %x %x\n", @@ -4073,68 +2279,68 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) return 0; /* the valid other immediate pointer objects */ - case type_SimpleVector: - case type_Ratio: - case type_Complex: -#ifdef type_ComplexSingleFloat - case type_ComplexSingleFloat: + case SIMPLE_VECTOR_WIDETAG: + case RATIO_WIDETAG: + case COMPLEX_WIDETAG: +#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG + case COMPLEX_SINGLE_FLOAT_WIDETAG: #endif -#ifdef type_ComplexDoubleFloat - case type_ComplexDoubleFloat: +#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG + case COMPLEX_DOUBLE_FLOAT_WIDETAG: #endif -#ifdef type_ComplexLongFloat - case type_ComplexLongFloat: +#ifdef COMPLEX_LONG_FLOAT_WIDETAG + case COMPLEX_LONG_FLOAT_WIDETAG: #endif - case type_SimpleArray: - case type_ComplexString: - case type_ComplexBitVector: - case type_ComplexVector: - case type_ComplexArray: - case type_ValueCellHeader: - case type_SymbolHeader: - case type_Fdefn: - case type_CodeHeader: - case type_Bignum: - case type_SingleFloat: - case type_DoubleFloat: -#ifdef type_LongFloat - case type_LongFloat: + case SIMPLE_ARRAY_WIDETAG: + case COMPLEX_STRING_WIDETAG: + case COMPLEX_BIT_VECTOR_WIDETAG: + case COMPLEX_VECTOR_WIDETAG: + case COMPLEX_ARRAY_WIDETAG: + case VALUE_CELL_HEADER_WIDETAG: + case SYMBOL_HEADER_WIDETAG: + case FDEFN_WIDETAG: + case CODE_HEADER_WIDETAG: + case BIGNUM_WIDETAG: + case SINGLE_FLOAT_WIDETAG: + case DOUBLE_FLOAT_WIDETAG: +#ifdef LONG_FLOAT_WIDETAG + case LONG_FLOAT_WIDETAG: #endif - case type_SimpleString: - case type_SimpleBitVector: - case type_SimpleArrayUnsignedByte2: - case type_SimpleArrayUnsignedByte4: - case type_SimpleArrayUnsignedByte8: - case type_SimpleArrayUnsignedByte16: - case type_SimpleArrayUnsignedByte32: -#ifdef type_SimpleArraySignedByte8 - case type_SimpleArraySignedByte8: + case SIMPLE_STRING_WIDETAG: + case SIMPLE_BIT_VECTOR_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: #endif -#ifdef type_SimpleArraySignedByte16 - case type_SimpleArraySignedByte16: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG: #endif -#ifdef type_SimpleArraySignedByte30 - case type_SimpleArraySignedByte30: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG: #endif -#ifdef type_SimpleArraySignedByte32 - case type_SimpleArraySignedByte32: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG: #endif - case type_SimpleArraySingleFloat: - case type_SimpleArrayDoubleFloat: -#ifdef type_SimpleArrayLongFloat - case type_SimpleArrayLongFloat: + case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG: + case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG: +#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG + case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG: #endif -#ifdef type_SimpleArrayComplexSingleFloat - case type_SimpleArrayComplexSingleFloat: +#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG + case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG: #endif -#ifdef type_SimpleArrayComplexDoubleFloat - case type_SimpleArrayComplexDoubleFloat: +#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG + case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG: #endif -#ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayComplexLongFloat: +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG + case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG: #endif - case type_Sap: - case type_WeakPointer: + case SAP_WIDETAG: + case WEAK_POINTER_WIDETAG: break; default: @@ -4178,43 +2384,43 @@ maybe_adjust_large_object(lispobj *where) int boxed; /* Check whether it's a vector or bignum object. */ - switch (TypeOf(where[0])) { - case type_SimpleVector: + switch (widetag_of(where[0])) { + case SIMPLE_VECTOR_WIDETAG: boxed = BOXED_PAGE; break; - case type_Bignum: - case type_SimpleString: - case type_SimpleBitVector: - case type_SimpleArrayUnsignedByte2: - case type_SimpleArrayUnsignedByte4: - case type_SimpleArrayUnsignedByte8: - case type_SimpleArrayUnsignedByte16: - case type_SimpleArrayUnsignedByte32: -#ifdef type_SimpleArraySignedByte8 - case type_SimpleArraySignedByte8: + case BIGNUM_WIDETAG: + case SIMPLE_STRING_WIDETAG: + case SIMPLE_BIT_VECTOR_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: #endif -#ifdef type_SimpleArraySignedByte16 - case type_SimpleArraySignedByte16: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG: #endif -#ifdef type_SimpleArraySignedByte30 - case type_SimpleArraySignedByte30: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG: #endif -#ifdef type_SimpleArraySignedByte32 - case type_SimpleArraySignedByte32: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG: #endif - case type_SimpleArraySingleFloat: - case type_SimpleArrayDoubleFloat: -#ifdef type_SimpleArrayLongFloat - case type_SimpleArrayLongFloat: + case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG: + case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG: +#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG + case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG: #endif -#ifdef type_SimpleArrayComplexSingleFloat - case type_SimpleArrayComplexSingleFloat: +#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG + case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG: #endif -#ifdef type_SimpleArrayComplexDoubleFloat - case type_SimpleArrayComplexDoubleFloat: +#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG + case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG: #endif -#ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayComplexLongFloat: +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG + case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG: #endif boxed = UNBOXED_PAGE; break; @@ -4223,7 +2429,7 @@ maybe_adjust_large_object(lispobj *where) } /* Find its current size. */ - nwords = (sizetab[TypeOf(where[0])])(where); + nwords = (sizetab[widetag_of(where[0])])(where); first_page = find_page_index((void *)where); gc_assert(first_page >= 0); @@ -4337,7 +2543,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; @@ -4356,13 +2562,20 @@ preserve_pointer(void *addr) * expensive but important, since it vastly reduces the * probability that random garbage will be bogusly interpreter 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. */ @@ -4457,7 +2670,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 @@ -4545,7 +2758,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; @@ -4564,7 +2777,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)) @@ -4662,8 +2875,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) @@ -4686,7 +2899,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)) @@ -4751,8 +2964,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; @@ -4769,8 +2981,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; @@ -4817,8 +3028,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 { @@ -4830,13 +3040,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; @@ -5058,9 +3266,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 @@ -5072,37 +3288,35 @@ verify_space(lispobj *start, size_t words) if (thing & 0x3) { /* Skip fixnums. FIXME: There should be an * is_fixnum for this. */ - switch(TypeOf(*start)) { + switch(widetag_of(*start)) { /* boxed objects */ - case type_SimpleVector: - case type_Ratio: - case type_Complex: - case type_SimpleArray: - case type_ComplexString: - case type_ComplexBitVector: - case type_ComplexVector: - case type_ComplexArray: - case type_ClosureHeader: - case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: - case type_ValueCellHeader: - case type_SymbolHeader: - case type_BaseChar: - case type_UnboundMarker: - case type_InstanceHeader: - case type_Fdefn: + case SIMPLE_VECTOR_WIDETAG: + case RATIO_WIDETAG: + case COMPLEX_WIDETAG: + case SIMPLE_ARRAY_WIDETAG: + case COMPLEX_STRING_WIDETAG: + case COMPLEX_BIT_VECTOR_WIDETAG: + case COMPLEX_VECTOR_WIDETAG: + case COMPLEX_ARRAY_WIDETAG: + case CLOSURE_HEADER_WIDETAG: + case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: + case VALUE_CELL_HEADER_WIDETAG: + case SYMBOL_HEADER_WIDETAG: + case BASE_CHAR_WIDETAG: + case UNBOUND_MARKER_WIDETAG: + case INSTANCE_HEADER_WIDETAG: + case FDEFN_WIDETAG: count = 1; break; - case type_CodeHeader: + case CODE_HEADER_WIDETAG: { lispobj object = *start; struct code *code; int nheader_words, ncode_words, nwords; lispobj fheaderl; - struct function *fheaderp; + struct simple_fun *fheaderp; code = (struct code *) start; @@ -5112,7 +3326,13 @@ verify_space(lispobj *start, size_t words) if (is_in_dynamic_space /* It's ok if it's byte compiled code. The trace * table offset will be a fixnum if it's x86 - * compiled code - check. */ + * compiled code - check. + * + * FIXME: #^#@@! lack of abstraction here.. + * This line can probably go away now that + * there's no byte compiler, but I've got + * too much to worry about right now to try + * to make sure. -- WHN 2001-10-06 */ && !(code->trace_table_offset & 0x3) /* Only when enabled */ && verify_dynamic_code_check) { @@ -5128,12 +3348,13 @@ verify_space(lispobj *start, size_t words) /* Scavenge the boxed section of the code data block */ verify_space(start + 1, nheader_words - 1); - /* Scavenge the boxed section of each function object in - * the code data block. */ + /* Scavenge the boxed section of each function + * object in the code data block. */ fheaderl = code->entry_points; while (fheaderl != NIL) { - fheaderp = (struct function *) native_pointer(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + fheaderp = + (struct simple_fun *) native_pointer(fheaderl); + gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG); verify_space(&fheaderp->name, 1); verify_space(&fheaderp->arglist, 1); verify_space(&fheaderp->type, 1); @@ -5144,57 +3365,57 @@ verify_space(lispobj *start, size_t words) } /* unboxed objects */ - case type_Bignum: - case type_SingleFloat: - case type_DoubleFloat: -#ifdef type_ComplexLongFloat - case type_LongFloat: + case BIGNUM_WIDETAG: + case SINGLE_FLOAT_WIDETAG: + case DOUBLE_FLOAT_WIDETAG: +#ifdef COMPLEX_LONG_FLOAT_WIDETAG + case LONG_FLOAT_WIDETAG: #endif -#ifdef type_ComplexSingleFloat - case type_ComplexSingleFloat: +#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG + case COMPLEX_SINGLE_FLOAT_WIDETAG: #endif -#ifdef type_ComplexDoubleFloat - case type_ComplexDoubleFloat: +#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG + case COMPLEX_DOUBLE_FLOAT_WIDETAG: #endif -#ifdef type_ComplexLongFloat - case type_ComplexLongFloat: +#ifdef COMPLEX_LONG_FLOAT_WIDETAG + case COMPLEX_LONG_FLOAT_WIDETAG: #endif - case type_SimpleString: - case type_SimpleBitVector: - case type_SimpleArrayUnsignedByte2: - case type_SimpleArrayUnsignedByte4: - case type_SimpleArrayUnsignedByte8: - case type_SimpleArrayUnsignedByte16: - case type_SimpleArrayUnsignedByte32: -#ifdef type_SimpleArraySignedByte8 - case type_SimpleArraySignedByte8: + case SIMPLE_STRING_WIDETAG: + case SIMPLE_BIT_VECTOR_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: #endif -#ifdef type_SimpleArraySignedByte16 - case type_SimpleArraySignedByte16: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG: #endif -#ifdef type_SimpleArraySignedByte30 - case type_SimpleArraySignedByte30: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG: #endif -#ifdef type_SimpleArraySignedByte32 - case type_SimpleArraySignedByte32: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG: #endif - case type_SimpleArraySingleFloat: - case type_SimpleArrayDoubleFloat: -#ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayLongFloat: + case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG: + case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG: +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG + case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG: #endif -#ifdef type_SimpleArrayComplexSingleFloat - case type_SimpleArrayComplexSingleFloat: +#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG + case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG: #endif -#ifdef type_SimpleArrayComplexDoubleFloat - case type_SimpleArrayComplexDoubleFloat: +#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG + case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG: #endif -#ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayComplexLongFloat: +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG + case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG: #endif - case type_Sap: - case type_WeakPointer: - count = (sizetab[TypeOf(*start)])(start); + case SAP_WIDETAG: + case WEAK_POINTER_WIDETAG: + count = (sizetab[widetag_of(*start)])(start); break; default: @@ -5308,13 +3529,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 @@ -5512,8 +3729,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; @@ -5527,8 +3743,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(); @@ -5589,14 +3804,15 @@ update_x86_dynamic_space_free_pointer(void) 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) { @@ -5605,8 +3821,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) { @@ -5617,12 +3831,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); } @@ -5710,13 +3923,6 @@ collect_garbage(unsigned last_gen) 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; - SHOW("returning from collect_garbage"); } @@ -5793,27 +3999,13 @@ 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 + + gc_set_region_empty(&boxed_region); + gc_set_region_empty(&unboxed_region); last_free_page = 0; SetSymbolValue(ALLOCATION_POINTER, (lispobj)((char *)heap_base)); - current_region_free_pointer = boxed_region.free_pointer; - current_region_end_addr = boxed_region.end_addr; - if (verify_after_free_heap) { /* Check whether purify has left any bad pointers. */ if (gencgc_verbose) @@ -5828,6 +4020,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; @@ -5861,25 +4056,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. @@ -5887,7 +4070,7 @@ 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; @@ -5909,13 +4092,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 @@ -5926,151 +4114,46 @@ 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 alloc_region *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; - } - - return result; + /* At this point we should either be in pseudo-atomic, or early + * enough in cold initn that interrupts are not yet enabled anyway. + * It would be nice to assert same. + */ + gc_assert(SymbolValue(PSEUDO_ATOMIC_ATOMIC)); + + /* 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 */ + } + + /* 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) { + auto_gc_trigger *= 2; + /* set things up so that GC happens when we finish the PA + * section. */ + maybe_gc_pending=1; + SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1)); } + new_obj = gc_alloc_with_region(nbytes,0,region,0); + return (new_obj); } + /* * noise to manipulate the gc trigger stuff @@ -6104,7 +4187,7 @@ component_ptr_from_pc(lispobj *pc) object = search_dynamic_space(pc); if (object) /* if we found something */ - if (TypeOf(*object) == type_CodeHeader) /* if it's a code object */ + if (widetag_of(*object) == CODE_HEADER_WIDETAG) /* if it's a code object */ return(object); return (NULL); @@ -6126,6 +4209,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) { @@ -6171,3 +4255,20 @@ gencgc_handle_wp_violation(void* fault_addr) void unhandled_sigmemoryfault() {} + +gc_alloc_update_all_page_tables(void) +{ + /* Flush the alloc regions updating the tables. */ + 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); +} +