X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;h=7c1eeab3648e3ee98360caf0efb86b40a2bfc51f;hb=872175cd9cb5b4966a36d4bd92421cc407a0355b;hp=6130e4f1f5b028dcbaed0caf0dd631c10a4c9883;hpb=fbe6e22af842835f7c70309f4d48064ca3984ad0;p=sbcl.git diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c index 6130e4f..7c1eeab 100644 --- a/src/runtime/gencgc.c +++ b/src/runtime/gencgc.c @@ -47,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 @@ -71,26 +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 substantially reduces the - * number of invalid pointers accepted. - * - * FIXME: This is basically constant=1. It will probably degrade - * interrupt safety during object initialization. But I don't think we - * should do without it -- the possibility of the GC being too - * conservative and hence running out of memory is also. Perhaps the - * interrupt safety issue could be fixed by making the initialization - * code do WITHOUT-GCING or WITHOUT-INTERRUPTS until the appropriate - * type bits have been set. (That might be necessary anyway, in order - * to keep interrupt code's allocation operations from stepping on the - * interrupted code's allocations.) Or perhaps it could be fixed by - * making sure that uninitialized memory is zero, reserving the - * all-zero case for uninitialized memory, and making the - * is-it-possibly-a-valid-pointer code check for all-zero and return - * true in that case. Then after either fix, we could get rid of this - * variable and simply hardwire the system always to do pointer - * filtering. */ -boolean enable_pointer_filter = 1; /* * debugging @@ -173,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)); } @@ -198,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 @@ -308,22 +288,21 @@ count_dont_move_pages(void) { int i; int count = 0; - - for (i = 0; i < last_free_page; i++) - if ((page_table[i].allocated != 0) - && (page_table[i].dont_move != 0)) - count++; + 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; @@ -395,7 +374,7 @@ print_generation_stats(int verbose) /* FIXME: should take FILE argument */ } 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.4f\n", i, @@ -482,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. @@ -534,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 && @@ -597,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); @@ -605,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, @@ -790,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)); */ @@ -914,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; @@ -937,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)); */ @@ -956,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; @@ -971,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 && @@ -1038,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, @@ -1139,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; @@ -1213,8 +1201,8 @@ static void /* 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; @@ -1222,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; @@ -1252,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. */ @@ -1302,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; @@ -1329,8 +1317,8 @@ static void 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; @@ -1343,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; @@ -1364,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)); } /* @@ -1423,7 +1409,7 @@ 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); @@ -1434,7 +1420,7 @@ copy_object(lispobj object, int nwords) new = gc_quick_alloc(nwords*4); dest = new; - source = (lispobj *) PTR(object); + source = (lispobj *) native_pointer(object); /* Copy the object. */ while (nwords > 0) { @@ -1463,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); @@ -1569,7 +1555,7 @@ copy_large_object(lispobj object, int nwords) new = gc_quick_alloc_large(nwords*4); dest = new; - source = (lispobj *) PTR(object); + source = (lispobj *) native_pointer(object); /* Copy the object. */ while (nwords > 0) { @@ -1593,7 +1579,7 @@ 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); @@ -1604,7 +1590,7 @@ copy_unboxed_object(lispobj object, int nwords) new = gc_quick_alloc_unboxed(nwords*4); dest = new; - source = (lispobj *) PTR(object); + source = (lispobj *) native_pointer(object); /* Copy the object. */ while (nwords > 0) { @@ -1638,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); @@ -1733,7 +1719,7 @@ copy_large_unboxed_object(lispobj object, int nwords) 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) { @@ -1771,11 +1757,11 @@ scavenge(lispobj *start, long n_words) gc_assert(object != 0x01); /* not a forwarding pointer */ - if (Pointerp(object)) { + 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); + lispobj *ptr = (lispobj *)native_pointer(object); lispobj first_word = *ptr; if (first_word == 0x01) { /* Yes, there's a forwarding pointer. */ @@ -1818,10 +1804,10 @@ scav_function_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. */ @@ -1842,7 +1828,7 @@ 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; @@ -1896,8 +1882,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 @@ -2079,7 +2067,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 == type_UnboundMarker) || + !is_lisp_pointer(fixups)) { /* Check for possible errors. */ if (check_code_fixups) sniff_code_object(new_code, displacement); @@ -2093,14 +2082,15 @@ 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");*/ @@ -2166,7 +2156,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) @@ -2196,13 +2186,13 @@ trans_code(struct code *code) struct function *fheaderp, *nfheaderp; lispobj nfheaderl; - fheaderp = (struct function *) PTR(fheaderl); + fheaderp = (struct function *) native_pointer(fheaderl); gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); /* Calculate the new function pointer and the new */ /* function header. */ nfheaderl = fheaderl + displacement; - nfheaderp = (struct function *) PTR(nfheaderl); + nfheaderp = (struct function *) native_pointer(nfheaderl); /* Set forwarding pointer. */ ((lispobj *)fheaderp)[0] = 0x01; @@ -2246,9 +2236,9 @@ scav_code_header(lispobj *where, lispobj object) entry_point != NIL; entry_point = function_ptr->next) { - gc_assert(Pointerp(entry_point)); + gc_assert(is_lisp_pointer(entry_point)); - function_ptr = (struct function *) PTR(entry_point); + function_ptr = (struct function *) native_pointer(entry_point); gc_assert(TypeOf(function_ptr->header) == type_FunctionHeader); scavenge(&function_ptr->name, 1); @@ -2264,7 +2254,7 @@ trans_code_header(lispobj object) { struct code *ncode; - ncode = trans_code((struct code *) PTR(object)); + ncode = trans_code((struct code *) native_pointer(object)); return (lispobj) ncode | type_OtherPointer; } @@ -2302,7 +2292,7 @@ trans_return_pc_header(lispobj object) SHOW("/trans_return_pc_header: Will this work?"); - return_pc = (struct function *) PTR(object); + return_pc = (struct function *) native_pointer(object); offset = HeaderValue(return_pc->header) * 4; /* Transport the whole code object. */ @@ -2349,7 +2339,7 @@ trans_function_header(lispobj object) unsigned long offset; struct code *code, *ncode; - fheader = (struct function *) PTR(object); + fheader = (struct function *) native_pointer(object); offset = HeaderValue(fheader->header) * 4; /* Transport the whole code object. */ @@ -2373,7 +2363,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; @@ -2394,20 +2384,20 @@ 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; @@ -2422,7 +2412,7 @@ trans_list(lispobj object) 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)); @@ -2444,10 +2434,10 @@ trans_list(lispobj object) struct cons *cdr_cons, *new_cdr_cons; if (LowtagOf(cdr) != type_ListPointer || !from_space_p(cdr) - || (*((lispobj *)PTR(cdr)) == 0x01)) + || (*((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)); @@ -2482,10 +2472,10 @@ 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); @@ -2496,7 +2486,7 @@ 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; @@ -2544,9 +2534,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); @@ -2559,9 +2549,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); @@ -2622,9 +2612,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); @@ -2638,9 +2628,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); @@ -2688,13 +2678,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); @@ -2754,10 +2744,10 @@ scav_vector(lispobj *where, lispobj object) /* Scavenge element 0, which may be a hash-table structure. */ scavenge(where+2, 1); - if (!Pointerp(where[2])) { + if (!is_lisp_pointer(where[2])) { lose("no pointer at %x in hash table", where[2]); } - hash_table = (lispobj *)PTR(where[2]); + hash_table = (lispobj *)native_pointer(where[2]); /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/ if (TypeOf(hash_table[0]) != type_InstanceHeader) { lose("hash table not instance (%x at %x)", hash_table[0], hash_table); @@ -2766,14 +2756,14 @@ scav_vector(lispobj *where, lispobj object) /* Scavenge element 1, which should be some internal symbol that * the hash table code reserves for marking empty slots. */ scavenge(where+3, 1); - if (!Pointerp(where[3])) { + if (!is_lisp_pointer(where[3])) { lose("not empty-hash-table-slot symbol pointer: %x", where[3]); } empty_symbol = where[3]; /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/ - if (TypeOf(*(lispobj *)PTR(empty_symbol)) != type_SymbolHeader) { + if (TypeOf(*(lispobj *)native_pointer(empty_symbol)) != type_SymbolHeader) { lose("not a symbol where empty-hash-table-slot symbol expected: %x", - *(lispobj *)PTR(empty_symbol)); + *(lispobj *)native_pointer(empty_symbol)); } /* Scavenge hash table, which will fix the positions of the other @@ -2781,7 +2771,7 @@ scav_vector(lispobj *where, lispobj object) scavenge(hash_table, 16); /* Cross-check the kv_vector. */ - if (where != (lispobj *)PTR(hash_table[9])) { + if (where != (lispobj *)native_pointer(hash_table[9])) { lose("hash_table table!=this table %x", hash_table[9]); } @@ -2792,11 +2782,11 @@ scav_vector(lispobj *where, lispobj object) { lispobj index_vector_obj = hash_table[13]; - if (Pointerp(index_vector_obj) && - (TypeOf(*(lispobj *)PTR(index_vector_obj)) == type_SimpleArrayUnsignedByte32)) { - index_vector = ((unsigned int *)PTR(index_vector_obj)) + 2; + if (is_lisp_pointer(index_vector_obj) && + (TypeOf(*(lispobj *)native_pointer(index_vector_obj)) == type_SimpleArrayUnsignedByte32)) { + index_vector = ((unsigned int *)native_pointer(index_vector_obj)) + 2; /*FSHOW((stderr, "/index_vector = %x\n",index_vector));*/ - length = fixnum_value(((unsigned int *)PTR(index_vector_obj))[1]); + length = fixnum_value(((unsigned int *)native_pointer(index_vector_obj))[1]); /*FSHOW((stderr, "/length = %d\n", length));*/ } else { lose("invalid index_vector %x", index_vector_obj); @@ -2807,11 +2797,11 @@ scav_vector(lispobj *where, lispobj object) { lispobj next_vector_obj = hash_table[14]; - if (Pointerp(next_vector_obj) && - (TypeOf(*(lispobj *)PTR(next_vector_obj)) == type_SimpleArrayUnsignedByte32)) { - next_vector = ((unsigned int *)PTR(next_vector_obj)) + 2; + if (is_lisp_pointer(next_vector_obj) && + (TypeOf(*(lispobj *)native_pointer(next_vector_obj)) == type_SimpleArrayUnsignedByte32)) { + next_vector = ((unsigned int *)native_pointer(next_vector_obj)) + 2; /*FSHOW((stderr, "/next_vector = %x\n", next_vector));*/ - next_vector_length = fixnum_value(((unsigned int *)PTR(next_vector_obj))[1]); + next_vector_length = fixnum_value(((unsigned int *)native_pointer(next_vector_obj))[1]); /*FSHOW((stderr, "/next_vector_length = %d\n", next_vector_length));*/ } else { lose("invalid next_vector %x", next_vector_obj); @@ -2826,12 +2816,12 @@ scav_vector(lispobj *where, lispobj object) * probably other stuff too. Ugh.. */ lispobj hash_vector_obj = hash_table[15]; - if (Pointerp(hash_vector_obj) && - (TypeOf(*(lispobj *)PTR(hash_vector_obj)) + if (is_lisp_pointer(hash_vector_obj) && + (TypeOf(*(lispobj *)native_pointer(hash_vector_obj)) == type_SimpleArrayUnsignedByte32)) { - hash_vector = ((unsigned int *)PTR(hash_vector_obj)) + 2; + hash_vector = ((unsigned int *)native_pointer(hash_vector_obj)) + 2; /*FSHOW((stderr, "/hash_vector = %x\n", hash_vector));*/ - gc_assert(fixnum_value(((unsigned int *)PTR(hash_vector_obj))[1]) + gc_assert(fixnum_value(((unsigned int *)native_pointer(hash_vector_obj))[1]) == next_vector_length); } else { hash_vector = NULL; @@ -2918,9 +2908,9 @@ trans_vector(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); @@ -2961,9 +2951,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); @@ -3003,9 +2993,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); @@ -3045,9 +3035,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); @@ -3086,9 +3076,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); @@ -3128,9 +3118,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); @@ -3169,9 +3159,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); @@ -3210,9 +3200,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); @@ -3251,9 +3241,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); @@ -3293,9 +3283,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); @@ -3337,9 +3327,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); @@ -3380,9 +3370,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); @@ -3424,9 +3414,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); @@ -3500,7 +3490,7 @@ trans_weak_pointer(lispobj object) lispobj copy; /* 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)); @@ -3510,7 +3500,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. */ @@ -3533,14 +3523,14 @@ void scan_weak_pointers(void) lispobj value = wp->value; lispobj *first_pointer; - first_pointer = (lispobj *)PTR(value); + first_pointer = (lispobj *)native_pointer(value); /* FSHOW((stderr, "/weak pointer at 0x%08x\n", (unsigned long) wp)); FSHOW((stderr, "/value: 0x%08x\n", (unsigned long) value)); */ - if (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 @@ -3862,7 +3852,7 @@ search_space(lispobj *start, size_t words, lispobj *pointer) lispobj thing = *start; /* If thing is an immediate then this is a cons. */ - if (Pointerp(thing) + if (is_lisp_pointer(thing) || ((thing & 3) == 0) /* fixnum */ || (TypeOf(thing) == type_BaseChar) || (TypeOf(thing) == type_UnboundMarker)) @@ -3945,12 +3935,27 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) /* 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. */ + * 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 (LowtagOf((lispobj)pointer)) { case type_FunctionPointer: /* Start_addr should be the enclosing code object, or a closure @@ -3990,11 +3995,11 @@ possibly_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]) + && (is_lisp_pointer(start_addr[1]) || ((start_addr[1] & 3) == 0) /* fixnum */ || (TypeOf(start_addr[1]) == type_BaseChar) || (TypeOf(start_addr[1]) == type_UnboundMarker))) @@ -4033,7 +4038,7 @@ possibly_valid_dynamic_space_pointer(lispobj *pointer) return 0; } /* Is it plausible? Not a cons. XXX should check the headers. */ - if (Pointerp(start_addr[0]) || ((start_addr[0] & 3) == 0)) { + if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) { if (gencgc_verbose) FSHOW((stderr, "/Wo2: %x %x %x\n", @@ -4152,12 +4157,13 @@ possibly_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) { @@ -4288,8 +4294,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; @@ -4302,16 +4311,16 @@ maybe_adjust_large_object(lispobj *where) * * 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) { @@ -4347,7 +4356,7 @@ preserve_pointer(void *addr) * expensive but important, since it vastly reduces the * probability that random garbage will be bogusly interpreter as * a pointer which prevents a page from moving. */ - if (enable_pointer_filter && !possibly_valid_dynamic_space_pointer(addr)) + if (!possibly_valid_dynamic_space_pointer(addr)) return; /* Work backwards to find a page with a first_object_offset of 0. @@ -4362,13 +4371,14 @@ preserve_pointer(void *addr) 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. */ @@ -4391,17 +4401,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.. */ @@ -4416,91 +4427,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 < (lispobj *)CONTROL_STACK_START) || - (stack_pointer > (lispobj *)CONTROL_STACK_END)) - lose("invalid stack pointer %x", - (unsigned)stack_pointer); - if ((stack_pointer > (lispobj *)CONTROL_STACK_START) && - (stack_pointer < (lispobj *)CONTROL_STACK_END)) { - /* FIXME: Ick! - * (1) hardwired word length = 4; and as usual, - * when fixing this, check for other places - * with the same problem - * (2) calling it 'length' suggests bytes; - * perhaps 'size' instead? */ - unsigned int length = ((unsigned)CONTROL_STACK_END - - (unsigned)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) { @@ -4534,7 +4475,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) @@ -4618,7 +4559,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) @@ -4673,14 +4614,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 @@ -4693,7 +4633,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. @@ -4704,7 +4644,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. */ @@ -4802,7 +4742,7 @@ scavenge_newspace_generation(int generation) { int i; - /* the new_areas array currently being written to by gc_alloc */ + /* 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; @@ -4814,7 +4754,7 @@ scavenge_newspace_generation(int generation) 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; @@ -4854,7 +4794,7 @@ 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; @@ -4906,7 +4846,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 @@ -5089,7 +5029,7 @@ verify_space(lispobj *start, size_t words) 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 && @@ -5106,7 +5046,7 @@ 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 @@ -5192,7 +5132,7 @@ verify_space(lispobj *start, size_t words) * the code data block. */ fheaderl = code->entry_points; while (fheaderl != NIL) { - fheaderp = (struct function *) PTR(fheaderl); + fheaderp = (struct function *) native_pointer(fheaderl); gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); verify_space(&fheaderp->name, 1); verify_space(&fheaderp->arglist, 1); @@ -5329,7 +5269,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) { @@ -5429,7 +5369,7 @@ garbage_collect_generation(int generation, int raise) { 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)); @@ -5481,24 +5421,23 @@ garbage_collect_generation(int generation, int raise) 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) && @@ -5508,7 +5447,7 @@ garbage_collect_generation(int generation, int raise) } /* Scavenge the binding stack. */ - scavenge( (lispobj *) BINDING_STACK_START, + scavenge((lispobj *) BINDING_STACK_START, (lispobj *)SymbolValue(BINDING_STACK_POINTER) - (lispobj *)BINDING_STACK_START); @@ -5521,7 +5460,7 @@ garbage_collect_generation(int generation, int raise) * please submit a patch. */ #if 0 if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) { - read_only_space_size = + unsigned long read_only_space_size = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - (lispobj*)READ_ONLY_SPACE_START; FSHOW((stderr, @@ -5535,18 +5474,21 @@ garbage_collect_generation(int generation, int raise) static_space_size = (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER) - (lispobj *)STATIC_SPACE_START; - if (gencgc_verbose > 1) + if (gencgc_verbose > 1) { FSHOW((stderr, "/scavenge static space: %d bytes\n", static_space_size * sizeof(lispobj))); + } 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 */ @@ -5761,15 +5703,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; @@ -5781,7 +5723,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) @@ -5849,14 +5791,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); @@ -5902,7 +5843,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; @@ -5918,14 +5861,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); @@ -6050,7 +5994,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); @@ -6065,7 +6009,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)); @@ -6110,7 +6054,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; @@ -6119,8 +6063,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; }