X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgc-common.c;h=4d2ef2b222f98deb146a860315bf2484784e646a;hb=e4542bc034db18cf98f005b2dac53a6d7d5c7260;hp=147b2f332f89b7f7c05a6f64af57a61b655bf013;hpb=2db3b6b4cb740d5b6512459c223859f747807b09;p=sbcl.git diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c index 147b2f3..4d2ef2b 100644 --- a/src/runtime/gc-common.c +++ b/src/runtime/gc-common.c @@ -1,5 +1,5 @@ /* - * Garbage Collection common functions for scavenging, moving and sizing + * Garbage Collection common functions for scavenging, moving and sizing * objects. These are for use with both GC (stop & copy GC) and GENCGC */ @@ -15,21 +15,6 @@ */ /* - * GENerational Conservative Garbage Collector for SBCL x86 - */ - -/* - * This software is part of the SBCL system. See the README file for - * more information. - * - * This software is derived from the CMU CL system, which was - * written at Carnegie Mellon University and released into the - * public domain. The software is in the public domain and is - * provided with absolutely no warranty. See the COPYING and CREDITS - * files for more information. - */ - -/* * 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 @@ -42,8 +27,9 @@ #include #include -#include "runtime.h" +#include #include "sbcl.h" +#include "runtime.h" #include "os.h" #include "interr.h" #include "globals.h" @@ -51,9 +37,11 @@ #include "validate.h" #include "lispregs.h" #include "arch.h" +#include "fixnump.h" #include "gc.h" #include "genesis/primitive-objects.h" #include "genesis/static-symbols.h" +#include "genesis/layout.h" #include "gc-internal.h" #ifdef LISP_FEATURE_SPARC @@ -64,14 +52,14 @@ #endif #endif -inline static boolean +inline static boolean forwarding_pointer_p(lispobj *pointer) { - lispobj first_word=*pointer; + lispobj first_word=*pointer; #ifdef LISP_FEATURE_GENCGC return (first_word == 0x01); #else return (is_lisp_pointer(first_word) - && new_space_p(first_word)); + && new_space_p(first_word)); #endif } @@ -94,22 +82,24 @@ set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) { return newspace_copy; } -int (*scavtab[256])(lispobj *where, lispobj object); +long (*scavtab[256])(lispobj *where, lispobj object); lispobj (*transother[256])(lispobj object); -int (*sizetab[256])(lispobj *where); +long (*sizetab[256])(lispobj *where); struct weak_pointer *weak_pointers; +unsigned long bytes_consed_between_gcs = 12*1024*1024; + + /* * copying objects */ /* to copy a boxed object */ lispobj -copy_object(lispobj object, int nwords) +copy_object(lispobj object, long nwords) { int tag; lispobj *new; - lispobj *source, *dest; gc_assert(is_lisp_pointer(object)); gc_assert(from_space_p(object)); @@ -119,94 +109,83 @@ copy_object(lispobj object, int nwords) tag = lowtag_of(object); /* Allocate space. */ - new = gc_general_alloc(nwords*4,ALLOC_BOXED,ALLOC_QUICK); - - dest = new; - source = (lispobj *) native_pointer(object); + new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK); /* Copy the object. */ - while (nwords > 0) { - dest[0] = source[0]; - dest[1] = source[1]; - dest += 2; - source += 2; - nwords -= 2; - } - + memcpy(new,native_pointer(object),nwords*N_WORD_BYTES); return make_lispobj(new,tag); } -static int scav_lose(lispobj *where, lispobj object); /* forward decl */ +static long scav_lose(lispobj *where, lispobj object); /* forward decl */ /* 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. */ - void scavenge(lispobj *start, long n_words) { lispobj *end = start + n_words; lispobj *object_ptr; - int n_words_scavenged; - + long n_words_scavenged; + for (object_ptr = start; - object_ptr < end; - object_ptr += n_words_scavenged) { + object_ptr < end; + object_ptr += n_words_scavenged) { - lispobj object = *object_ptr; + lispobj object = *object_ptr; #ifdef LISP_FEATURE_GENCGC - gc_assert(!forwarding_pointer_p(object_ptr)); -#endif - if (is_lisp_pointer(object)) { - if (from_space_p(object)) { - /* It currently points to old space. Check for a - * forwarding pointer. */ - lispobj *ptr = native_pointer(object); - if (forwarding_pointer_p(ptr)) { - /* Yes, there's a forwarding pointer. */ - *object_ptr = LOW_WORD(forwarding_pointer_value(ptr)); - n_words_scavenged = 1; - } else { - /* Scavenge that pointer. */ - n_words_scavenged = - (scavtab[widetag_of(object)])(object_ptr, object); - } - } else { - /* It points somewhere other than oldspace. Leave it - * alone. */ - n_words_scavenged = 1; - } - } + gc_assert(!forwarding_pointer_p(object_ptr)); +#endif + if (is_lisp_pointer(object)) { + if (from_space_p(object)) { + /* It currently points to old space. Check for a + * forwarding pointer. */ + lispobj *ptr = native_pointer(object); + if (forwarding_pointer_p(ptr)) { + /* Yes, there's a forwarding pointer. */ + *object_ptr = LOW_WORD(forwarding_pointer_value(ptr)); + n_words_scavenged = 1; + } else { + /* Scavenge that pointer. */ + n_words_scavenged = + (scavtab[widetag_of(object)])(object_ptr, object); + } + } else { + /* It points somewhere other than oldspace. Leave it + * alone. */ + n_words_scavenged = 1; + } + } #ifndef LISP_FEATURE_GENCGC - /* this workaround is probably not necessary for gencgc; at least, the - * behaviour it describes has never been reported */ - else if (n_words==1) { - /* there are some situations where an - other-immediate may end up in a descriptor - register. I'm not sure whether this is - supposed to happen, but if it does then we - don't want to (a) barf or (b) scavenge over the - data-block, because there isn't one. So, if - we're checking a single word and it's anything - other than a pointer, just hush it up */ - int type=widetag_of(object); - n_words_scavenged=1; - - if ((scavtab[type]==scav_lose) || - (((scavtab[type])(start,object))>1)) { - fprintf(stderr,"warning: attempted to scavenge non-descriptor value %x at %p. If you can\nreproduce this warning, send a bug report (see manual page for details)\n", - object,start); - } - } -#endif - else if ((object & 3) == 0) { - /* It's a fixnum: really easy.. */ - n_words_scavenged = 1; - } else { - /* It's some sort of header object or another. */ - n_words_scavenged = - (scavtab[widetag_of(object)])(object_ptr, object); - } + /* this workaround is probably not necessary for gencgc; at least, the + * behaviour it describes has never been reported */ + else if (n_words==1) { + /* there are some situations where an + other-immediate may end up in a descriptor + register. I'm not sure whether this is + supposed to happen, but if it does then we + don't want to (a) barf or (b) scavenge over the + data-block, because there isn't one. So, if + we're checking a single word and it's anything + other than a pointer, just hush it up */ + int type=widetag_of(object); + n_words_scavenged=1; + + if ((scavtab[type]==scav_lose) || + (((scavtab[type])(start,object))>1)) { + fprintf(stderr,"warning: attempted to scavenge non-descriptor value %x at %p. If you can\nreproduce this warning, send a bug report (see manual page for details)\n", + object,start); + } + } +#endif + else if (fixnump(object)) { + /* It's a fixnum: really easy.. */ + n_words_scavenged = 1; + } else { + /* It's some sort of header object or another. */ + n_words_scavenged = + (scavtab[widetag_of(object)])(object_ptr, object); + } } gc_assert(object_ptr == end); } @@ -214,7 +193,7 @@ scavenge(lispobj *start, long n_words) static lispobj trans_fun_header(lispobj object); /* forward decls */ static lispobj trans_boxed(lispobj object); -static int +static long scav_fun_pointer(lispobj *where, lispobj object) { lispobj *first_pointer; @@ -230,17 +209,16 @@ scav_fun_pointer(lispobj *where, lispobj object) switch (widetag_of(*first_pointer)) { case SIMPLE_FUN_HEADER_WIDETAG: - case CLOSURE_FUN_HEADER_WIDETAG: - copy = trans_fun_header(object); - break; + copy = trans_fun_header(object); + break; default: - copy = trans_boxed(object); - break; + copy = trans_boxed(object); + break; } if (copy != object) { - /* Set forwarding pointer */ - set_forwarding_pointer(first_pointer,copy); + /* Set forwarding pointer */ + set_forwarding_pointer(first_pointer,copy); } gc_assert(is_lisp_pointer(copy)); @@ -257,7 +235,7 @@ trans_code(struct code *code) { struct code *new_code; lispobj first, l_code, l_new_code; - int nheader_words, ncode_words, nwords; + long nheader_words, ncode_words, nwords; unsigned long displacement; lispobj fheaderl, *prev_pointer; @@ -265,12 +243,12 @@ trans_code(struct code *code) first = code->header; if (forwarding_pointer_p((lispobj *)code)) { #ifdef DEBUG_CODE_GC - printf("Was already transported\n"); + printf("Was already transported\n"); #endif - return (struct code *) forwarding_pointer_value - ((lispobj *)((pointer_sized_uint_t) code)); + return (struct code *) forwarding_pointer_value + ((lispobj *)((pointer_sized_uint_t) code)); } - + gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG); /* prepare to transport the code vector */ @@ -286,19 +264,19 @@ trans_code(struct code *code) #if defined(DEBUG_CODE_GC) printf("Old code object at 0x%08x, new code object at 0x%08x.\n", - (unsigned long) code, (unsigned long) new_code); + (unsigned long) code, (unsigned long) new_code); printf("Code object is %d words long.\n", nwords); #endif #ifdef LISP_FEATURE_GENCGC if (new_code == code) - return new_code; + return new_code; #endif displacement = l_new_code - l_code; set_forwarding_pointer((lispobj *)code, l_new_code); - + /* set forwarding pointers for all the function headers in the */ /* code object. also fix all self pointers */ @@ -306,49 +284,49 @@ trans_code(struct code *code) prev_pointer = &new_code->entry_points; while (fheaderl != NIL) { - struct simple_fun *fheaderp, *nfheaderp; - lispobj nfheaderl; - - fheaderp = (struct simple_fun *) native_pointer(fheaderl); - gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG); + struct simple_fun *fheaderp, *nfheaderp; + lispobj nfheaderl; + + fheaderp = (struct simple_fun *) native_pointer(fheaderl); + gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG); - /* Calculate the new function pointer and the new */ - /* function header. */ - nfheaderl = fheaderl + displacement; - nfheaderp = (struct simple_fun *) native_pointer(nfheaderl); + /* Calculate the new function pointer and the new */ + /* function header. */ + nfheaderl = fheaderl + displacement; + nfheaderp = (struct simple_fun *) native_pointer(nfheaderl); #ifdef DEBUG_CODE_GC - printf("fheaderp->header (at %x) <- %x\n", - &(fheaderp->header) , nfheaderl); -#endif - set_forwarding_pointer((lispobj *)fheaderp, nfheaderl); - - /* fix self pointer. */ - nfheaderp->self = -#ifdef LISP_FEATURE_GENCGC /* GENCGC? Maybe x86 is better conditional */ - FUN_RAW_ADDR_OFFSET + -#endif - nfheaderl; - - *prev_pointer = nfheaderl; - - fheaderl = fheaderp->next; - prev_pointer = &nfheaderp->next; + printf("fheaderp->header (at %x) <- %x\n", + &(fheaderp->header) , nfheaderl); +#endif + set_forwarding_pointer((lispobj *)fheaderp, nfheaderl); + + /* fix self pointer. */ + nfheaderp->self = +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) + FUN_RAW_ADDR_OFFSET + +#endif + nfheaderl; + + *prev_pointer = nfheaderl; + + fheaderl = fheaderp->next; + prev_pointer = &nfheaderp->next; } - os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words), - ncode_words * sizeof(int)); + os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words), + ncode_words * sizeof(long)); #ifdef LISP_FEATURE_GENCGC gencgc_apply_code_fixups(code, new_code); #endif return new_code; } -static int +static long scav_code_header(lispobj *where, lispobj object) { struct code *code; - int n_header_words, n_code_words, n_words; - lispobj entry_point; /* tagged pointer to entry point */ + long 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; @@ -363,19 +341,19 @@ scav_code_header(lispobj *where, lispobj object) /* 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) { + entry_point != NIL; + entry_point = function_ptr->next) { - gc_assert(is_lisp_pointer(entry_point)); + 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); + 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); + scavenge(&function_ptr->name, 1); + scavenge(&function_ptr->arglist, 1); + scavenge(&function_ptr->type, 1); } - + return n_words; } @@ -389,14 +367,14 @@ trans_code_header(lispobj object) } -static int +static long size_code_header(lispobj *where) { struct code *code; - int nheader_words, ncode_words, nwords; + long nheader_words, ncode_words, nwords; code = (struct code *) where; - + ncode_words = fixnum_value(code->code_size); nheader_words = HeaderValue(code->header); nwords = ncode_words + nheader_words; @@ -405,14 +383,16 @@ size_code_header(lispobj *where) return nwords; } -static int +#if !defined(LISP_FEATURE_X86) && ! defined(LISP_FEATURE_X86_64) +static long scav_return_pc_header(lispobj *where, lispobj object) { lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x", - (unsigned long) where, - (unsigned long) object); + (unsigned long) where, + (unsigned long) object); return 0; /* bogus return value to satisfy static type checking */ } +#endif /* LISP_FEATURE_X86 */ static lispobj trans_return_pc_header(lispobj object) @@ -422,7 +402,8 @@ trans_return_pc_header(lispobj object) struct code *code, *ncode; return_pc = (struct simple_fun *) native_pointer(object); - offset = HeaderValue(return_pc->header) * 4 ; + /* FIXME: was times 4, should it really be N_WORD_BYTES? */ + offset = HeaderValue(return_pc->header) * N_WORD_BYTES; /* Transport the whole code object */ code = (struct code *) ((unsigned long) return_pc - offset); @@ -437,8 +418,8 @@ trans_return_pc_header(lispobj object) * objects don't move, we don't need to update anything, but we do * have to figure out that the function is still live. */ -#ifdef LISP_FEATURE_X86 -static int +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +static long scav_closure_header(lispobj *where, lispobj object) { struct closure *closure; @@ -451,20 +432,22 @@ scav_closure_header(lispobj *where, lispobj object) /* The function may have moved so update the raw address. But * don't write unnecessarily. */ if (closure->fun != fun + FUN_RAW_ADDR_OFFSET) - closure->fun = fun + FUN_RAW_ADDR_OFFSET; + closure->fun = fun + FUN_RAW_ADDR_OFFSET; #endif return 2; } #endif -static int +#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)) +static long scav_fun_header(lispobj *where, lispobj object) { lose("attempted to scavenge a function header where=0x%08x object=0x%08x", - (unsigned long) where, - (unsigned long) object); + (unsigned long) where, + (unsigned long) object); return 0; /* bogus return value to satisfy static type checking */ } +#endif /* LISP_FEATURE_X86 */ static lispobj trans_fun_header(lispobj object) @@ -472,9 +455,10 @@ trans_fun_header(lispobj object) struct simple_fun *fheader; unsigned long offset; struct code *code, *ncode; - + fheader = (struct simple_fun *) native_pointer(object); - offset = HeaderValue(fheader->header) * 4; + /* FIXME: was times 4, should it really be N_WORD_BYTES? */ + offset = HeaderValue(fheader->header) * N_WORD_BYTES; /* Transport the whole code object */ code = (struct code *) ((unsigned long) fheader - offset); @@ -488,7 +472,7 @@ trans_fun_header(lispobj object) * instances */ -static int +static long scav_instance_pointer(lispobj *where, lispobj object) { lispobj copy, *first_pointer; @@ -514,7 +498,7 @@ scav_instance_pointer(lispobj *where, lispobj object) static lispobj trans_list(lispobj object); -static int +static long scav_list_pointer(lispobj *where, lispobj object) { lispobj first, *first_pointer; @@ -548,8 +532,8 @@ trans_list(lispobj object) cons = (struct cons *) native_pointer(object); /* Copy 'object'. */ - new_cons = (struct cons *) - gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK); + new_cons = (struct cons *) + gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK); new_cons->car = cons->car; new_cons->cdr = cons->cdr; /* updated later */ new_list_pointer = make_lispobj(new_cons,lowtag_of(object)); @@ -562,32 +546,32 @@ trans_list(lispobj object) /* Try to linearize the list in the cdr direction to help reduce * paging. */ while (1) { - lispobj new_cdr; - struct cons *cdr_cons, *new_cdr_cons; - - if(lowtag_of(cdr) != LIST_POINTER_LOWTAG || - !from_space_p(cdr) || - forwarding_pointer_p((lispobj *)native_pointer(cdr))) - break; - - cdr_cons = (struct cons *) native_pointer(cdr); - - /* Copy 'cdr'. */ - new_cdr_cons = (struct cons*) - gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK); - new_cdr_cons->car = cdr_cons->car; - new_cdr_cons->cdr = cdr_cons->cdr; - new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr)); - - /* Grab the cdr before it is clobbered. */ - cdr = cdr_cons->cdr; - set_forwarding_pointer((lispobj *)cdr_cons, new_cdr); - - /* Update the cdr of the last cons copied into new space to - * keep the newspace scavenge from having to do it. */ - new_cons->cdr = new_cdr; - - new_cons = new_cdr_cons; + lispobj new_cdr; + struct cons *cdr_cons, *new_cdr_cons; + + if(lowtag_of(cdr) != LIST_POINTER_LOWTAG || + !from_space_p(cdr) || + forwarding_pointer_p((lispobj *)native_pointer(cdr))) + break; + + cdr_cons = (struct cons *) native_pointer(cdr); + + /* Copy 'cdr'. */ + new_cdr_cons = (struct cons*) + gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK); + new_cdr_cons->car = cdr_cons->car; + new_cdr_cons->cdr = cdr_cons->cdr; + new_cdr = make_lispobj(new_cdr_cons, lowtag_of(cdr)); + + /* Grab the cdr before it is clobbered. */ + cdr = cdr_cons->cdr; + set_forwarding_pointer((lispobj *)cdr_cons, new_cdr); + + /* Update the cdr of the last cons copied into new space to + * keep the newspace scavenge from having to do it. */ + new_cons->cdr = new_cdr; + + new_cons = new_cdr_cons; } return new_list_pointer; @@ -598,7 +582,7 @@ trans_list(lispobj object) * scavenging and transporting other pointers */ -static int +static long scav_other_pointer(lispobj *where, lispobj object) { lispobj first, *first_pointer; @@ -610,9 +594,9 @@ scav_other_pointer(lispobj *where, lispobj object) first = (transother[widetag_of(*first_pointer)])(object); if (first != object) { - set_forwarding_pointer(first_pointer, first); + set_forwarding_pointer(first_pointer, first); #ifdef LISP_FEATURE_GENCGC - *where = first; + *where = first; #endif } #ifndef LISP_FEATURE_GENCGC @@ -628,13 +612,13 @@ scav_other_pointer(lispobj *where, lispobj object) * immediate, boxed, and unboxed objects */ -static int +static long size_pointer(lispobj *where) { return 1; } -static int +static long scav_immediate(lispobj *where, lispobj object) { return 1; @@ -647,19 +631,37 @@ trans_immediate(lispobj object) return NIL; /* bogus return value to satisfy static type checking */ } -static int +static long size_immediate(lispobj *where) { return 1; } -static int +static long scav_boxed(lispobj *where, lispobj object) { return 1; } +static long +scav_instance(lispobj *where, lispobj object) +{ + lispobj nuntagged; + long ntotal = HeaderValue(object); + lispobj layout = ((struct instance *)where)->slots[0]; + + if (!layout) + return 1; + if (forwarding_pointer_p(native_pointer(layout))) + layout = (lispobj) forwarding_pointer_value(native_pointer(layout)); + + nuntagged = ((struct layout *)native_pointer(layout))->n_untagged_slots; + scavenge(where + 1, ntotal - fixnum_value(nuntagged)); + + return ntotal + 1; +} + static lispobj trans_boxed(lispobj object) { @@ -676,7 +678,7 @@ trans_boxed(lispobj object) } -static int +static long size_boxed(lispobj *where) { lispobj header; @@ -692,36 +694,35 @@ size_boxed(lispobj *where) /* Note: on the sparc we don't have to do anything special for fdefns, */ /* 'cause the raw-addr has a function lowtag. */ #ifndef LISP_FEATURE_SPARC -static int +static long scav_fdefn(lispobj *where, lispobj object) { struct fdefn *fdefn; fdefn = (struct fdefn *)where; - /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n", + /* FSHOW((stderr, "scav_fdefn, function = %p, raw_addr = %p\n", fdefn->fun, fdefn->raw_addr)); */ - if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) - == (char *)((unsigned long)(fdefn->raw_addr))) { - scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1); - - /* Don't write unnecessarily. */ - if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)) - fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET); - /* gc.c has more casts here, which may be relevant or alternatively - may be compiler warning defeaters. try - fdefn->raw_addr = - (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET; - */ - return sizeof(struct fdefn) / sizeof(lispobj); + if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) + == (char *)((unsigned long)(fdefn->raw_addr))) { + scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1); + + /* Don't write unnecessarily. */ + if (fdefn->raw_addr != (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)) + fdefn->raw_addr = (char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET); + /* gc.c has more casts here, which may be relevant or alternatively + may be compiler warning defeaters. try + fdefn->raw_addr = ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET; + */ + return sizeof(struct fdefn) / sizeof(lispobj); } else { - return 1; + return 1; } } #endif -static int +static long scav_unboxed(lispobj *where, lispobj object) { unsigned long length; @@ -748,7 +749,7 @@ trans_unboxed(lispobj object) return copy_unboxed_object(object, length); } -static int +static long size_unboxed(lispobj *where) { lispobj header; @@ -761,12 +762,61 @@ size_unboxed(lispobj *where) return length; } -static int + /* vector-like objects */ +static long +scav_base_string(lispobj *where, lispobj object) +{ + struct vector *vector; + long length, nwords; -#define NWORDS(x,y) (CEILING((x),(y)) / (y)) + /* NOTE: Strings contain one more byte of data than the length */ + /* slot indicates. */ -scav_string(lispobj *where, lispobj object) + vector = (struct vector *) where; + length = fixnum_value(vector->length) + 1; + nwords = CEILING(NWORDS(length, 8) + 2, 2); + + return nwords; +} +static lispobj +trans_base_string(lispobj object) +{ + struct vector *vector; + long length, nwords; + + gc_assert(is_lisp_pointer(object)); + + /* NOTE: A string contains one more byte of data (a terminating + * '\0' to help when interfacing with C functions) than indicated + * by the length slot. */ + + vector = (struct vector *) native_pointer(object); + length = fixnum_value(vector->length) + 1; + nwords = CEILING(NWORDS(length, 8) + 2, 2); + + return copy_large_unboxed_object(object, nwords); +} + +static long +size_base_string(lispobj *where) +{ + struct vector *vector; + long length, nwords; + + /* NOTE: A string contains one more byte of data (a terminating + * '\0' to help when interfacing with C functions) than indicated + * by the length slot. */ + + vector = (struct vector *) where; + length = fixnum_value(vector->length) + 1; + nwords = CEILING(NWORDS(length, 8) + 2, 2); + + return nwords; +} + +static long +scav_character_string(lispobj *where, lispobj object) { struct vector *vector; int length, nwords; @@ -776,12 +826,12 @@ scav_string(lispobj *where, lispobj object) vector = (struct vector *) where; length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); return nwords; } static lispobj -trans_string(lispobj object) +trans_character_string(lispobj object) { struct vector *vector; int length, nwords; @@ -794,13 +844,13 @@ trans_string(lispobj object) vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); return copy_large_unboxed_object(object, nwords); } -static int -size_string(lispobj *where) +static long +size_character_string(lispobj *where) { struct vector *vector; int length, nwords; @@ -811,7 +861,7 @@ size_string(lispobj *where) vector = (struct vector *) where; length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); return nwords; } @@ -820,7 +870,7 @@ static lispobj trans_vector(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); @@ -832,11 +882,11 @@ trans_vector(lispobj object) return copy_large_object(object, nwords); } -static int +static long size_vector(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -845,7 +895,7 @@ size_vector(lispobj *where) return nwords; } -static int +static long scav_vector_nil(lispobj *where, lispobj object) { return 2; @@ -858,22 +908,22 @@ trans_vector_nil(lispobj object) return copy_unboxed_object(object, 2); } -static int +static long size_vector_nil(lispobj *where) { /* Just the header word and the length word */ return 2; } -static int +static long scav_vector_bit(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); + nwords = CEILING(NWORDS(length, 1) + 2, 2); return nwords; } @@ -882,39 +932,39 @@ static lispobj trans_vector_bit(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); + nwords = CEILING(NWORDS(length, 1) + 2, 2); return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_bit(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); + nwords = CEILING(NWORDS(length, 1) + 2, 2); return nwords; } -static int +static long scav_vector_unsigned_byte_2(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); + nwords = CEILING(NWORDS(length, 2) + 2, 2); return nwords; } @@ -923,39 +973,39 @@ static lispobj trans_vector_unsigned_byte_2(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); + nwords = CEILING(NWORDS(length, 2) + 2, 2); return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_unsigned_byte_2(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); + nwords = CEILING(NWORDS(length, 2) + 2, 2); return nwords; } -static int +static long scav_vector_unsigned_byte_4(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); + nwords = CEILING(NWORDS(length, 4) + 2, 2); return nwords; } @@ -964,39 +1014,39 @@ static lispobj trans_vector_unsigned_byte_4(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); + nwords = CEILING(NWORDS(length, 4) + 2, 2); return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_unsigned_byte_4(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); + nwords = CEILING(NWORDS(length, 4) + 2, 2); return nwords; } -static int +static long scav_vector_unsigned_byte_8(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); return nwords; } @@ -1009,40 +1059,40 @@ static lispobj trans_vector_unsigned_byte_8(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_unsigned_byte_8(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); return nwords; } -static int +static long scav_vector_unsigned_byte_16(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); + nwords = CEILING(NWORDS(length, 16) + 2, 2); return nwords; } @@ -1051,39 +1101,39 @@ static lispobj trans_vector_unsigned_byte_16(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); + nwords = CEILING(NWORDS(length, 16) + 2, 2); return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_unsigned_byte_16(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); + nwords = CEILING(NWORDS(length, 16) + 2, 2); return nwords; } -static int +static long scav_vector_unsigned_byte_32(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); return nwords; } @@ -1092,39 +1142,82 @@ static lispobj trans_vector_unsigned_byte_32(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_unsigned_byte_32(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); + + return nwords; +} + +#if N_WORD_BITS == 64 +static long +scav_vector_unsigned_byte_64(lispobj *where, lispobj object) +{ + struct vector *vector; + long length, nwords; + + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 64) + 2, 2); + + return nwords; +} + +static lispobj +trans_vector_unsigned_byte_64(lispobj object) +{ + struct vector *vector; + long length, nwords; + + gc_assert(is_lisp_pointer(object)); + + vector = (struct vector *) native_pointer(object); + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 64) + 2, 2); + + return copy_large_unboxed_object(object, nwords); +} + +static long +size_vector_unsigned_byte_64(lispobj *where) +{ + struct vector *vector; + long length, nwords; + + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 64) + 2, 2); return nwords; } +#endif -static int +static long scav_vector_single_float(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); return nwords; } @@ -1133,39 +1226,39 @@ static lispobj trans_vector_single_float(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_single_float(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); return nwords; } -static int +static long scav_vector_double_float(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + nwords = CEILING(NWORDS(length, 64) + 2, 2); return nwords; } @@ -1174,42 +1267,42 @@ static lispobj trans_vector_double_float(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + nwords = CEILING(NWORDS(length, 64) + 2, 2); return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_double_float(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + nwords = CEILING(NWORDS(length, 64) + 2, 2); return nwords; } #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG -static int +static long scav_vector_long_float(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length * - LONG_FLOAT_SIZE - + 2, 2); + nwords = CEILING(length * + LONG_FLOAT_SIZE + + 2, 2); return nwords; } @@ -1217,7 +1310,7 @@ static lispobj trans_vector_long_float(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); @@ -1228,11 +1321,11 @@ trans_vector_long_float(lispobj object) return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_long_float(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1244,15 +1337,15 @@ size_vector_long_float(lispobj *where) #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG -static int +static long scav_vector_complex_single_float(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + nwords = CEILING(NWORDS(length, 64) + 2, 2); return nwords; } @@ -1261,41 +1354,41 @@ static lispobj trans_vector_complex_single_float(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + nwords = CEILING(NWORDS(length, 64) + 2, 2); return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_complex_single_float(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + nwords = CEILING(NWORDS(length, 64) + 2, 2); return nwords; } #endif #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG -static int +static long scav_vector_complex_double_float(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length * 4 + 2, 2); + nwords = CEILING(NWORDS(length, 128) + 2, 2); return nwords; } @@ -1304,26 +1397,26 @@ static lispobj trans_vector_complex_double_float(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); vector = (struct vector *) native_pointer(object); length = fixnum_value(vector->length); - nwords = CEILING(length * 4 + 2, 2); + nwords = CEILING(NWORDS(length, 128) + 2, 2); return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_complex_double_float(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); - nwords = CEILING(length * 4 + 2, 2); + nwords = CEILING(NWORDS(length, 128) + 2, 2); return nwords; } @@ -1331,11 +1424,11 @@ size_vector_complex_double_float(lispobj *where) #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG -static int +static long scav_vector_complex_long_float(lispobj *where, lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1348,7 +1441,7 @@ static lispobj trans_vector_complex_long_float(lispobj object) { struct vector *vector; - int length, nwords; + long length, nwords; gc_assert(is_lisp_pointer(object)); @@ -1359,11 +1452,11 @@ trans_vector_complex_long_float(lispobj object) return copy_large_unboxed_object(object, nwords); } -static int +static long size_vector_complex_long_float(lispobj *where) { struct vector *vector; - int length, nwords; + long length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1374,7 +1467,7 @@ size_vector_complex_long_float(lispobj *where) #endif #define WEAK_POINTER_NWORDS \ - CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2) + CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2) static lispobj trans_weak_pointer(lispobj object) @@ -1395,16 +1488,16 @@ trans_weak_pointer(lispobj object) copy = copy_object(object, WEAK_POINTER_NWORDS); #ifndef LISP_FEATURE_GENCGC wp = (struct weak_pointer *) native_pointer(copy); - + gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG); /* Push the weak pointer onto the list of weak pointers. */ - wp->next = LOW_WORD(weak_pointers); + wp->next = (struct weak_pointer *)LOW_WORD(weak_pointers); weak_pointers = wp; #endif return copy; } -static int +static long size_weak_pointer(lispobj *where) { return WEAK_POINTER_NWORDS; @@ -1414,29 +1507,28 @@ size_weak_pointer(lispobj *where) void scan_weak_pointers(void) { struct weak_pointer *wp; - for (wp = weak_pointers; wp != NULL; - wp=(struct weak_pointer *)native_pointer(wp->next)) { - lispobj value = wp->value; - lispobj *first_pointer; - gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG); - if (!(is_lisp_pointer(value) && from_space_p(value))) - continue; - - /* Now, we need to check whether the object has been forwarded. If - * it has been, the weak pointer is still good and needs to be - * updated. Otherwise, the weak pointer needs to be nil'ed - * out. */ - - first_pointer = (lispobj *)native_pointer(value); - - if (forwarding_pointer_p(first_pointer)) { - wp->value= - (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer)); - } else { - /* Break it. */ - wp->value = NIL; - wp->broken = T; - } + for (wp = weak_pointers; wp != NULL; wp=wp->next) { + lispobj value = wp->value; + lispobj *first_pointer; + gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG); + if (!(is_lisp_pointer(value) && from_space_p(value))) + continue; + + /* Now, we need to check whether the object has been forwarded. If + * it has been, the weak pointer is still good and needs to be + * updated. Otherwise, the weak pointer needs to be nil'ed + * out. */ + + first_pointer = (lispobj *)native_pointer(value); + + if (forwarding_pointer_p(first_pointer)) { + wp->value= + (lispobj)LOW_WORD(forwarding_pointer_value(first_pointer)); + } else { + /* Break it. */ + wp->value = NIL; + wp->broken = T; + } } } @@ -1446,12 +1538,13 @@ void scan_weak_pointers(void) * initialization */ -static int +static long scav_lose(lispobj *where, lispobj object) { lose("no scavenge function for object 0x%08x (widetag 0x%x)", - (unsigned long)object, - widetag_of(*(lispobj*)native_pointer(object))); + (unsigned long)object, + widetag_of(*(lispobj*)native_pointer(object))); + return 0; /* bogus return value to satisfy static type checking */ } @@ -1459,17 +1552,17 @@ static lispobj trans_lose(lispobj object) { lose("no transport function for object 0x%08x (widetag 0x%x)", - (unsigned long)object, - widetag_of(*(lispobj*)native_pointer(object))); + (unsigned long)object, + widetag_of(*(lispobj*)native_pointer(object))); return NIL; /* bogus return value to satisfy static type checking */ } -static int +static long size_lose(lispobj *where) { lose("no size function for object at 0x%08x (widetag 0x%x)", - (unsigned long)where, - widetag_of(LOW_WORD(where))); + (unsigned long)where, + widetag_of(LOW_WORD(where))); return 1; /* bogus return value to satisfy static type checking */ } @@ -1481,13 +1574,13 @@ size_lose(lispobj *where) void gc_init_tables(void) { - int i; + long i; /* Set default value in all slots of scavenge table. FIXME * replace this gnarly sizeof with something based on * N_WIDETAG_BITS */ - for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) { - scavtab[i] = scav_lose; + for (i = 0; i < ((sizeof scavtab)/(sizeof scavtab[0])); i++) { + scavtab[i] = scav_lose; } /* For each type which can be selected by the lowtag alone, set @@ -1496,21 +1589,25 @@ gc_init_tables(void) */ for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) { - scavtab[EVEN_FIXNUM_LOWTAG|(i< 0) { + size_t count = 1; + lispobj thing = *start; + + /* If thing is an immediate then this is a cons. */ + if (is_lisp_pointer(thing) + || (fixnump(thing)) + || (widetag_of(thing) == CHARACTER_WIDETAG) +#if N_WORD_BITS == 64 + || (widetag_of(thing) == SINGLE_FLOAT_WIDETAG) +#endif + || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG)) + count = 2; + else + count = (sizetab[widetag_of(thing)])(start); + + /* 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. */ + count = CEILING(count,2); + + start += count; + words -= count; + } + return (NULL); +}