X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;h=a90c60df42548bb3c756aa5215b7b780e29e1975;hb=23f1e2ef66bcc31ca7ea765a82a97998119aa4d5;hp=a4766868b8b82d50ea1bab3e3a23d9ae902c8684;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index a476686..a90c60d 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -14,10 +14,6 @@ */ /* - * $Header$ - */ - -/* * For a review of garbage collection techniques (e.g. generational * GC) and terminology (e.g. "scavenging") see Paul R. Wilson, * "Uniprocessor Garbage Collection Techniques". As of 20000618, this @@ -28,22 +24,17 @@ * . */ -/* - * FIXME: GC :FULL T seems to be unable to recover a lot of unused - * space. After cold init is complete, GC :FULL T gets us down to - * about 44 Mb total used, but PURIFY gets us down to about 17 Mb - * total used. - */ - #include #include #include "runtime.h" #include "sbcl.h" #include "os.h" +#include "interr.h" #include "globals.h" #include "interrupt.h" #include "validate.h" #include "lispregs.h" +#include "arch.h" #include "gc.h" #include "gencgc.h" @@ -56,8 +47,8 @@ void do_pending_interrupt(void); */ /* the number of actual generations. (The number of 'struct - * generation' objects is one more than this, because one serves as - * scratch when GC'ing.) */ + * generation' objects is one more than this, because one object + * serves as scratch when GC'ing.) */ #define NUM_GENERATIONS 6 /* Should we use page protection to help avoid the scavenging of pages @@ -66,10 +57,13 @@ boolean enable_page_protection = 1; /* Should we unmap a page and re-mmap it to have it zero filled? */ #if defined(__FreeBSD__) || defined(__OpenBSD__) -/* Note: this can waste a lot of swap on FreeBSD so don't unmap there. +/* comment from cmucl-2.4.8: This can waste a lot of swap on FreeBSD + * so don't unmap there. * - * Presumably this behavior exists on OpenBSD too, so don't unmap - * there either. -- WHN 20000727 */ + * The CMU CL comment didn't specify a version, but was probably an + * old version of FreeBSD (pre-4.0), so this might no longer be true. + * OTOH, if it is true, this behavior might exist on OpenBSD too, so + * for now we don't unmap there either. -- WHN 2001-04-07 */ boolean gencgc_unmap_zero = 0; #else boolean gencgc_unmap_zero = 1; @@ -77,11 +71,6 @@ boolean gencgc_unmap_zero = 1; /* the minimum size (in bytes) for a large object*/ unsigned large_object_size = 4 * 4096; - -/* Should we filter stack/register pointers? This could reduce the - * number of invalid pointers accepted. KLUDGE: It will probably - * degrades interrupt safety during object initialization. */ -boolean enable_pointer_filter = 1; /* * debugging @@ -164,8 +153,8 @@ struct page page_table[NUM_PAGES]; static void *heap_base = NULL; /* Calculate the start address for the given page number. */ -inline void -*page_address(int page_num) +inline void * +page_address(int page_num) { return (heap_base + (page_num * 4096)); } @@ -189,10 +178,10 @@ find_page_index(void *addr) /* a structure to hold the state of a generation */ struct generation { - /* the first page that gc_alloc checks on its next call */ + /* the first page that gc_alloc() checks on its next call */ int alloc_start_page; - /* the first page that gc_alloc_unboxed checks on its next call */ + /* the first page that gc_alloc_unboxed() checks on its next call */ int alloc_unboxed_start_page; /* the first page that gc_alloc_large (boxed) considers on its next @@ -269,28 +258,28 @@ static int count_write_protect_generation_pages(int generation) { int i; - int cnt = 0; + int count = 0; for (i = 0; i < last_free_page; i++) if ((page_table[i].allocated != FREE_PAGE) && (page_table[i].gen == generation) && (page_table[i].write_protected == 1)) - cnt++; - return(cnt); + count++; + return count; } -/* Count the number of pages within the given generation */ +/* Count the number of pages within the given generation. */ static int count_generation_pages(int generation) { int i; - int cnt = 0; + int count = 0; for (i = 0; i < last_free_page; i++) if ((page_table[i].allocated != 0) && (page_table[i].gen == generation)) - cnt++; - return(cnt); + count++; + return count; } /* Count the number of dont_move pages. */ @@ -298,23 +287,22 @@ static int count_dont_move_pages(void) { int i; - int cnt = 0; - - for (i = 0; i < last_free_page; i++) - if ((page_table[i].allocated != 0) - && (page_table[i].dont_move != 0)) - cnt++; - return(cnt); + int count = 0; + for (i = 0; i < last_free_page; i++) { + if ((page_table[i].allocated != 0) && (page_table[i].dont_move != 0)) { + ++count; + } + } + return count; } /* Work through the pages and add up the number of bytes used for the * given generation. */ static int -generation_bytes_allocated (int gen) +count_generation_bytes_allocated (int gen) { int i; int result = 0; - for (i = 0; i < last_free_page; i++) { if ((page_table[i].allocated != 0) && (page_table[i].gen == gen)) result += page_table[i].bytes_used; @@ -365,27 +353,30 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ for (j = 0; j < last_free_page; j++) if (page_table[j].gen == i) { + /* Count the number of boxed pages within the given - * generation */ - if (page_table[j].allocated == BOXED_PAGE) + * generation. */ + if (page_table[j].allocated == BOXED_PAGE) { if (page_table[j].large_object) large_boxed_cnt++; else boxed_cnt++; - + } + /* Count the number of unboxed pages within the given - * generation */ - if (page_table[j].allocated == UNBOXED_PAGE) + * generation. */ + if (page_table[j].allocated == UNBOXED_PAGE) { if (page_table[j].large_object) large_unboxed_cnt++; else unboxed_cnt++; + } } gc_assert(generations[i].bytes_allocated - == generation_bytes_allocated(i)); + == count_generation_bytes_allocated(i)); fprintf(stderr, - " %8d: %5d %5d %5d %5d %8d %5d %8d %4d %3d %7.4lf\n", + " %8d: %5d %5d %5d %5d %8d %5d %8d %4d %3d %7.4f\n", i, boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt, generations[i].bytes_allocated, @@ -396,7 +387,7 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ generations[i].num_gc, gen_av_mem_age(i)); } - fprintf(stderr," Total bytes allocated=%d\n", bytes_allocated); + fprintf(stderr," Total bytes allocated=%ld\n", bytes_allocated); fpu_restore(fpu_state); } @@ -470,7 +461,7 @@ static int gc_alloc_generation; * keeps the allocation contiguous when scavenging the newspace. * * The alloc_region should have been closed by a call to - * gc_alloc_update_page_tables, and will thus be in an empty state. + * gc_alloc_update_page_tables(), and will thus be in an empty state. * * To assist the scavenging functions write-protected pages are not * used. Free pages should not be write-protected. @@ -522,7 +513,10 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) 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. */ + * 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 && @@ -585,7 +579,7 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) /* 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", + "Argh! gc_alloc_new_region() failed on restart_page, nbytes=%d.\n", nbytes); print_generation_stats(1); lose(NULL); @@ -593,7 +587,7 @@ gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) /* FSHOW((stderr, - "/gc_alloc_new_region gen %d: %d bytes: pages %d to %d: addr=%x\n", + "/gc_alloc_new_region() gen %d: %d bytes: pages %d to %d: addr=%x\n", gc_alloc_generation, bytes_found, first_page, @@ -690,7 +684,7 @@ struct new_area { int size; }; static struct new_area (*new_areas)[]; -static new_areas_index; +static int new_areas_index; int max_new_areas; /* Add a new area to new_areas. */ @@ -778,7 +772,7 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) /* FSHOW((stderr, - "/gc_alloc_update_page_tables to gen %d:\n", + "/gc_alloc_update_page_tables() to gen %d:\n", gc_alloc_generation)); */ @@ -790,7 +784,7 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) next_page = first_page+1; - /* Skip if no bytes were allocated */ + /* Skip if no bytes were allocated. */ if (alloc_region->free_pointer != alloc_region->start_addr) { orig_first_page_bytes_used = page_table[first_page].bytes_used; @@ -801,7 +795,7 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) /* Update the first page. */ /* If the page was free then set up the gen, and - first_object_offset. */ + * first_object_offset. */ if (page_table[first_page].bytes_used == 0) gc_assert(page_table[first_page].first_object_offset == 0); @@ -814,8 +808,8 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) byte_cnt = 0; - /* Calc. the number of bytes used in this page. This is not always - the number of new bytes, unless it was free. */ + /* Calculate the number of bytes used in this page. This is not + * always the number of new bytes, unless it was free. */ more = 0; if ((bytes_used = (alloc_region->free_pointer - page_address(first_page)))>4096) { bytes_used = 4096; @@ -825,9 +819,9 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) byte_cnt += bytes_used; - /* All the rest of the pages should be free. Need to set their - first_object_offset pointer to the start of the region, and set - the bytes_used. */ + /* All the rest of the pages should be free. We need to set their + * first_object_offset pointer to the start of the region, and set + * the bytes_used. */ while (more) { if (unboxed) gc_assert(page_table[next_page].allocated == UNBOXED_PAGE); @@ -860,7 +854,7 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) gc_assert((byte_cnt- orig_first_page_bytes_used) == region_size); /* Set the generations alloc restart page to the last page of - the region. */ + * the region. */ if (unboxed) generations[gc_alloc_generation].alloc_unboxed_start_page = next_page-1; @@ -877,12 +871,12 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) region_size, gc_alloc_generation)); */ - } - else - /* No bytes allocated. Unallocate the first_page if there are 0 - bytes_used. */ + } else { + /* There are no bytes allocated. Unallocate the first_page if + * there are 0 bytes_used. */ if (page_table[first_page].bytes_used == 0) page_table[first_page].allocated = FREE_PAGE; + } /* Unallocate any unused pages. */ while (next_page <= alloc_region->last_page) { @@ -902,8 +896,8 @@ gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) static inline void *gc_quick_alloc(int nbytes); /* Allocate a possibly large object. */ -static void -*gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region) +static void * +gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region) { int first_page; int last_page; @@ -925,7 +919,7 @@ static void /* FSHOW((stderr, - "/gc_alloc_large for %d bytes from gen %d\n", + "/gc_alloc_large() for %d bytes from gen %d\n", nbytes, gc_alloc_generation)); */ @@ -944,12 +938,15 @@ static void 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 = generations[gc_alloc_generation].alloc_large_unboxed_start_page; - else + if (unboxed) { + restart_page = + generations[gc_alloc_generation].alloc_large_unboxed_start_page; + } else { restart_page = generations[gc_alloc_generation].alloc_large_start_page; - if (restart_page <= alloc_region->last_page) + } + if (restart_page <= alloc_region->last_page) { restart_page = alloc_region->last_page+1; + } do { first_page = restart_page; @@ -959,6 +956,9 @@ static void && (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 && @@ -1026,7 +1026,7 @@ static void /* if (large) FSHOW((stderr, - "/gc_alloc_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n", + "/gc_alloc_large() gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n", gc_alloc_generation, nbytes, bytes_found, @@ -1127,11 +1127,11 @@ static void return((void *)(page_address(first_page)+orig_first_page_bytes_used)); } -/* Allocate bytes from the boxed_region. It first checks if there is - * room, if not then it calls gc_alloc_new_region to find a new region - * with enough space. A pointer to the start of the region is returned. */ -static void -*gc_alloc(int nbytes) +/* 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) { void *new_free_pointer; @@ -1195,13 +1195,14 @@ static void /* shouldn't happen */ gc_assert(0); + return((void *) NIL); /* dummy value: return something ... */ } /* 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. */ -static inline void -*gc_quick_alloc(int nbytes) +static inline void * +gc_quick_alloc(int nbytes) { void *new_free_pointer; @@ -1209,22 +1210,22 @@ static inline void new_free_pointer = boxed_region.free_pointer + nbytes; if (new_free_pointer <= boxed_region.end_addr) { - /* If so then allocate from the current region. */ + /* 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); } - - /* Else call gc_alloc */ - return (gc_alloc(nbytes)); } /* 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 + * not enough free space then call gc_alloc() to do the job. A pointer * to the start of the region is returned. */ -static inline void -*gc_quick_alloc_large(int nbytes) +static inline void * +gc_quick_alloc_large(int nbytes) { void *new_free_pointer; @@ -1239,19 +1240,19 @@ static inline void 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); } - - /* Else call gc_alloc */ - return (gc_alloc(nbytes)); } -static void -*gc_alloc_unboxed(int nbytes) +static void * +gc_alloc_unboxed(int nbytes) { void *new_free_pointer; /* - FSHOW((stderr, "/gc_alloc_unboxed %d\n", nbytes)); + FSHOW((stderr, "/gc_alloc_unboxed() %d\n", nbytes)); */ /* Check whether there is room in the current region. */ @@ -1289,7 +1290,7 @@ static void /* Set up a new region. */ gc_alloc_new_region(nbytes, 1, &unboxed_region); - /* Should now be enough room. */ + /* (There should now be enough room.) */ /* Check whether there is room in the current region. */ new_free_pointer = unboxed_region.free_pointer + nbytes; @@ -1313,10 +1314,11 @@ static void /* shouldn't happen? */ gc_assert(0); + return((void *) NIL); /* dummy value: return something ... */ } -static inline void -*gc_quick_alloc_unboxed(int nbytes) +static inline void * +gc_quick_alloc_unboxed(int nbytes) { void *new_free_pointer; @@ -1329,19 +1331,19 @@ static inline void unboxed_region.free_pointer = new_free_pointer; return((void *)new_obj); + } else { + /* Let general gc_alloc_unboxed() handle it. */ + return gc_alloc_unboxed(nbytes); } - - /* Else call gc_alloc */ - 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 gc_alloc to do the job. + * 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) +static inline void * +gc_quick_alloc_large_unboxed(int nbytes) { void *new_free_pointer; @@ -1350,17 +1352,15 @@ static inline void /* 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. */ + /* 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); } - - /* Else call gc_alloc. */ - return (gc_alloc_unboxed(nbytes)); } /* @@ -1409,18 +1409,18 @@ copy_object(lispobj object, int nwords) lispobj *new; lispobj *source, *dest; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); gc_assert(from_space_p(object)); gc_assert((nwords & 0x01) == 0); /* Get tag of object. */ - tag = LowtagOf(object); + tag = lowtag_of(object); /* Allocate space. */ new = gc_quick_alloc(nwords*4); dest = new; - source = (lispobj *) PTR(object); + source = (lispobj *) native_pointer(object); /* Copy the object. */ while (nwords > 0) { @@ -1449,7 +1449,7 @@ copy_large_object(lispobj object, int nwords) lispobj *source, *dest; int first_page; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); gc_assert(from_space_p(object)); gc_assert((nwords & 0x01) == 0); @@ -1549,13 +1549,13 @@ 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); dest = new; - source = (lispobj *) PTR(object); + source = (lispobj *) native_pointer(object); /* Copy the object. */ while (nwords > 0) { @@ -1579,18 +1579,18 @@ copy_unboxed_object(lispobj object, int nwords) lispobj *new; lispobj *source, *dest; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); gc_assert(from_space_p(object)); 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); dest = new; - source = (lispobj *) PTR(object); + source = (lispobj *) native_pointer(object); /* Copy the object. */ while (nwords > 0) { @@ -1624,7 +1624,7 @@ copy_large_unboxed_object(lispobj object, int nwords) lispobj *source, *dest; int first_page; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); gc_assert(from_space_p(object)); gc_assert((nwords & 0x01) == 0); @@ -1713,13 +1713,13 @@ 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); dest = new; - source = (lispobj *) PTR(object); + source = (lispobj *) native_pointer(object); /* Copy the object. */ while (nwords > 0) { @@ -1739,145 +1739,84 @@ copy_large_unboxed_object(lispobj object, int nwords) * scavenging */ -#define DIRECT_SCAV 0 - +/* 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 nwords) +scavenge(lispobj *start, long n_words) { - while (nwords > 0) { - lispobj object; - int type, words_scavenged; + lispobj *end = start + n_words; + lispobj *object_ptr; + int n_words_scavenged; + + for (object_ptr = start; + object_ptr < end; + object_ptr += n_words_scavenged) { - object = *start; + lispobj object = *object_ptr; -/* FSHOW((stderr, "Scavenge: %p, %ld\n", start, nwords)); */ - gc_assert(object != 0x01); /* not a forwarding pointer */ -#if DIRECT_SCAV - type = TypeOf(object); - words_scavenged = (scavtab[type])(start, object); -#else - if (Pointerp(object)) { - /* It's a 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 *)PTR(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) { - /* Yep, there be a forwarding pointer. */ - *start = ptr[1]; - words_scavenged = 1; - } - else + /* Yes, there's a forwarding pointer. */ + *object_ptr = ptr[1]; + n_words_scavenged = 1; + } else { /* Scavenge that pointer. */ - words_scavenged = (scavtab[TypeOf(object)])(start, object); + n_words_scavenged = + (scavtab[widetag_of(object)])(object_ptr, object); + } } else { - /* It points somewhere other than oldspace. Leave it alone. */ - words_scavenged = 1; + /* 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 { - if ((object & 3) == 0) { - /* It's a fixnum. Real easy.. */ - words_scavenged = 1; - } else { - /* It's some sort of header object or another. */ - words_scavenged = (scavtab[TypeOf(object)])(start, object); - } + /* It's some sort of header object or another. */ + n_words_scavenged = + (scavtab[widetag_of(object)])(object_ptr, object); } -#endif - - start += words_scavenged; - nwords -= words_scavenged; } - gc_assert(nwords == 0); + gc_assert(object_ptr == end); } - /* * code and code-related objects */ -#define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer) +/* FIXME: (1) Shouldn't this be defined in sbcl.h? */ +#define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG) -static lispobj trans_function_header(lispobj object); +static lispobj trans_fun_header(lispobj object); static lispobj trans_boxed(lispobj object); -#if DIRECT_SCAV -static int -scav_function_pointer(lispobj *where, lispobj object) -{ - gc_assert(Pointerp(object)); - - if (from_space_p(object)) { - lispobj first, *first_pointer; - - /* object is a pointer into from space. Check to see whether - * it has been forwarded. */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer; - - if (first == 0x01) { - /* Forwarded */ - *where = first_pointer[1]; - return 1; - } - else { - int type; - lispobj copy; - - /* must transport object -- object may point to either a - * function header, a closure function header, or to a - * closure header. */ - - type = TypeOf(first); - switch (type) { - 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; - } - - first = copy; - } - - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); - - *where = first; - } - return 1; -} -#else static int -scav_function_pointer(lispobj *where, lispobj object) +scav_fun_pointer(lispobj *where, lispobj object) { lispobj *first_pointer; lispobj copy; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); /* Object is a pointer into from space - no a FP. */ - first_pointer = (lispobj *) PTR(object); + 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); + switch (widetag_of(*first_pointer)) { + case SIMPLE_FUN_HEADER_WIDETAG: + case CLOSURE_FUN_HEADER_WIDETAG: + copy = trans_fun_header(object); break; default: copy = trans_boxed(object); @@ -1890,14 +1829,13 @@ scav_function_pointer(lispobj *where, lispobj object) first_pointer[1] = copy; } - gc_assert(Pointerp(copy)); + gc_assert(is_lisp_pointer(copy)); gc_assert(!from_space_p(copy)); *where = copy; return 1; } -#endif /* Scan a x86 compiled code object, looking for possible fixups that * have been missed after a move. @@ -1912,8 +1850,6 @@ void sniff_code_object(struct code *code, unsigned displacement) { int nheader_words, ncode_words, nwords; - lispobj fheaderl; - struct function *fheaderp; void *p; void *constants_start_addr, *constants_end_addr; void *code_start_addr, *code_end_addr; @@ -1922,15 +1858,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; @@ -1947,8 +1874,10 @@ sniff_code_object(struct code *code, unsigned displacement) unsigned d2 = *((unsigned char *)p - 2); unsigned d3 = *((unsigned char *)p - 3); unsigned d4 = *((unsigned char *)p - 4); +#if QSHOW unsigned d5 = *((unsigned char *)p - 5); unsigned d6 = *((unsigned char *)p - 6); +#endif /* Check for code references. */ /* Check for a 32 bit word that looks like an absolute @@ -2093,19 +2022,10 @@ apply_code_fixups(struct code *old_code, struct code *new_code) int nheader_words, ncode_words, nwords; void *constants_start_addr, *constants_end_addr; void *code_start_addr, *code_end_addr; - lispobj p; lispobj fixups = NIL; 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; @@ -2131,7 +2051,8 @@ 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) || !Pointerp(fixups)) { + if ((fixups == 0) || (fixups == UNBOUND_MARKER_WIDETAG) || + !is_lisp_pointer(fixups)) { /* Check for possible errors. */ if (check_code_fixups) sniff_code_object(new_code, displacement); @@ -2145,19 +2066,21 @@ apply_code_fixups(struct code *old_code, struct code *new_code) return; } - fixups_vector = (struct vector *)PTR(fixups); + fixups_vector = (struct vector *)native_pointer(fixups); /* Could be pointing to a forwarding pointer. */ - if (Pointerp(fixups) && (find_page_index((void*)fixups_vector) != -1) - && (fixups_vector->header == 0x01)) { + if (is_lisp_pointer(fixups) && + (find_page_index((void*)fixups_vector) != -1) && + (fixups_vector->header == 0x01)) { /* If so, then follow it. */ /*SHOW("following pointer to a forwarding pointer");*/ - fixups_vector = (struct vector *)PTR((lispobj)fixups_vector->length); + fixups_vector = (struct vector *)native_pointer((lispobj)fixups_vector->length); } /*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); @@ -2207,10 +2130,10 @@ trans_code(struct code *code) if (*((lispobj *)code) == 0x01) return (struct code*)(((lispobj *)code)[1]); - gc_assert(TypeOf(code->header) == type_CodeHeader); + gc_assert(widetag_of(code->header) == CODE_HEADER_WIDETAG); /* Prepare to transport the code vector. */ - l_code = (lispobj) code | type_OtherPointer; + l_code = (lispobj) code | OTHER_POINTER_LOWTAG; ncode_words = fixnum_value(code->code_size); nheader_words = HeaderValue(code->header); @@ -2218,7 +2141,7 @@ trans_code(struct code *code) nwords = CEILING(nwords, 2); l_new_code = copy_large_object(l_code, nwords); - new_code = (struct code *) PTR(l_new_code); + new_code = (struct code *) native_pointer(l_new_code); /* may not have been moved.. */ if (new_code == code) @@ -2245,23 +2168,23 @@ trans_code(struct code *code) prev_pointer = &new_code->entry_points; while (fheaderl != NIL) { - struct function *fheaderp, *nfheaderp; + struct simple_fun *fheaderp, *nfheaderp; lispobj nfheaderl; - fheaderp = (struct function *) PTR(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); - /* Calculate the new function pointer and the new */ - /* function header. */ + /* Calculate the new function pointer and the new + * function header. */ nfheaderl = fheaderl + displacement; - nfheaderp = (struct function *) PTR(nfheaderl); + nfheaderp = (struct simple_fun *) native_pointer(nfheaderl); /* Set forwarding pointer. */ ((lispobj *)fheaderp)[0] = 0x01; ((lispobj *)fheaderp)[1] = nfheaderl; /* Fix self pointer. */ - nfheaderp->self = nfheaderl + RAW_ADDR_OFFSET; + nfheaderp->self = nfheaderl + FUN_RAW_ADDR_OFFSET; *prev_pointer = nfheaderl; @@ -2269,8 +2192,7 @@ trans_code(struct code *code) prev_pointer = &nfheaderp->next; } - /* sniff_code_object(new_code,displacement);*/ - apply_code_fixups(code,new_code); + apply_code_fixups(code, new_code); return new_code; } @@ -2279,34 +2201,36 @@ static int scav_code_header(lispobj *where, lispobj object) { struct code *code; - int nheader_words, ncode_words, nwords; - lispobj fheaderl; - struct function *fheaderp; + int n_header_words, n_code_words, n_words; + lispobj entry_point; /* tagged pointer to entry point */ + struct simple_fun *function_ptr; /* untagged pointer to entry point */ code = (struct code *) where; - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(object); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); + 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, nheader_words - 1); + scavenge(where + 1, n_header_words - 1); - /* Scavenge the boxed section of each function object in the */ - /* code data block. */ - fheaderl = code->entry_points; - while (fheaderl != NIL) { - fheaderp = (struct function *) PTR(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + /* 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) { - scavenge(&fheaderp->name, 1); - scavenge(&fheaderp->arglist, 1); - scavenge(&fheaderp->type, 1); - - fheaderl = fheaderp->next; + gc_assert(is_lisp_pointer(entry_point)); + + function_ptr = (struct simple_fun *) native_pointer(entry_point); + gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG); + + scavenge(&function_ptr->name, 1); + scavenge(&function_ptr->arglist, 1); + scavenge(&function_ptr->type, 1); } - return nwords; + return n_words; } static lispobj @@ -2314,8 +2238,8 @@ trans_code_header(lispobj object) { struct code *ncode; - ncode = trans_code((struct code *) PTR(object)); - return (lispobj) ncode | type_OtherPointer; + ncode = trans_code((struct code *) native_pointer(object)); + return (lispobj) ncode | OTHER_POINTER_LOWTAG; } static int @@ -2346,20 +2270,20 @@ scav_return_pc_header(lispobj *where, lispobj object) static lispobj trans_return_pc_header(lispobj object) { - struct function *return_pc; + struct simple_fun *return_pc; unsigned long offset; struct code *code, *ncode; SHOW("/trans_return_pc_header: Will this work?"); - return_pc = (struct function *) PTR(object); + return_pc = (struct simple_fun *) native_pointer(object); offset = HeaderValue(return_pc->header) * 4; /* Transport the whole code object. */ code = (struct code *) ((unsigned long) return_pc - offset); ncode = trans_code(code); - return ((lispobj) ncode + offset) | type_OtherPointer; + return ((lispobj) ncode + offset) | OTHER_POINTER_LOWTAG; } /* On the 386, closures hold a pointer to the raw address instead of the @@ -2372,19 +2296,19 @@ scav_closure_header(lispobj *where, lispobj object) lispobj fun; closure = (struct closure *)where; - fun = closure->function - RAW_ADDR_OFFSET; + fun = closure->fun - FUN_RAW_ADDR_OFFSET; scavenge(&fun, 1); /* The function may have moved so update the raw address. But * don't write unnecessarily. */ - if (closure->function != fun + RAW_ADDR_OFFSET) - closure->function = fun + RAW_ADDR_OFFSET; + if (closure->fun != fun + FUN_RAW_ADDR_OFFSET) + closure->fun = fun + FUN_RAW_ADDR_OFFSET; return 2; } #endif static int -scav_function_header(lispobj *where, lispobj object) +scav_fun_header(lispobj *where, lispobj object) { lose("attempted to scavenge a function header where=0x%08x object=0x%08x", (unsigned long) where, @@ -2393,53 +2317,26 @@ scav_function_header(lispobj *where, lispobj object) } static lispobj -trans_function_header(lispobj object) +trans_fun_header(lispobj object) { - struct function *fheader; + struct simple_fun *fheader; unsigned long offset; struct code *code, *ncode; - fheader = (struct function *) PTR(object); + fheader = (struct simple_fun *) native_pointer(object); offset = HeaderValue(fheader->header) * 4; /* Transport the whole code object. */ code = (struct code *) ((unsigned long) fheader - offset); ncode = trans_code(code); - return ((lispobj) ncode + offset) | type_FunctionPointer; + return ((lispobj) ncode + offset) | FUN_POINTER_LOWTAG; } /* * instances */ -#if DIRECT_SCAV -static int -scav_instance_pointer(lispobj *where, lispobj object) -{ - if (from_space_p(object)) { - lispobj first, *first_pointer; - - /* Object is a pointer into from space. Check to see */ - /* whether it has been forwarded. */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer; - - if (first == 0x01) { - /* forwarded */ - first = first_pointer[1]; - } else { - first = trans_boxed(object); - gc_assert(first != object); - /* Set forwarding pointer. */ - first_pointer[0] = 0x01; - first_pointer[1] = first; - } - *where = first; - } - return 1; -} -#else static int scav_instance_pointer(lispobj *where, lispobj object) { @@ -2450,7 +2347,7 @@ scav_instance_pointer(lispobj *where, lispobj object) gc_assert(copy != object); - first_pointer = (lispobj *) PTR(object); + first_pointer = (lispobj *) native_pointer(object); /* Set forwarding pointer. */ first_pointer[0] = 0x01; @@ -2459,7 +2356,6 @@ scav_instance_pointer(lispobj *where, lispobj object) return 1; } -#endif /* * lists and conses @@ -2467,84 +2363,46 @@ scav_instance_pointer(lispobj *where, lispobj object) static lispobj trans_list(lispobj object); -#if DIRECT_SCAV -static int -scav_list_pointer(lispobj *where, lispobj object) -{ - /* KLUDGE: There's lots of cut-and-paste duplication between this - * and scav_instance_pointer(..), scav_other_pointer(..), and - * perhaps other functions too. -- WHN 20000620 */ - - gc_assert(Pointerp(object)); - - if (from_space_p(object)) { - lispobj first, *first_pointer; - - /* Object is a pointer into from space. Check to see whether it has - * been forwarded. */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer; - - if (first == 0x01) { - /* forwarded */ - first = first_pointer[1]; - } else { - first = trans_list(object); - - /* Set forwarding pointer */ - first_pointer[0] = 0x01; - first_pointer[1] = first; - } - - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); - *where = first; - } - return 1; -} -#else static int scav_list_pointer(lispobj *where, lispobj object) { lispobj first, *first_pointer; - gc_assert(Pointerp(object)); + 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 *) PTR(object); + first_pointer = (lispobj *) native_pointer(object); /* Set forwarding pointer */ first_pointer[0] = 0x01; first_pointer[1] = first; - gc_assert(Pointerp(first)); + gc_assert(is_lisp_pointer(first)); gc_assert(!from_space_p(first)); *where = first; return 1; } -#endif static lispobj trans_list(lispobj object) { lispobj new_list_pointer; struct cons *cons, *new_cons; - int n = 0; lispobj cdr; gc_assert(from_space_p(object)); - cons = (struct cons *) PTR(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); + new_list_pointer = (lispobj)new_cons | lowtag_of(object); /* Grab the cdr before it is clobbered. */ cdr = cons->cdr; @@ -2559,17 +2417,17 @@ trans_list(lispobj object) lispobj new_cdr; struct cons *cdr_cons, *new_cdr_cons; - if (LowtagOf(cdr) != type_ListPointer || !from_space_p(cdr) - || (*((lispobj *)PTR(cdr)) == 0x01)) + if (lowtag_of(cdr) != LIST_POINTER_LOWTAG || !from_space_p(cdr) + || (*((lispobj *)native_pointer(cdr)) == 0x01)) break; - cdr_cons = (struct cons *) PTR(cdr); + 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); + new_cdr = (lispobj)new_cdr_cons | lowtag_of(cdr); /* Grab the cdr before it is clobbered. */ cdr = cdr_cons->cdr; @@ -2593,52 +2451,17 @@ trans_list(lispobj object) * scavenging and transporting other pointers */ -#if DIRECT_SCAV -static int -scav_other_pointer(lispobj *where, lispobj object) -{ - gc_assert(Pointerp(object)); - - if (from_space_p(object)) { - lispobj first, *first_pointer; - - /* Object is a pointer into from space. Check to see */ - /* whether it has been forwarded. */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer; - - if (first == 0x01) { - /* Forwarded. */ - first = first_pointer[1]; - *where = first; - } else { - first = (transother[TypeOf(first)])(object); - - if (first != object) { - /* Set forwarding pointer */ - first_pointer[0] = 0x01; - first_pointer[1] = first; - *where = first; - } - } - - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); - } - return 1; -} -#else static int scav_other_pointer(lispobj *where, lispobj object) { lispobj first, *first_pointer; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); /* Object is a pointer into from space - not FP. */ - first_pointer = (lispobj *) PTR(object); + first_pointer = (lispobj *) native_pointer(object); - first = (transother[TypeOf(*first_pointer)])(object); + first = (transother[widetag_of(*first_pointer)])(object); if (first != object) { /* Set forwarding pointer. */ @@ -2647,13 +2470,11 @@ scav_other_pointer(lispobj *where, lispobj object) *where = first; } - gc_assert(Pointerp(first)); + gc_assert(is_lisp_pointer(first)); gc_assert(!from_space_p(first)); return 1; } -#endif - /* * immediate, boxed, and unboxed objects @@ -2697,9 +2518,9 @@ trans_boxed(lispobj object) lispobj header; unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - header = *((lispobj *) PTR(object)); + header = *((lispobj *) native_pointer(object)); length = HeaderValue(header) + 1; length = CEILING(length, 2); @@ -2712,9 +2533,9 @@ trans_boxed_large(lispobj object) lispobj header; unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - header = *((lispobj *) PTR(object)); + header = *((lispobj *) native_pointer(object)); length = HeaderValue(header) + 1; length = CEILING(length, 2); @@ -2742,14 +2563,14 @@ scav_fdefn(lispobj *where, lispobj object) fdefn = (struct fdefn *)where; /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n", - fdefn->function, fdefn->raw_addr)); */ + fdefn->fun, fdefn->raw_addr)); */ - if ((char *)(fdefn->function + RAW_ADDR_OFFSET) == fdefn->raw_addr) { + if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) == fdefn->raw_addr) { scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1); /* Don't write unnecessarily. */ - if (fdefn->raw_addr != (char *)(fdefn->function + RAW_ADDR_OFFSET)) - fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET); + if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)) + fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET); return sizeof(struct fdefn) / sizeof(lispobj); } else { @@ -2775,9 +2596,9 @@ trans_unboxed(lispobj object) unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - header = *((lispobj *) PTR(object)); + header = *((lispobj *) native_pointer(object)); length = HeaderValue(header) + 1; length = CEILING(length, 2); @@ -2791,9 +2612,9 @@ trans_unboxed_large(lispobj object) unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - header = *((lispobj *) PTR(object)); + header = *((lispobj *) native_pointer(object)); length = HeaderValue(header) + 1; length = CEILING(length, 2); @@ -2841,13 +2662,13 @@ trans_string(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + 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 *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length) + 1; nwords = CEILING(NWORDS(length, 4) + 2, 2); @@ -2879,12 +2700,14 @@ scav_vector(lispobj *where, lispobj object) { unsigned int kv_length; lispobj *kv_vector; - unsigned int length; + unsigned int length = 0; /* (0 = dummy to stop GCC warning) */ lispobj *hash_table; lispobj empty_symbol; - unsigned int *index_vector, *next_vector, *hash_vector; + unsigned int *index_vector = NULL; /* (NULL = dummy to stop GCC warning) */ + unsigned int *next_vector = NULL; /* (NULL = dummy to stop GCC warning) */ + unsigned int *hash_vector = NULL; /* (NULL = dummy to stop GCC warning) */ lispobj weak_p_obj; - unsigned next_vector_length; + unsigned next_vector_length = 0; /* FIXME: A comment explaining this would be nice. It looks as * though SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based @@ -2895,7 +2718,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); @@ -3112,9 +2939,9 @@ trans_vector_bit(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(NWORDS(length, 32) + 2, 2); @@ -3154,9 +2981,9 @@ trans_vector_unsigned_byte_2(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(NWORDS(length, 16) + 2, 2); @@ -3196,9 +3023,9 @@ trans_vector_unsigned_byte_4(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(NWORDS(length, 8) + 2, 2); @@ -3237,9 +3064,9 @@ trans_vector_unsigned_byte_8(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(NWORDS(length, 4) + 2, 2); @@ -3279,9 +3106,9 @@ trans_vector_unsigned_byte_16(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(NWORDS(length, 2) + 2, 2); @@ -3320,9 +3147,9 @@ trans_vector_unsigned_byte_32(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(length + 2, 2); @@ -3361,9 +3188,9 @@ trans_vector_single_float(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(length + 2, 2); @@ -3402,9 +3229,9 @@ trans_vector_double_float(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(length * 2 + 2, 2); @@ -3424,7 +3251,7 @@ size_vector_double_float(lispobj *where) return nwords; } -#ifdef type_SimpleArrayLongFloat +#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG static int scav_vector_long_float(lispobj *where, lispobj object) { @@ -3444,9 +3271,9 @@ trans_vector_long_float(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(length * 3 + 2, 2); @@ -3468,7 +3295,7 @@ size_vector_long_float(lispobj *where) #endif -#ifdef type_SimpleArrayComplexSingleFloat +#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG static int scav_vector_complex_single_float(lispobj *where, lispobj object) { @@ -3488,9 +3315,9 @@ trans_vector_complex_single_float(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(length * 2 + 2, 2); @@ -3511,7 +3338,7 @@ size_vector_complex_single_float(lispobj *where) } #endif -#ifdef type_SimpleArrayComplexDoubleFloat +#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG static int scav_vector_complex_double_float(lispobj *where, lispobj object) { @@ -3531,9 +3358,9 @@ trans_vector_complex_double_float(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(length * 4 + 2, 2); @@ -3555,7 +3382,7 @@ size_vector_complex_double_float(lispobj *where) #endif -#ifdef type_SimpleArrayComplexLongFloat +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG static int scav_vector_complex_long_float(lispobj *where, lispobj object) { @@ -3575,9 +3402,9 @@ trans_vector_complex_long_float(lispobj object) struct vector *vector; int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); nwords = CEILING(length * 6 + 2, 2); @@ -3649,9 +3476,9 @@ static lispobj trans_weak_pointer(lispobj object) { lispobj copy; - struct weak_pointer *wp; + /* struct weak_pointer *wp; */ - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); #if defined(DEBUG_WEAK) FSHOW((stderr, "Transporting weak pointer from 0x%08x\n", object)); @@ -3661,7 +3488,7 @@ trans_weak_pointer(lispobj object) /* been transported so they can be fixed up in a post-GC pass. */ copy = copy_object(object, WEAK_POINTER_NWORDS); - /* wp = (struct weak_pointer *) PTR(copy);*/ + /* wp = (struct weak_pointer *) native_pointer(copy);*/ /* Push the weak pointer onto the list of weak pointers. */ @@ -3682,16 +3509,11 @@ void scan_weak_pointers(void) struct weak_pointer *wp; for (wp = weak_pointers; wp != NULL; wp = wp->next) { lispobj value = wp->value; - lispobj first, *first_pointer; - - first_pointer = (lispobj *)PTR(value); + lispobj *first_pointer; - /* - FSHOW((stderr, "/weak pointer at 0x%08x\n", (unsigned long) wp)); - FSHOW((stderr, "/value: 0x%08x\n", (unsigned long) value)); - */ + first_pointer = (lispobj *)native_pointer(value); - if (Pointerp(value) && from_space_p(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 @@ -3700,7 +3522,6 @@ void scan_weak_pointers(void) wp->value = first_pointer[1]; } else { /* Break it. */ - SHOW("broken"); wp->value = NIL; wp->broken = T; } @@ -3715,21 +3536,27 @@ void scan_weak_pointers(void) static int scav_lose(lispobj *where, lispobj object) { - lose("no scavenge function for object 0x%08x", (unsigned long) object); + lose("no scavenge function for object 0x%08x (widetag 0x%x)", + (unsigned long)object, + widetag_of(*(lispobj*)native_pointer(object))); return 0; /* bogus return value to satisfy static type checking */ } static lispobj trans_lose(lispobj object) { - lose("no transport function for object 0x%08x", (unsigned long) object); + lose("no transport function for object 0x%08x (widetag 0x%x)", + (unsigned long)object, + widetag_of(*(lispobj*)native_pointer(object))); return NIL; /* bogus return value to satisfy static type checking */ } static int size_lose(lispobj *where) { - lose("no size function for object at 0x%08x", (unsigned long) where); + lose("no size function for object at 0x%08x (widetag 0x%x)", + (unsigned long)where, + widetag_of(where)); return 1; /* bogus return value to satisfy static type checking */ } @@ -3743,264 +3570,297 @@ gc_init_tables(void) 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; + /* For each type which can be selected by the lowtag alone, set + * multiple entries in our widetag scavenge table (one for each + * possible value of the high bits). + * + * FIXME: bare constant 32 and 3 here, ick! */ + for (i = 0; i < 32; i++) { + scavtab[EVEN_FIXNUM_LOWTAG|(i<<3)] = scav_immediate; + scavtab[FUN_POINTER_LOWTAG|(i<<3)] = scav_fun_pointer; + /* skipping OTHER_IMMEDIATE_0_LOWTAG */ + scavtab[LIST_POINTER_LOWTAG|(i<<3)] = scav_list_pointer; + scavtab[ODD_FIXNUM_LOWTAG|(i<<3)] = scav_immediate; + scavtab[INSTANCE_POINTER_LOWTAG|(i<<3)] = scav_instance_pointer; + /* skipping OTHER_IMMEDIATE_1_LOWTAG */ + scavtab[OTHER_POINTER_LOWTAG|(i<<3)] = scav_other_pointer; } - /* Other-pointer types (those selected by all eight bits of the tag) get - * one entry each in the scavenge table. */ - scavtab[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; + /* Other-pointer types (those selected by all eight bits of the + * tag) get one entry each in the scavenge table. */ + scavtab[BIGNUM_WIDETAG] = scav_unboxed; + scavtab[RATIO_WIDETAG] = scav_boxed; + scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed; + scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed; +#ifdef LONG_FLOAT_WIDETAG + scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed; #endif - scavtab[type_Complex] = scav_boxed; -#ifdef type_ComplexSingleFloat - scavtab[type_ComplexSingleFloat] = scav_unboxed; + scavtab[COMPLEX_WIDETAG] = scav_boxed; +#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG + scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed; #endif -#ifdef type_ComplexDoubleFloat - scavtab[type_ComplexDoubleFloat] = scav_unboxed; +#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG + scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed; #endif -#ifdef type_ComplexLongFloat - scavtab[type_ComplexLongFloat] = scav_unboxed; +#ifdef COMPLEX_LONG_FLOAT_WIDETAG + scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = 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; + scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed; + scavtab[SIMPLE_STRING_WIDETAG] = scav_string; + scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit; + scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector; + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] = + scav_vector_unsigned_byte_2; + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] = + scav_vector_unsigned_byte_4; + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] = + scav_vector_unsigned_byte_8; + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] = + scav_vector_unsigned_byte_16; + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] = + scav_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG + scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = scav_vector_unsigned_byte_8; #endif -#ifdef type_SimpleArraySignedByte16 - scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG + scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] = + scav_vector_unsigned_byte_16; #endif -#ifdef type_SimpleArraySignedByte30 - scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG + scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] = + scav_vector_unsigned_byte_32; #endif -#ifdef type_SimpleArraySignedByte32 - scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG + scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] = + 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; + scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float; + scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float; +#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG + scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float; #endif -#ifdef type_SimpleArrayComplexSingleFloat - scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float; +#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG + scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] = + scav_vector_complex_single_float; #endif -#ifdef type_SimpleArrayComplexDoubleFloat - scavtab[type_SimpleArrayComplexDoubleFloat] = scav_vector_complex_double_float; +#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG + scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] = + scav_vector_complex_double_float; #endif -#ifdef type_SimpleArrayComplexLongFloat - scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float; +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG + scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] = + 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;*/ + scavtab[COMPLEX_STRING_WIDETAG] = scav_boxed; + scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed; + scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed; + scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed; + scavtab[CODE_HEADER_WIDETAG] = scav_code_header; + /*scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header;*/ + /*scavtab[CLOSURE_FUN_HEADER_WIDETAG] = scav_fun_header;*/ + /*scavtab[RETURN_PC_HEADER_WIDETAG] = scav_return_pc_header;*/ #ifdef __i386__ - scavtab[type_ClosureHeader] = scav_closure_header; - scavtab[type_FuncallableInstanceHeader] = scav_closure_header; - scavtab[type_ByteCodeFunction] = scav_closure_header; - scavtab[type_ByteCodeClosure] = scav_closure_header; + scavtab[CLOSURE_HEADER_WIDETAG] = scav_closure_header; + scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_closure_header; #else - scavtab[type_ClosureHeader] = scav_boxed; - scavtab[type_FuncallableInstanceHeader] = scav_boxed; - scavtab[type_ByteCodeFunction] = scav_boxed; - scavtab[type_ByteCodeClosure] = scav_boxed; + scavtab[CLOSURE_HEADER_WIDETAG] = scav_boxed; + scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = 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; + scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed; + scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed; + scavtab[BASE_CHAR_WIDETAG] = scav_immediate; + scavtab[SAP_WIDETAG] = scav_unboxed; + scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate; + scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer; + scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed; + scavtab[FDEFN_WIDETAG] = scav_fdefn; /* transport other table, initialized same way as scavtab */ for (i = 0; i < 256; i++) transother[i] = trans_lose; - transother[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; + transother[BIGNUM_WIDETAG] = trans_unboxed; + transother[RATIO_WIDETAG] = trans_boxed; + transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed; + transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed; +#ifdef LONG_FLOAT_WIDETAG + transother[LONG_FLOAT_WIDETAG] = trans_unboxed; #endif - transother[type_Complex] = trans_boxed; -#ifdef type_ComplexSingleFloat - transother[type_ComplexSingleFloat] = trans_unboxed; + transother[COMPLEX_WIDETAG] = trans_boxed; +#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG + transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed; #endif -#ifdef type_ComplexDoubleFloat - transother[type_ComplexDoubleFloat] = trans_unboxed; +#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG + transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed; #endif -#ifdef type_ComplexLongFloat - transother[type_ComplexLongFloat] = trans_unboxed; +#ifdef COMPLEX_LONG_FLOAT_WIDETAG + transother[COMPLEX_LONG_FLOAT_WIDETAG] = 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; + transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed_large; + transother[SIMPLE_STRING_WIDETAG] = trans_string; + transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit; + transother[SIMPLE_VECTOR_WIDETAG] = trans_vector; + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] = + trans_vector_unsigned_byte_2; + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] = + trans_vector_unsigned_byte_4; + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] = + trans_vector_unsigned_byte_8; + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] = + trans_vector_unsigned_byte_16; + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] = + trans_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG + transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = + trans_vector_unsigned_byte_8; #endif -#ifdef type_SimpleArraySignedByte16 - transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG + transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] = + trans_vector_unsigned_byte_16; #endif -#ifdef type_SimpleArraySignedByte30 - transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG + transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] = + trans_vector_unsigned_byte_32; #endif -#ifdef type_SimpleArraySignedByte32 - transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG + transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] = + 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; + transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = + trans_vector_single_float; + transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = + trans_vector_double_float; +#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG + transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = + trans_vector_long_float; #endif -#ifdef type_SimpleArrayComplexSingleFloat - transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float; +#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG + transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] = + trans_vector_complex_single_float; #endif -#ifdef type_SimpleArrayComplexDoubleFloat - transother[type_SimpleArrayComplexDoubleFloat] = trans_vector_complex_double_float; +#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG + transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] = + trans_vector_complex_double_float; #endif -#ifdef type_SimpleArrayComplexLongFloat - transother[type_SimpleArrayComplexLongFloat] = trans_vector_complex_long_float; +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG + transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] = + 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; + transother[COMPLEX_STRING_WIDETAG] = trans_boxed; + transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed; + transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed; + transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed; + transother[CODE_HEADER_WIDETAG] = trans_code_header; + transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header; + transother[CLOSURE_FUN_HEADER_WIDETAG] = trans_fun_header; + transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header; + transother[CLOSURE_HEADER_WIDETAG] = trans_boxed; + transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed; + transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed; + transother[SYMBOL_HEADER_WIDETAG] = trans_boxed; + transother[BASE_CHAR_WIDETAG] = trans_immediate; + transother[SAP_WIDETAG] = trans_unboxed; + transother[UNBOUND_MARKER_WIDETAG] = trans_immediate; + transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer; + transother[INSTANCE_HEADER_WIDETAG] = trans_boxed; + transother[FDEFN_WIDETAG] = trans_boxed; /* size table, initialized the same way as scavtab */ for (i = 0; i < 256; i++) sizetab[i] = size_lose; for (i = 0; i < 32; i++) { - sizetab[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[EVEN_FIXNUM_LOWTAG|(i<<3)] = size_immediate; + sizetab[FUN_POINTER_LOWTAG|(i<<3)] = size_pointer; + /* skipping OTHER_IMMEDIATE_0_LOWTAG */ + sizetab[LIST_POINTER_LOWTAG|(i<<3)] = size_pointer; + sizetab[ODD_FIXNUM_LOWTAG|(i<<3)] = size_immediate; + sizetab[INSTANCE_POINTER_LOWTAG|(i<<3)] = size_pointer; + /* skipping OTHER_IMMEDIATE_1_LOWTAG */ + sizetab[OTHER_POINTER_LOWTAG|(i<<3)] = size_pointer; } - sizetab[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; + sizetab[BIGNUM_WIDETAG] = size_unboxed; + sizetab[RATIO_WIDETAG] = size_boxed; + sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed; + sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed; +#ifdef LONG_FLOAT_WIDETAG + sizetab[LONG_FLOAT_WIDETAG] = size_unboxed; #endif - sizetab[type_Complex] = size_boxed; -#ifdef type_ComplexSingleFloat - sizetab[type_ComplexSingleFloat] = size_unboxed; + sizetab[COMPLEX_WIDETAG] = size_boxed; +#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG + sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed; #endif -#ifdef type_ComplexDoubleFloat - sizetab[type_ComplexDoubleFloat] = size_unboxed; +#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG + sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed; #endif -#ifdef type_ComplexLongFloat - sizetab[type_ComplexLongFloat] = size_unboxed; +#ifdef COMPLEX_LONG_FLOAT_WIDETAG + sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = 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; + sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed; + sizetab[SIMPLE_STRING_WIDETAG] = size_string; + sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit; + sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector; + sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] = + size_vector_unsigned_byte_2; + sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] = + size_vector_unsigned_byte_4; + sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] = + size_vector_unsigned_byte_8; + sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] = + size_vector_unsigned_byte_16; + sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] = + size_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG + sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = size_vector_unsigned_byte_8; #endif -#ifdef type_SimpleArraySignedByte16 - sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG + sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] = + size_vector_unsigned_byte_16; #endif -#ifdef type_SimpleArraySignedByte30 - sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG + sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] = + size_vector_unsigned_byte_32; #endif -#ifdef type_SimpleArraySignedByte32 - sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG + sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] = + 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; + sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float; + sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float; +#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG + sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float; #endif -#ifdef type_SimpleArrayComplexSingleFloat - sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float; +#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG + sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] = + size_vector_complex_single_float; #endif -#ifdef type_SimpleArrayComplexDoubleFloat - sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float; +#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG + sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] = + size_vector_complex_double_float; #endif -#ifdef type_SimpleArrayComplexLongFloat - sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float; +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG + sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] = + 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; + sizetab[COMPLEX_STRING_WIDETAG] = size_boxed; + sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed; + sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed; + sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed; + sizetab[CODE_HEADER_WIDETAG] = size_code_header; #if 0 /* We shouldn't see these, so just lose if it happens. */ - sizetab[type_FunctionHeader] = size_function_header; - sizetab[type_ClosureFunctionHeader] = size_function_header; - sizetab[type_ReturnPcHeader] = size_return_pc_header; + sizetab[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header; + sizetab[CLOSURE_FUN_HEADER_WIDETAG] = size_function_header; + sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header; #endif - sizetab[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; + sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed; + sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed; + sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed; + sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed; + sizetab[BASE_CHAR_WIDETAG] = size_immediate; + sizetab[SAP_WIDETAG] = size_unboxed; + sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate; + sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer; + sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed; + sizetab[FDEFN_WIDETAG] = size_boxed; } /* Scan an area looking for an object which encloses the given pointer. @@ -4012,23 +3872,23 @@ search_space(lispobj *start, size_t words, lispobj *pointer) size_t count = 1; lispobj thing = *start; - /* If thing is an immediate then this is a cons */ - if (Pointerp(thing) + /* 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? */ + /* Check whether the pointer is within this object. */ if ((pointer >= start) && (pointer < (start+count))) { /* found it! */ /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/ return(start); } - /* Round up the count */ + /* Round up the count. */ count = CEILING(count,2); start += count; @@ -4050,7 +3910,7 @@ search_read_only_space(lispobj *pointer) static lispobj * search_static_space(lispobj *pointer) { - lispobj* start = (lispobj*)static_space; + lispobj* start = (lispobj*)STATIC_SPACE_START; lispobj* end = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER); if ((pointer < start) || (pointer >= end)) return NULL; @@ -4065,7 +3925,7 @@ search_dynamic_space(lispobj *pointer) int page_index = find_page_index(pointer); lispobj *start; - /* Address may be invalid - do some checks. */ + /* The address may be invalid, so do some checks. */ if ((page_index == -1) || (page_table[page_index].allocated == FREE_PAGE)) return NULL; start = (lispobj *)((void *)page_address(page_index) @@ -4073,48 +3933,62 @@ search_dynamic_space(lispobj *pointer) return (search_space(start, (pointer+2)-start, pointer)); } -/* FIXME: There is a strong family resemblance between this function - * and the function of the same name in purify.c. Would it be possible - * to implement them as exactly the same function? */ +/* Is there any possibility that pointer is a valid Lisp object + * reference, and/or something else (e.g. subroutine call return + * address) which should prevent us from moving the referred-to thing? */ static int -valid_dynamic_space_pointer(lispobj *pointer) +possibly_valid_dynamic_space_pointer(lispobj *pointer) { lispobj *start_addr; - /* Find the object start address */ + /* Find the object start address. */ if ((start_addr = search_dynamic_space(pointer)) == NULL) { return 0; } /* We need to allow raw pointers into Code objects for return - * addresses. This will also pickup pointers to functions in code + * addresses. This will also pick up pointers to functions in code * objects. */ - if (TypeOf(*start_addr) == type_CodeHeader) { - /* X Could do some further checks here. */ + if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) { + /* XXX could do some further checks here */ return 1; } /* If it's not a return address then it needs to be a valid Lisp * pointer. */ - if (!Pointerp((lispobj)pointer)) { + if (!is_lisp_pointer((lispobj)pointer)) { return 0; } /* Check that the object pointed to is consistent with the pointer - * low tag. */ - switch (LowtagOf((lispobj)pointer)) { - case type_FunctionPointer: + * low tag. + * + * FIXME: It's not safe to rely on the result from this check + * before an object is initialized. Thus, if we were interrupted + * just as an object had been allocated but not initialized, the + * GC relying on this result could bogusly reclaim the memory. + * However, we can't really afford to do without this check. So + * we should make it safe somehow. + * (1) Perhaps just review the code to make sure + * that WITHOUT-GCING or WITHOUT-INTERRUPTS or some such + * thing is wrapped around critical sections where allocated + * memory type bits haven't been set. + * (2) Perhaps find some other hack to protect against this, e.g. + * recording the result of the last call to allocate-lisp-memory, + * and returning true from this function when *pointer is + * a reference to that result. */ + switch (lowtag_of((lispobj)pointer)) { + case FUN_POINTER_LOWTAG: /* Start_addr should be the enclosing code object, or a closure - header. */ - switch (TypeOf(*start_addr)) { - case type_CodeHeader: + * header. */ + 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: - if ((int)pointer != ((int)start_addr+type_FunctionPointer)) { + case CLOSURE_HEADER_WIDETAG: + case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: + if ((unsigned)pointer != + ((unsigned)start_addr+FUN_POINTER_LOWTAG)) { if (gencgc_verbose) FSHOW((stderr, "/Wf2: %x %x %x\n", @@ -4130,8 +4004,9 @@ valid_dynamic_space_pointer(lispobj *pointer) return 0; } break; - case type_ListPointer: - if ((int)pointer != ((int)start_addr+type_ListPointer)) { + case LIST_POINTER_LOWTAG: + if ((unsigned)pointer != + ((unsigned)start_addr+LIST_POINTER_LOWTAG)) { if (gencgc_verbose) FSHOW((stderr, "/Wl1: %x %x %x\n", @@ -4139,14 +4014,14 @@ valid_dynamic_space_pointer(lispobj *pointer) return 0; } /* Is it plausible cons? */ - if ((Pointerp(start_addr[0]) + 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)) - && (Pointerp(start_addr[1]) + || (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) @@ -4155,15 +4030,16 @@ valid_dynamic_space_pointer(lispobj *pointer) pointer, start_addr, *start_addr)); return 0; } - case type_InstancePointer: - if ((int)pointer != ((int)start_addr+type_InstancePointer)) { + case INSTANCE_POINTER_LOWTAG: + if ((unsigned)pointer != + ((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", @@ -4171,25 +4047,26 @@ valid_dynamic_space_pointer(lispobj *pointer) return 0; } break; - case type_OtherPointer: - if ((int)pointer != ((int)start_addr+type_OtherPointer)) { + case OTHER_POINTER_LOWTAG: + if ((unsigned)pointer != + ((int)start_addr+OTHER_POINTER_LOWTAG)) { if (gencgc_verbose) FSHOW((stderr, "/Wo1: %x %x %x\n", pointer, start_addr, *start_addr)); return 0; } - /* Is it plausible? Not a cons. X should check the headers. */ - if (Pointerp(start_addr[0]) || ((start_addr[0] & 3) == 0)) { + /* Is it plausible? Not a cons. XXX should check the headers. */ + if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) { if (gencgc_verbose) FSHOW((stderr, "/Wo2: %x %x %x\n", 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", @@ -4197,17 +4074,15 @@ 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", @@ -4215,68 +4090,68 @@ 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: @@ -4299,18 +4174,16 @@ valid_dynamic_space_pointer(lispobj *pointer) return 1; } -/* Adjust large bignum and vector objects. This will adjust the allocated - * region if the size has shrunk, and move unboxed objects into unboxed - * pages. The pages are not promoted here, and the promoted region is not - * added to the new_regions; this is really only designed to be called from - * preserve_pointer. Shouldn't fail if this is missed, just may delay the - * moving of objects to unboxed pages, and the freeing of pages. */ +/* Adjust large bignum and vector objects. This will adjust the + * allocated region if the size has shrunk, and move unboxed objects + * into unboxed pages. The pages are not promoted here, and the + * promoted region is not added to the new_regions; this is really + * only designed to be called from preserve_pointer(). Shouldn't fail + * if this is missed, just may delay the moving of objects to unboxed + * pages, and the freeing of pages. */ static void maybe_adjust_large_object(lispobj *where) { - int tag; - lispobj *new; - lispobj *source, *dest; int first_page; int nwords; @@ -4322,43 +4195,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; @@ -4367,7 +4240,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); @@ -4438,8 +4311,11 @@ maybe_adjust_large_object(lispobj *where) next_page++; } - if ((bytes_freed > 0) && gencgc_verbose) - FSHOW((stderr, "/adjust_large_object freed %d\n", bytes_freed)); + if ((bytes_freed > 0) && gencgc_verbose) { + FSHOW((stderr, + "/maybe_adjust_large_object() freed %d\n", + bytes_freed)); + } generations[from_space].bytes_allocated -= bytes_freed; bytes_allocated -= bytes_freed; @@ -4447,21 +4323,21 @@ maybe_adjust_large_object(lispobj *where) return; } -/* Take a possible pointer to a list object and mark the page_table - * so that it will not need changing during a GC. +/* Take a possible pointer to a Lisp object and mark its page in the + * page_table so that it will not be relocated during a GC. * * This involves locating the page it points to, then backing up to * the first page that has its first object start at offset 0, and - * then marking all pages dont_move from the first until a page that ends - * by being full, or having free gen. + * then marking all pages dont_move from the first until a page that + * ends by being full, or having free gen. * * This ensures that objects spanning pages are not broken. * * It is assumed that all the page static flags have been cleared at * the start of a GC. * - * It is also assumed that the current gc_alloc region has been flushed and - * the tables updated. */ + * It is also assumed that the current gc_alloc() region has been + * flushed and the tables updated. */ static void preserve_pointer(void *addr) { @@ -4470,22 +4346,34 @@ preserve_pointer(void *addr) int i; unsigned region_allocation; - /* Address is quite likely to have been invalid - do some checks. */ + /* quick check 1: Address is quite likely to have been invalid. */ if ((addr_page_index == -1) || (page_table[addr_page_index].allocated == FREE_PAGE) || (page_table[addr_page_index].bytes_used == 0) || (page_table[addr_page_index].gen != from_space) - /* Skip if already marked dont_move */ + /* Skip if already marked dont_move. */ || (page_table[addr_page_index].dont_move != 0)) return; + /* (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; - /* Check the offset within the page */ - if (((int)addr & 0xfff) > page_table[addr_page_index].bytes_used) + /* quick check 2: Check the offset within the page. + * + * FIXME: The mask should have a symbolic name, and ideally should + * be derived from page size instead of hardwired to 0xfff. + * (Also fix other uses of 0xfff, elsewhere.) */ + if (((unsigned)addr & 0xfff) > page_table[addr_page_index].bytes_used) return; - if (enable_pointer_filter && !valid_dynamic_space_pointer(addr)) + /* Filter out anything which can't be a pointer to a Lisp object + * (or, as a special case which also requires dont_move, a return + * address referring to something in a CodeObject). This is + * expensive but important, since it vastly reduces the + * probability that random garbage will be bogusly interpreter as + * a pointer which prevents a page from moving. */ + if (!possibly_valid_dynamic_space_pointer(addr)) return; /* Work backwards to find a page with a first_object_offset of 0. @@ -4493,24 +4381,25 @@ preserve_pointer(void *addr) * gen. Assumes the first_object_offset is negative or zero. */ first_page = addr_page_index; while (page_table[first_page].first_object_offset != 0) { - first_page--; + --first_page; /* Do some checks. */ gc_assert(page_table[first_page].bytes_used == 4096); gc_assert(page_table[first_page].gen == from_space); gc_assert(page_table[first_page].allocated == region_allocation); } - /* Adjust any large objects before promotion as they won't be copied - * after promotion. */ + /* Adjust any large objects before promotion as they won't be + * copied after promotion. */ if (page_table[first_page].large_object) { maybe_adjust_large_object(page_address(first_page)); - /* If a large object has shrunk then addr may now point to a free - * area in which case it's ignored here. Note it gets through the - * valid pointer test above because the tail looks like conses. */ + /* If a large object has shrunk then addr may now point to a + * free area in which case it's ignored here. Note it gets + * through the valid pointer test above because the tail looks + * like conses. */ if ((page_table[addr_page_index].allocated == FREE_PAGE) || (page_table[addr_page_index].bytes_used == 0) /* Check the offset within the page. */ - || (((int)addr & 0xfff) + || (((unsigned)addr & 0xfff) > page_table[addr_page_index].bytes_used)) { FSHOW((stderr, "weird? ignore ptr 0x%x to freed area of large object\n", @@ -4529,17 +4418,18 @@ preserve_pointer(void *addr) /* Mark the page static. */ page_table[i].dont_move = 1; - /* Move the page to the new_space. XX I'd rather not do this but - * the GC logic is not quite able to copy with the static pages - * remaining in the from space. This also requires the generation - * bytes_allocated counters be updated. */ + /* Move the page to the new_space. XX I'd rather not do this + * but the GC logic is not quite able to copy with the static + * pages remaining in the from space. This also requires the + * generation bytes_allocated counters be updated. */ page_table[i].gen = new_space; generations[new_space].bytes_allocated += page_table[i].bytes_used; generations[from_space].bytes_allocated -= page_table[i].bytes_used; - /* It is essential that the pages are not write protected as they - * may have pointers into the old-space which need scavenging. They - * shouldn't be write protected at this stage. */ + /* It is essential that the pages are not write protected as + * they may have pointers into the old-space which need + * scavenging. They shouldn't be write protected at this + * stage. */ gc_assert(!page_table[i].write_protected); /* Check whether this is the last page in this contiguous block.. */ @@ -4554,85 +4444,21 @@ preserve_pointer(void *addr) /* Check that the page is now static. */ gc_assert(page_table[addr_page_index].dont_move != 0); - - return; } - -#ifdef CONTROL_STACKS -/* Scavenge the thread stack conservative roots. */ -static void -scavenge_thread_stacks(void) -{ - lispobj thread_stacks = SymbolValue(CONTROL_STACKS); - int type = TypeOf(thread_stacks); - - if (LowtagOf(thread_stacks) == type_OtherPointer) { - struct vector *vector = (struct vector *) PTR(thread_stacks); - int length, i; - if (TypeOf(vector->header) != type_SimpleVector) - return; - length = fixnum_value(vector->length); - for (i = 0; i < length; i++) { - lispobj stack_obj = vector->data[i]; - if (LowtagOf(stack_obj) == type_OtherPointer) { - struct vector *stack = (struct vector *) PTR(stack_obj); - int vector_length; - if (TypeOf(stack->header) != - type_SimpleArrayUnsignedByte32) { - return; - } - vector_length = fixnum_value(stack->length); - if ((gencgc_verbose > 1) && (vector_length <= 0)) - FSHOW((stderr, - "/weird? control stack vector length %d\n", - vector_length)); - if (vector_length > 0) { - lispobj *stack_pointer = (lispobj*)stack->data[0]; - if ((stack_pointer < control_stack) || - (stack_pointer > control_stack_end)) - lose("invalid stack pointer %x", - (unsigned)stack_pointer); - if ((stack_pointer > control_stack) && - (stack_pointer < control_stack_end)) { - unsigned int length = ((int)control_stack_end - - (int)stack_pointer) / 4; - int j; - if (length >= vector_length) { - lose("invalid stack size %d >= vector length %d", - length, - vector_length); - } - if (gencgc_verbose > 1) { - FSHOW((stderr, - "scavenging %d words of control stack %d of length %d words.\n", - length, i, vector_length)); - } - for (j = 0; j < length; j++) { - preserve_pointer((void *)stack->data[1+j]); - } - } - } - } - } - } -} -#endif - /* If the given page is not write-protected, then scan it for pointers * to younger generations or the top temp. generation, if no * suspicious pointers are found then the page is write-protected. * - * Care is taken to check for pointers to the current gc_alloc region - * if it is a younger generation or the temp. generation. This frees - * the caller from doing a gc_alloc_update_page_tables. Actually the - * gc_alloc_generation does not need to be checked as this is only - * called from scavenge_generation when the gc_alloc generation is + * Care is taken to check for pointers to the current gc_alloc() + * region if it is a younger generation or the temp. generation. This + * frees the caller from doing a gc_alloc_update_page_tables(). Actually + * the gc_alloc_generation does not need to be checked as this is only + * called from scavenge_generation() when the gc_alloc generation is * younger, so it just checks if there is a pointer to the current * region. * - * We return 1 if the page was write-protected, else 0. - */ + * We return 1 if the page was write-protected, else 0. */ static int update_page_write_prot(int page) { @@ -4666,7 +4492,7 @@ update_page_write_prot(int page) && ((page_table[index].gen < gen) || (page_table[index].gen == NUM_GENERATIONS))) - /* Or does it point within a current gc_alloc region? */ + /* Or does it point within a current gc_alloc() region? */ || ((boxed_region.start_addr <= ptr) && (ptr <= boxed_region.free_pointer)) || ((unboxed_region.start_addr <= ptr) @@ -4750,7 +4576,7 @@ scavenge_generation(int generation) /* Now work forward until the end of this contiguous area * is found. A small area is preferred as there is a * better chance of its pages being write-protected. */ - for (last_page = i; ;last_page++) + for (last_page = i; ; last_page++) /* Check whether this is the last page in this contiguous * block. */ if ((page_table[last_page].bytes_used < 4096) @@ -4805,14 +4631,13 @@ scavenge_generation(int generation) && (page_table[i].bytes_used != 0) && (page_table[i].gen == generation) && (page_table[i].write_protected_cleared != 0)) { - FSHOW((stderr, "/scavenge_generation %d\n", generation)); + FSHOW((stderr, "/scavenge_generation() %d\n", generation)); FSHOW((stderr, "/page bytes_used=%d first_object_offset=%d dont_move=%d\n", page_table[i].bytes_used, page_table[i].first_object_offset, page_table[i].dont_move)); - lose("write-protected page %d written to in scavenge_generation", - i); + lose("write to protected page %d in scavenge_generation()", i); } } #endif @@ -4825,7 +4650,7 @@ scavenge_generation(int generation) * newspace generation. * * To help improve the efficiency, areas written are recorded by - * gc_alloc and only these scavenged. Sometimes a little more will be + * gc_alloc() and only these scavenged. Sometimes a little more will be * scavenged, but this causes no harm. An easy check is done that the * scavenged bytes equals the number allocated in the previous * scavenge. @@ -4836,7 +4661,7 @@ scavenge_generation(int generation) * * Write-protected pages could potentially be written by alloc however * to avoid having to handle re-scavenging of write-protected pages - * gc_alloc does not write to write-protected pages. + * gc_alloc() does not write to write-protected pages. * * New areas of objects allocated are recorded alternatively in the two * new_areas arrays below. */ @@ -4867,15 +4692,15 @@ scavenge_newspace_generation_one_scan(int generation) /* The scavenge will start at the first_object_offset of page i. * - * We need to find the full extent of this contiguous block in case - * objects span pages. + * We need to find the full extent of this contiguous + * block in case objects span pages. * - * Now work forward until the end of this contiguous area is - * found. A small area is preferred as there is a better chance - * of its pages being write-protected. */ + * Now work forward until the end of this contiguous area + * is found. A small area is preferred as there is a + * better chance of its pages being write-protected. */ for (last_page = i; ;last_page++) { - /* Check whether this is the last page in this contiguous - * block */ + /* Check whether this is the last page in this + * 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) @@ -4885,9 +4710,9 @@ scavenge_newspace_generation_one_scan(int generation) break; } - /* Do a limited check for write_protected pages. If all pages - * are write_protected then no need to scavenge. Except if the - * pages are marked dont_move. */ + /* Do a limited check for write-protected pages. If all + * pages are write-protected then no need to scavenge, + * except if the pages are marked dont_move. */ { int j, all_wp = 1; for (j = i; j <= last_page; j++) @@ -4896,60 +4721,36 @@ scavenge_newspace_generation_one_scan(int generation) all_wp = 0; break; } -#if !SC_NS_GEN_CK - if (all_wp == 0) -#endif - { - int size; - - /* Calculate the size. */ - if (last_page == i) - size = (page_table[last_page].bytes_used - - page_table[i].first_object_offset)/4; - else - size = (page_table[last_page].bytes_used - + (last_page-i)*4096 - - page_table[i].first_object_offset)/4; - - { -#if SC_NS_GEN_CK - int a1 = bytes_allocated; -#endif - /* FSHOW((stderr, - "/scavenge(%x,%d)\n", - page_address(i) - + page_table[i].first_object_offset, - size)); */ - new_areas_ignore_page = last_page; + if (!all_wp) { + int size; - scavenge(page_address(i)+page_table[i].first_object_offset,size); + /* Calculate the size. */ + if (last_page == i) + size = (page_table[last_page].bytes_used + - page_table[i].first_object_offset)/4; + else + size = (page_table[last_page].bytes_used + + (last_page-i)*4096 + - page_table[i].first_object_offset)/4; + + { + new_areas_ignore_page = last_page; + + scavenge(page_address(i) + + page_table[i].first_object_offset, + size); -#if SC_NS_GEN_CK - /* Flush the alloc regions updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); - - if ((all_wp != 0) && (a1 != bytes_allocated)) { - FSHOW((stderr, - "alloc'ed over %d to %d\n", - i, last_page)); - FSHOW((stderr, - "/page: bytes_used=%d first_object_offset=%d dont_move=%d wp=%d wpc=%d\n", - page_table[i].bytes_used, - page_table[i].first_object_offset, - page_table[i].dont_move, - page_table[i].write_protected, - page_table[i].write_protected_cleared)); - } -#endif - } } + } } i = last_page; } } + FSHOW((stderr, + "/done with one full scan of newspace generation %d\n", + generation)); } /* Do a complete scavenge of the newspace generation. */ @@ -4958,28 +4759,19 @@ scavenge_newspace_generation(int generation) { int i; - /* the new_areas array currently being written to by gc_alloc */ - struct new_area (*current_new_areas)[] = &new_areas_1; + /* the new_areas array currently being written to by gc_alloc() */ + struct new_area (*current_new_areas)[] = &new_areas_1; int current_new_areas_index; - int current_new_areas_allocated; /* the new_areas created but the previous scavenge cycle */ - struct new_area (*previous_new_areas)[] = NULL; + struct new_area (*previous_new_areas)[] = NULL; int previous_new_areas_index; - int previous_new_areas_allocated; - -#define SC_NS_GEN_CK 0 -#if SC_NS_GEN_CK - /* Clear the write_protected_cleared flags on all pages. */ - for (i = 0; i < NUM_PAGES; i++) - page_table[i].write_protected_cleared = 0; -#endif /* Flush the current regions updating the tables. */ gc_alloc_update_page_tables(0, &boxed_region); gc_alloc_update_page_tables(1, &unboxed_region); - /* Turn on the recording of new areas by gc_alloc. */ + /* Turn on the recording of new areas by gc_alloc(). */ new_areas = current_new_areas; new_areas_index = 0; @@ -5019,12 +4811,13 @@ scavenge_newspace_generation(int generation) else current_new_areas = &new_areas_1; - /* Set up for gc_alloc. */ + /* Set up for gc_alloc(). */ new_areas = current_new_areas; new_areas_index = 0; /* Check whether previous_new_areas had overflowed. */ if (previous_new_areas_index >= NUM_NEW_AREAS) { + /* New areas of objects allocated have been lost so need to do a * full scan to be sure! If this becomes a problem try * increasing NUM_NEW_AREAS. */ @@ -5043,20 +4836,18 @@ scavenge_newspace_generation(int generation) /* Flush the current regions updating the tables. */ gc_alloc_update_page_tables(0, &boxed_region); gc_alloc_update_page_tables(1, &unboxed_region); + } else { + /* Work through previous_new_areas. */ for (i = 0; i < previous_new_areas_index; i++) { + /* FIXME: All these bare *4 and /4 should be something + * like BYTES_PER_WORD or WBYTES. */ int page = (*previous_new_areas)[i].page; int offset = (*previous_new_areas)[i].offset; int size = (*previous_new_areas)[i].size / 4; gc_assert((*previous_new_areas)[i].size % 4 == 0); - - /* FIXME: All these bare *4 and /4 should be something - * like BYTES_PER_WORD or WBYTES. */ - /*FSHOW((stderr, - "/S page %d offset %d size %d\n", - page, offset, size*4));*/ scavenge(page_address(page)+offset, size); } @@ -5072,7 +4863,7 @@ scavenge_newspace_generation(int generation) current_new_areas_index));*/ } - /* Turn off recording of areas allocated by gc_alloc. */ + /* Turn off recording of areas allocated by gc_alloc(). */ record_new_objects = 0; #if SC_NS_GEN_CK @@ -5099,14 +4890,13 @@ scavenge_newspace_generation(int generation) static void unprotect_oldspace(void) { - int bytes_freed = 0; int i; for (i = 0; i < last_free_page; i++) { if ((page_table[i].allocated != FREE_PAGE) && (page_table[i].bytes_used != 0) && (page_table[i].gen == from_space)) { - void *page_start, *addr; + void *page_start; page_start = (void *)page_address(i); @@ -5212,6 +5002,7 @@ free_oldspace(void) return bytes_freed; } +#if 0 /* Print some information about a pointer at the given address. */ static void print_ptr(lispobj *addr) @@ -5221,7 +5012,7 @@ print_ptr(lispobj *addr) if (pi1 != -1) fprintf(stderr," %x: page %d alloc %d gen %d bytes_used %d offset %d dont_move %d\n", - addr, + (unsigned int) addr, pi1, page_table[pi1].allocated, page_table[pi1].gen, @@ -5239,28 +5030,29 @@ print_ptr(lispobj *addr) *(addr+3), *(addr+4)); } +#endif extern int undefined_tramp; static void -verify_space(lispobj*start, size_t words) +verify_space(lispobj *start, size_t words) { - int dynamic_space = (find_page_index((void*)start) != -1); - int readonly_space = - (READ_ONLY_SPACE_START <= (int)start && - (int)start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); + int is_in_dynamic_space = (find_page_index((void*)start) != -1); + int is_in_readonly_space = + (READ_ONLY_SPACE_START <= (unsigned)start && + (unsigned)start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); while (words > 0) { size_t count = 1; lispobj thing = *(lispobj*)start; - if (Pointerp(thing)) { + if (is_lisp_pointer(thing)) { int page_index = find_page_index((void*)thing); int to_readonly_space = (READ_ONLY_SPACE_START <= thing && thing < SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); int to_static_space = - ((int)static_space <= thing && + (STATIC_SPACE_START <= thing && thing < SymbolValue(STATIC_SPACE_FREE_POINTER)); /* Does it point to the dynamic space? */ @@ -5271,12 +5063,12 @@ verify_space(lispobj*start, size_t words) && (page_table[page_index].bytes_used == 0)) lose ("Ptr %x @ %x sees free page.", thing, start); /* Check that it doesn't point to a forwarding pointer! */ - if (*((lispobj *)PTR(thing)) == 0x01) { + if (*((lispobj *)native_pointer(thing)) == 0x01) { lose("Ptr %x @ %x sees forwarding ptr.", thing, start); } /* Check that its not in the RO space as it would then be a * pointer from the RO to the dynamic space. */ - if (readonly_space) { + if (is_in_readonly_space) { lose("ptr to dynamic space %x from RO space %x", thing, start); } @@ -5284,12 +5076,12 @@ verify_space(lispobj*start, size_t words) * it down a lot (so it's commented out). * * FIXME: Add a variable to enable this dynamically. */ - /* if (!valid_dynamic_space_pointer((lispobj *)thing)) { + /* 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 - && (thing != (int)&undefined_tramp)) { + && (thing != (unsigned)&undefined_tramp)) { lose("Ptr %x @ %x sees junk.", thing, start); } } @@ -5297,47 +5089,51 @@ 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; /* Check that it's not in the dynamic space. * FIXME: Isn't is supposed to be OK for code * objects to be in the dynamic space these days? */ - if (dynamic_space + 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) { @@ -5353,12 +5149,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 *) PTR(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); @@ -5369,57 +5166,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: @@ -5435,19 +5232,25 @@ verify_space(lispobj*start, size_t words) static void verify_gc(void) { + /* FIXME: It would be nice to make names consistent so that + * foo_size meant size *in* *bytes* instead of size in some + * arbitrary units. (Yes, this caused a bug, how did you guess?:-) + * Some counts of lispobjs are called foo_count; it might be good + * to grep for all foo_size and rename the appropriate ones to + * foo_count. */ int read_only_space_size = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - (lispobj*)READ_ONLY_SPACE_START; int static_space_size = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER) - - (lispobj*)static_space; + - (lispobj*)STATIC_SPACE_START; int binding_stack_size = (lispobj*)SymbolValue(BINDING_STACK_POINTER) - (lispobj*)BINDING_STACK_START; verify_space((lispobj*)READ_ONLY_SPACE_START, read_only_space_size); - verify_space((lispobj*)static_space, static_space_size); - verify_space((lispobj*)BINDING_STACK_START, binding_stack_size); + verify_space((lispobj*)STATIC_SPACE_START , static_space_size); + verify_space((lispobj*)BINDING_STACK_START , binding_stack_size); } static void @@ -5488,7 +5291,7 @@ verify_generation(int generation) } } -/* Check the all the free space is zero filled. */ +/* Check that all the free space is zero filled. */ static void verify_zero_fill(void) { @@ -5508,7 +5311,7 @@ verify_zero_fill(void) } else { int free_bytes = 4096 - page_table[page].bytes_used; if (free_bytes > 0) { - int *start_addr = (int *)((int)page_address(page) + int *start_addr = (int *)((unsigned)page_address(page) + page_table[page].bytes_used); int size = free_bytes / 4; int i; @@ -5581,15 +5384,14 @@ write_protect_generation_pages(int generation) } } -/* Garbage collect a generation. If raise is 0 the remains of the +/* Garbage collect a generation. If raise is 0 then the remains of the * generation are not raised to the next generation. */ static void garbage_collect_generation(int generation, int raise) { - unsigned long allocated = bytes_allocated; unsigned long bytes_freed; unsigned long i; - unsigned long read_only_space_size, static_space_size; + unsigned long static_space_size; gc_assert(generation <= (NUM_GENERATIONS-1)); @@ -5628,35 +5430,36 @@ garbage_collect_generation(int generation, int raise) /* Un-write-protect the old-space pages. This is essential for the * promoted pages as they may contain pointers into the old-space * which need to be scavenged. It also helps avoid unnecessary page - * faults as forwarding pointer are written into them. They need to + * faults as forwarding pointers are written into them. They need to * be un-protected anyway before unmapping later. */ unprotect_oldspace(); /* Scavenge the stack's conservative roots. */ { - lispobj **ptr; - for (ptr = (lispobj **)CONTROL_STACK_END-1; - ptr > (lispobj **)&raise; ptr--) + void **ptr; + for (ptr = (void **)CONTROL_STACK_END - 1; + ptr > (void **)&raise; + ptr--) { preserve_pointer(*ptr); + } } -#ifdef CONTROL_STACKS - scavenge_thread_stacks(); -#endif +#if QSHOW if (gencgc_verbose > 1) { int num_dont_move_pages = count_dont_move_pages(); - FSHOW((stderr, - "/non-movable pages due to conservative pointers = %d (%d bytes)\n", - num_dont_move_pages, - /* FIXME: 4096 should be symbolic constant here and - * prob'ly elsewhere too. */ - num_dont_move_pages * 4096)); + fprintf(stderr, + "/non-movable pages due to conservative pointers = %d (%d bytes)\n", + num_dont_move_pages, + /* FIXME: 4096 should be symbolic constant here and + * prob'ly elsewhere too. */ + num_dont_move_pages * 4096); } +#endif /* Scavenge all the rest of the roots. */ /* Scavenge the Lisp functions of the interrupt handlers, taking - * care to avoid SIG_DFL, SIG_IGN. */ + * care to avoid SIG_DFL and SIG_IGN. */ for (i = 0; i < NSIG; i++) { union interrupt_handler handler = interrupt_handlers[i]; if (!ARE_SAME_HANDLER(handler.c, SIG_IGN) && @@ -5666,38 +5469,59 @@ garbage_collect_generation(int generation, int raise) } /* Scavenge the binding stack. */ - scavenge(binding_stack, - (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack); - + scavenge((lispobj *) BINDING_STACK_START, + (lispobj *)SymbolValue(BINDING_STACK_POINTER) - + (lispobj *)BINDING_STACK_START); + + /* The original CMU CL code had scavenge-read-only-space code + * controlled by the Lisp-level variable + * *SCAVENGE-READ-ONLY-SPACE*. It was disabled by default, and it + * wasn't documented under what circumstances it was useful or + * safe to turn it on, so it's been turned off in SBCL. If you + * want/need this functionality, and can test and document it, + * please submit a patch. */ +#if 0 if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) { - read_only_space_size = - (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - - read_only_space; + unsigned long read_only_space_size = + (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - + (lispobj*)READ_ONLY_SPACE_START; FSHOW((stderr, "/scavenge read only space: %d bytes\n", read_only_space_size * sizeof(lispobj))); - scavenge(read_only_space, read_only_space_size); + scavenge( (lispobj *) READ_ONLY_SPACE_START, read_only_space_size); } +#endif - static_space_size = (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER) - - static_space; - if (gencgc_verbose > 1) + /* Scavenge static space. */ + static_space_size = + (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER) - + (lispobj *)STATIC_SPACE_START; + if (gencgc_verbose > 1) { FSHOW((stderr, "/scavenge static space: %d bytes\n", static_space_size * sizeof(lispobj))); - scavenge(static_space, static_space_size); + } + scavenge( (lispobj *) STATIC_SPACE_START, static_space_size); /* All generations but the generation being GCed need to be * scavenged. The new_space generation needs special handling as * objects may be moved in - it is handled separately below. */ - for (i = 0; i < NUM_GENERATIONS; i++) - if ((i != generation) && (i != new_space)) + for (i = 0; i < NUM_GENERATIONS; i++) { + if ((i != generation) && (i != new_space)) { scavenge_generation(i); + } + } /* Finally scavenge the new_space generation. Keep going until no * more objects are moved into the new generation */ scavenge_newspace_generation(new_space); + /* FIXME: I tried reenabling this check when debugging unrelated + * GC weirdness ca. sbcl-0.6.12.45, and it failed immediately. + * Since the current GC code seems to work well, I'm guessing that + * this debugging code is just stale, but I haven't tried to + * figure it out. It should be figured out and then either made to + * work or just deleted. */ #define RESCAN_CHECK 0 #if RESCAN_CHECK /* As a check re-scavenge the newspace once; no new objects should @@ -5768,7 +5592,7 @@ garbage_collect_generation(int generation, int raise) ++generations[generation].num_gc; } -/* Update last_free_page then ALLOCATION_POINTER */ +/* Update last_free_page, then SymbolValue(ALLOCATION_POINTER). */ int update_x86_dynamic_space_free_pointer(void) { @@ -5784,6 +5608,7 @@ update_x86_dynamic_space_free_pointer(void) SetSymbolValue(ALLOCATION_POINTER, (lispobj)(((char *)heap_base) + last_free_page*4096)); + return 0; /* dummy value: return something ... */ } /* GC all generations below last_gen, raising their objects to the @@ -5840,7 +5665,7 @@ collect_garbage(unsigned last_gen) if (gencgc_verbose > 1) { FSHOW((stderr, - "Starting GC of generation %d with raise=%d alloc=%d trig=%d GCs=%d\n", + "starting GC of generation %d with raise=%d alloc=%d trig=%d GCs=%d\n", gen, raise, generations[gen].bytes_allocated, @@ -5848,8 +5673,8 @@ collect_garbage(unsigned last_gen) generations[gen].num_gc)); } - /* If an older generation is being filled then update its memory - * age. */ + /* If an older generation is being filled, then update its + * memory age. */ if (raise == 1) { generations[gen+1].cum_sum_bytes_allocated += generations[gen+1].bytes_allocated; @@ -5900,15 +5725,15 @@ collect_garbage(unsigned last_gen) write_protect_generation_pages(gen_to_wp); } - /* Set gc_alloc back to generation 0. The current regions should - * be flushed after the above GCs */ + /* Set gc_alloc() back to generation 0. The current regions should + * be flushed after the above GCs. */ gc_assert((boxed_region.free_pointer - boxed_region.start_addr) == 0); gc_alloc_generation = 0; update_x86_dynamic_space_free_pointer(); - /* This is now done by Lisp SCRUB-CONTROL-STACK in Lisp SUB-GC, so we - * needn't do it here: */ + /* 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; @@ -5920,7 +5745,7 @@ collect_garbage(unsigned last_gen) /* This is called by Lisp PURIFY when it is finished. All live objects * will have been moved to the RO and Static heaps. The dynamic space * will need a full re-initialization. We don't bother having Lisp - * PURIFY flush the current gc_alloc region, as the page_tables are + * PURIFY flush the current gc_alloc() region, as the page_tables are * re-initialized, and every page is zeroed to be sure. */ void gc_free_heap(void) @@ -5958,14 +5783,11 @@ gc_free_heap(void) addr); } } else if (gencgc_zero_check_during_free_heap) { - int *page_start, i; - /* Double-check that the page is zero filled. */ + int *page_start, i; gc_assert(page_table[page].allocated == FREE_PAGE); gc_assert(page_table[page].bytes_used == 0); - - page_start = (int *)page_address(i); - + page_start = (int *)page_address(page); for (i=0; i<1024; i++) { if (page_start[i] != 0) { lose("free region not zero at %x", page_start + i); @@ -5991,14 +5813,13 @@ gc_free_heap(void) if (gencgc_verbose > 1) print_generation_stats(0); - /* Initialize gc_alloc */ + /* 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); @@ -6030,7 +5851,7 @@ gc_init(void) gc_init_tables(); - heap_base = (void*)DYNAMIC_0_SPACE_START; + heap_base = (void*)DYNAMIC_SPACE_START; /* Initialize each page structure. */ for (i = 0; i < NUM_PAGES; i++) { @@ -6044,7 +5865,9 @@ gc_init(void) bytes_allocated = 0; - /* Initialize the generations. */ + /* Initialize the generations. + * + * FIXME: very similar to code in gc_free_heap(), should be shared */ for (i = 0; i < NUM_GENERATIONS; i++) { generations[i].alloc_start_page = 0; generations[i].alloc_unboxed_start_page = 0; @@ -6060,14 +5883,15 @@ gc_init(void) generations[i].min_av_mem_age = 0.75; } - /* Initialize gc_alloc. */ + /* Initialize gc_alloc. + * + * FIXME: identical with code in gc_free_heap(), should be shared */ 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); @@ -6089,7 +5913,7 @@ void gencgc_pickup_dynamic(void) { int page = 0; - int addr = DYNAMIC_0_SPACE_START; + int addr = DYNAMIC_SPACE_START; int alloc_ptr = SymbolValue(ALLOCATION_POINTER); /* Initialize the first region. */ @@ -6099,7 +5923,7 @@ gencgc_pickup_dynamic(void) page_table[page].bytes_used = 4096; page_table[page].large_object = 0; page_table[page].first_object_offset = - (void *)DYNAMIC_0_SPACE_START - page_address(page); + (void *)DYNAMIC_SPACE_START - page_address(page); addr += 4096; page++; } while (addr < alloc_ptr); @@ -6192,7 +6016,7 @@ alloc(int nbytes) SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1)); goto retry1; } - /* Call gc_alloc. */ + /* Call gc_alloc(). */ boxed_region.free_pointer = current_region_free_pointer; { void *new_obj = gc_alloc(nbytes); @@ -6207,7 +6031,7 @@ alloc(int nbytes) retry2: /* At least wrap this allocation in a pseudo atomic to prevent - * gc_alloc from being re-entered. */ + * gc_alloc() from being re-entered. */ SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0)); SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1)); @@ -6252,7 +6076,7 @@ alloc(int nbytes) goto retry2; } - /* Else call gc_alloc. */ + /* Else call gc_alloc(). */ boxed_region.free_pointer = current_region_free_pointer; result = gc_alloc(nbytes); current_region_free_pointer = boxed_region.free_pointer; @@ -6261,8 +6085,7 @@ alloc(int nbytes) alloc_entered--; SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0)); if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED) != 0) { - /* Handle any interrupts that occurred during - * gc_alloc(..). */ + /* Handle any interrupts that occurred during gc_alloc(..). */ do_pending_interrupt(); goto retry2; } @@ -6287,21 +6110,23 @@ clear_auto_gc_trigger(void) auto_gc_trigger = 0; } -/* Find the code object for the given pc, or return NULL on failure. */ -lispobj* +/* Find the code object for the given pc, or return NULL on failure. + * + * FIXME: PC shouldn't be lispobj*, should it? Maybe void*? */ +lispobj * component_ptr_from_pc(lispobj *pc) { lispobj *object = NULL; - if (object = search_read_only_space(pc)) + if ( (object = search_read_only_space(pc)) ) ; - else if (object = search_static_space(pc)) + else if ( (object = search_static_space(pc)) ) ; else 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); @@ -6312,6 +6137,8 @@ component_ptr_from_pc(lispobj *pc) * catch GENCGC-related write-protect violations */ +void unhandled_sigmemoryfault(void); + /* Depending on which OS we're running under, different signals might * be raised for a violation of write protection in the heap. This * function factors out the common generational GC magic which needs @@ -6334,6 +6161,10 @@ gencgc_handle_wp_violation(void* fault_addr) /* Check whether the fault is within the dynamic space. */ if (page_index == (-1)) { + /* It can be helpful to be able to put a breakpoint on this + * case to help diagnose low-level problems. */ + unhandled_sigmemoryfault(); + /* not within the dynamic space -- not our responsibility */ return 0; @@ -6354,3 +6185,11 @@ gencgc_handle_wp_violation(void* fault_addr) return 1; } } + +/* This is to be called when we catch a SIGSEGV/SIGBUS, determine that + * it's not just a case of the program hitting the write barrier, and + * are about to let Lisp deal with it. It's basically just a + * convenient place to set a gdb breakpoint. */ +void +unhandled_sigmemoryfault() +{}