X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgc-common.c;h=7add9512717560b3535f0ae2be7c95e9fec85407;hb=debae3c18d31b5222be4d5de8dcb2601336e24a4;hp=0869cd928624686d77da175d8e4525fae0d87d67;hpb=4a8044ce718c8db3192c9013ea32a5eeee2df8a0;p=sbcl.git diff --git a/src/runtime/gc-common.c b/src/runtime/gc-common.c index 0869cd9..7add951 100644 --- a/src/runtime/gc-common.c +++ b/src/runtime/gc-common.c @@ -37,11 +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 "genesis/hash-table.h" #include "gc-internal.h" #ifdef LISP_FEATURE_SPARC @@ -52,6 +52,9 @@ #endif #endif +os_vm_size_t dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE; +os_vm_size_t thread_control_stack_size = DEFAULT_CONTROL_STACK_SIZE; + inline static boolean forwarding_pointer_p(lispobj *pointer) { lispobj first_word=*pointer; @@ -82,59 +85,49 @@ set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) { return newspace_copy; } -long (*scavtab[256])(lispobj *where, lispobj object); +sword_t (*scavtab[256])(lispobj *where, lispobj object); lispobj (*transother[256])(lispobj object); -long (*sizetab[256])(lispobj *where); +sword_t (*sizetab[256])(lispobj *where); struct weak_pointer *weak_pointers; -unsigned long bytes_consed_between_gcs = 12*1024*1024; - +os_vm_size_t bytes_consed_between_gcs = 12*1024*1024; /* * copying objects */ +/* gc_general_copy_object is inline from gc-internal.h */ + /* to copy a boxed object */ lispobj -copy_object(lispobj object, long nwords) +copy_object(lispobj object, sword_t nwords) { - int tag; - lispobj *new; - - gc_assert(is_lisp_pointer(object)); - gc_assert(from_space_p(object)); - gc_assert((nwords & 0x01) == 0); - - /* Get tag of object. */ - tag = lowtag_of(object); - - /* Allocate space. */ - new = gc_general_alloc(nwords*N_WORD_BYTES,ALLOC_BOXED,ALLOC_QUICK); + return gc_general_copy_object(object, nwords, BOXED_PAGE_FLAG); +} - /* Copy the object. */ - memcpy(new,native_pointer(object),nwords*N_WORD_BYTES); - return make_lispobj(new,tag); +lispobj +copy_code_object(lispobj object, sword_t nwords) +{ + return gc_general_copy_object(object, nwords, CODE_PAGE_FLAG); } -static long scav_lose(lispobj *where, lispobj object); /* forward decl */ +static sword_t 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) +scavenge(lispobj *start, sword_t n_words) { lispobj *end = start + n_words; lispobj *object_ptr; - long n_words_scavenged; - - for (object_ptr = start; - object_ptr < end; - object_ptr += n_words_scavenged) { + for (object_ptr = start; object_ptr < end;) { lispobj object = *object_ptr; #ifdef LISP_FEATURE_GENCGC - gc_assert(!forwarding_pointer_p(object_ptr)); + if (forwarding_pointer_p(object_ptr)) + lose("unexpect forwarding pointer in scavenge: %p, start=%p, n=%l\n", + object_ptr, start, n_words); #endif if (is_lisp_pointer(object)) { if (from_space_p(object)) { @@ -144,57 +137,59 @@ scavenge(lispobj *start, long n_words) if (forwarding_pointer_p(ptr)) { /* Yes, there's a forwarding pointer. */ *object_ptr = LOW_WORD(forwarding_pointer_value(ptr)); - n_words_scavenged = 1; + object_ptr++; } else { /* Scavenge that pointer. */ - n_words_scavenged = + object_ptr += (scavtab[widetag_of(object)])(object_ptr, object); } } else { /* It points somewhere other than oldspace. Leave it * alone. */ - n_words_scavenged = 1; + object_ptr++; } } -#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 +#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) + /* This workaround is probably not needed for those ports + which don't have a partitioned register set (and therefore + scan the stack conservatively for roots). */ + 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); + 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 widetag = widetag_of(object); + + if ((scavtab[widetag] == scav_lose) || + (((sizetab[widetag])(object_ptr)) > 1)) { + fprintf(stderr,"warning: \ +attempted to scavenge non-descriptor value %x at %p.\n\n\ +If you can reproduce this warning, please send a bug report\n\ +(see manual page for details).\n", + object, object_ptr); } + object_ptr++; } #endif else if (fixnump(object)) { /* It's a fixnum: really easy.. */ - n_words_scavenged = 1; + object_ptr++; } else { /* It's some sort of header object or another. */ - n_words_scavenged = - (scavtab[widetag_of(object)])(object_ptr, object); + object_ptr += (scavtab[widetag_of(object)])(object_ptr, object); } } - gc_assert_verbose(object_ptr == end, "Final object pointer %p, end %p\n", - object_ptr, end); + gc_assert_verbose(object_ptr == end, "Final object pointer %p, start %p, end %p\n", + object_ptr, start, end); } static lispobj trans_fun_header(lispobj object); /* forward decls */ static lispobj trans_boxed(lispobj object); -static long +static sword_t scav_fun_pointer(lispobj *where, lispobj object) { lispobj *first_pointer; @@ -236,8 +231,8 @@ trans_code(struct code *code) { struct code *new_code; lispobj first, l_code, l_new_code; - long nheader_words, ncode_words, nwords; - unsigned long displacement; + uword_t nheader_words, ncode_words, nwords; + uword_t displacement; lispobj fheaderl, *prev_pointer; /* if object has already been transported, just return pointer */ @@ -260,12 +255,12 @@ trans_code(struct code *code) nwords = ncode_words + nheader_words; nwords = CEILING(nwords, 2); - l_new_code = copy_object(l_code, nwords); + l_new_code = copy_code_object(l_code, nwords); new_code = (struct code *) native_pointer(l_new_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); + (uword_t) code, (uword_t) new_code); printf("Code object is %d words long.\n", nwords); #endif @@ -314,19 +309,26 @@ trans_code(struct code *code) fheaderl = fheaderp->next; prev_pointer = &nfheaderp->next; } - os_flush_icache((os_vm_address_t) (((long *)new_code) + nheader_words), - ncode_words * sizeof(long)); #ifdef LISP_FEATURE_GENCGC + /* Cheneygc doesn't need this os_flush_icache, it flushes the whole + spaces once when all copying is done. */ + os_flush_icache((os_vm_address_t) (((sword_t *)new_code) + nheader_words), + ncode_words * sizeof(sword_t)); + +#endif + +#ifdef LISP_FEATURE_X86 gencgc_apply_code_fixups(code, new_code); #endif + return new_code; } -static long +static sword_t scav_code_header(lispobj *where, lispobj object) { struct code *code; - long n_header_words, n_code_words, n_words; + sword_t 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 */ @@ -345,8 +347,9 @@ scav_code_header(lispobj *where, lispobj object) entry_point != NIL; entry_point = function_ptr->next) { - gc_assert_verbose(is_lisp_pointer(entry_point), "Entry point %lx\n", - (long)entry_point); + gc_assert_verbose(is_lisp_pointer(entry_point), + "Entry point %lx\n is not a lisp pointer.", + (sword_t)entry_point); function_ptr = (struct simple_fun *) native_pointer(entry_point); gc_assert(widetag_of(function_ptr->header)==SIMPLE_FUN_HEADER_WIDETAG); @@ -354,6 +357,7 @@ scav_code_header(lispobj *where, lispobj object) scavenge(&function_ptr->name, 1); scavenge(&function_ptr->arglist, 1); scavenge(&function_ptr->type, 1); + scavenge(&function_ptr->info, 1); } return n_words; @@ -369,11 +373,11 @@ trans_code_header(lispobj object) } -static long +static sword_t size_code_header(lispobj *where) { struct code *code; - long nheader_words, ncode_words, nwords; + sword_t nheader_words, ncode_words, nwords; code = (struct code *) where; @@ -386,12 +390,12 @@ size_code_header(lispobj *where) } #if !defined(LISP_FEATURE_X86) && ! defined(LISP_FEATURE_X86_64) -static long +static sword_t scav_return_pc_header(lispobj *where, lispobj object) { lose("attempted to scavenge a return PC header where=0x%08x object=0x%08x\n", - (unsigned long) where, - (unsigned long) object); + (uword_t) where, + (uword_t) object); return 0; /* bogus return value to satisfy static type checking */ } #endif /* LISP_FEATURE_X86 */ @@ -400,7 +404,7 @@ static lispobj trans_return_pc_header(lispobj object) { struct simple_fun *return_pc; - unsigned long offset; + uword_t offset; struct code *code, *ncode; return_pc = (struct simple_fun *) native_pointer(object); @@ -408,7 +412,7 @@ trans_return_pc_header(lispobj object) offset = HeaderValue(return_pc->header) * N_WORD_BYTES; /* Transport the whole code object */ - code = (struct code *) ((unsigned long) return_pc - offset); + code = (struct code *) ((uword_t) return_pc - offset); ncode = trans_code(code); return ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG; @@ -421,7 +425,7 @@ trans_return_pc_header(lispobj object) * have to figure out that the function is still live. */ #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) -static long +static sword_t scav_closure_header(lispobj *where, lispobj object) { struct closure *closure; @@ -441,12 +445,12 @@ scav_closure_header(lispobj *where, lispobj object) #endif #if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)) -static long +static sword_t scav_fun_header(lispobj *where, lispobj object) { lose("attempted to scavenge a function header where=0x%08x object=0x%08x\n", - (unsigned long) where, - (unsigned long) object); + (uword_t) where, + (uword_t) object); return 0; /* bogus return value to satisfy static type checking */ } #endif /* LISP_FEATURE_X86 */ @@ -455,7 +459,7 @@ static lispobj trans_fun_header(lispobj object) { struct simple_fun *fheader; - unsigned long offset; + uword_t offset; struct code *code, *ncode; fheader = (struct simple_fun *) native_pointer(object); @@ -463,7 +467,7 @@ trans_fun_header(lispobj object) offset = HeaderValue(fheader->header) * N_WORD_BYTES; /* Transport the whole code object */ - code = (struct code *) ((unsigned long) fheader - offset); + code = (struct code *) ((uword_t) fheader - offset); ncode = trans_code(code); return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG; @@ -474,7 +478,7 @@ trans_fun_header(lispobj object) * instances */ -static long +static sword_t scav_instance_pointer(lispobj *where, lispobj object) { lispobj copy, *first_pointer; @@ -500,7 +504,7 @@ scav_instance_pointer(lispobj *where, lispobj object) static lispobj trans_list(lispobj object); -static long +static sword_t scav_list_pointer(lispobj *where, lispobj object) { lispobj first, *first_pointer; @@ -535,7 +539,7 @@ trans_list(lispobj object) /* Copy 'object'. */ new_cons = (struct cons *) - gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK); + gc_general_alloc(sizeof(struct cons), BOXED_PAGE_FLAG, ALLOC_QUICK); new_cons->car = cons->car; new_cons->cdr = cons->cdr; /* updated later */ new_list_pointer = make_lispobj(new_cons,lowtag_of(object)); @@ -560,7 +564,7 @@ trans_list(lispobj object) /* Copy 'cdr'. */ new_cdr_cons = (struct cons*) - gc_general_alloc(sizeof(struct cons),ALLOC_BOXED,ALLOC_QUICK); + gc_general_alloc(sizeof(struct cons), BOXED_PAGE_FLAG, 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)); @@ -584,7 +588,7 @@ trans_list(lispobj object) * scavenging and transporting other pointers */ -static long +static sword_t scav_other_pointer(lispobj *where, lispobj object) { lispobj first, *first_pointer; @@ -614,13 +618,13 @@ scav_other_pointer(lispobj *where, lispobj object) * immediate, boxed, and unboxed objects */ -static long +static sword_t size_pointer(lispobj *where) { return 1; } -static long +static sword_t scav_immediate(lispobj *where, lispobj object) { return 1; @@ -633,24 +637,24 @@ trans_immediate(lispobj object) return NIL; /* bogus return value to satisfy static type checking */ } -static long +static sword_t size_immediate(lispobj *where) { return 1; } -static long +static sword_t scav_boxed(lispobj *where, lispobj object) { return 1; } -static long +static sword_t scav_instance(lispobj *where, lispobj object) { lispobj nuntagged; - long ntotal = HeaderValue(object); + sword_t ntotal = HeaderValue(object); lispobj layout = ((struct instance *)where)->slots[0]; if (!layout) @@ -668,7 +672,7 @@ static lispobj trans_boxed(lispobj object) { lispobj header; - unsigned long length; + uword_t length; gc_assert(is_lisp_pointer(object)); @@ -680,11 +684,11 @@ trans_boxed(lispobj object) } -static long +static sword_t size_boxed(lispobj *where) { lispobj header; - unsigned long length; + uword_t length; header = *where; length = HeaderValue(header) + 1; @@ -695,8 +699,8 @@ 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 long +#if !defined(LISP_FEATURE_SPARC) +static sword_t scav_fdefn(lispobj *where, lispobj object) { struct fdefn *fdefn; @@ -706,8 +710,7 @@ scav_fdefn(lispobj *where, lispobj object) /* 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))) { + if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) == fdefn->raw_addr) { scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1); /* Don't write unnecessarily. */ @@ -724,10 +727,10 @@ scav_fdefn(lispobj *where, lispobj object) } #endif -static long +static sword_t scav_unboxed(lispobj *where, lispobj object) { - unsigned long length; + uword_t length; length = HeaderValue(object) + 1; length = CEILING(length, 2); @@ -739,7 +742,7 @@ static lispobj trans_unboxed(lispobj object) { lispobj header; - unsigned long length; + uword_t length; gc_assert(is_lisp_pointer(object)); @@ -751,11 +754,11 @@ trans_unboxed(lispobj object) return copy_unboxed_object(object, length); } -static long +static sword_t size_unboxed(lispobj *where) { lispobj header; - unsigned long length; + uword_t length; header = *where; length = HeaderValue(header) + 1; @@ -766,11 +769,11 @@ size_unboxed(lispobj *where) /* vector-like objects */ -static long +static sword_t scav_base_string(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; /* NOTE: Strings contain one more byte of data than the length */ /* slot indicates. */ @@ -785,7 +788,7 @@ static lispobj trans_base_string(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -800,11 +803,11 @@ trans_base_string(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_base_string(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; /* NOTE: A string contains one more byte of data (a terminating * '\0' to help when interfacing with C functions) than indicated @@ -817,7 +820,7 @@ size_base_string(lispobj *where) return nwords; } -static long +static sword_t scav_character_string(lispobj *where, lispobj object) { struct vector *vector; @@ -851,7 +854,7 @@ trans_character_string(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_character_string(lispobj *where) { struct vector *vector; @@ -872,7 +875,7 @@ static lispobj trans_vector(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -884,11 +887,11 @@ trans_vector(lispobj object) return copy_large_object(object, nwords); } -static long +static sword_t size_vector(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -897,7 +900,7 @@ size_vector(lispobj *where) return nwords; } -static long +static sword_t scav_vector_nil(lispobj *where, lispobj object) { return 2; @@ -910,18 +913,18 @@ trans_vector_nil(lispobj object) return copy_unboxed_object(object, 2); } -static long +static sword_t size_vector_nil(lispobj *where) { /* Just the header word and the length word */ return 2; } -static long +static sword_t scav_vector_bit(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -934,7 +937,7 @@ static lispobj trans_vector_bit(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -945,11 +948,11 @@ trans_vector_bit(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_vector_bit(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -958,11 +961,11 @@ size_vector_bit(lispobj *where) return nwords; } -static long +static sword_t scav_vector_unsigned_byte_2(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -975,7 +978,7 @@ static lispobj trans_vector_unsigned_byte_2(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -986,11 +989,11 @@ trans_vector_unsigned_byte_2(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_vector_unsigned_byte_2(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -999,11 +1002,11 @@ size_vector_unsigned_byte_2(lispobj *where) return nwords; } -static long +static sword_t scav_vector_unsigned_byte_4(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1016,7 +1019,7 @@ static lispobj trans_vector_unsigned_byte_4(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -1026,11 +1029,11 @@ trans_vector_unsigned_byte_4(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_vector_unsigned_byte_4(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1040,11 +1043,11 @@ size_vector_unsigned_byte_4(lispobj *where) } -static long +static sword_t scav_vector_unsigned_byte_8(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1061,7 +1064,7 @@ static lispobj trans_vector_unsigned_byte_8(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -1072,11 +1075,11 @@ trans_vector_unsigned_byte_8(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_vector_unsigned_byte_8(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1086,11 +1089,11 @@ size_vector_unsigned_byte_8(lispobj *where) } -static long +static sword_t scav_vector_unsigned_byte_16(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1103,7 +1106,7 @@ static lispobj trans_vector_unsigned_byte_16(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -1114,11 +1117,11 @@ trans_vector_unsigned_byte_16(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_vector_unsigned_byte_16(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1127,11 +1130,11 @@ size_vector_unsigned_byte_16(lispobj *where) return nwords; } -static long +static sword_t scav_vector_unsigned_byte_32(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1144,7 +1147,7 @@ static lispobj trans_vector_unsigned_byte_32(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -1155,11 +1158,11 @@ trans_vector_unsigned_byte_32(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_vector_unsigned_byte_32(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1169,11 +1172,11 @@ size_vector_unsigned_byte_32(lispobj *where) } #if N_WORD_BITS == 64 -static long +static sword_t scav_vector_unsigned_byte_64(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1186,7 +1189,7 @@ static lispobj trans_vector_unsigned_byte_64(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -1197,11 +1200,11 @@ trans_vector_unsigned_byte_64(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_vector_unsigned_byte_64(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1211,11 +1214,11 @@ size_vector_unsigned_byte_64(lispobj *where) } #endif -static long +static sword_t scav_vector_single_float(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1228,7 +1231,7 @@ static lispobj trans_vector_single_float(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -1239,11 +1242,11 @@ trans_vector_single_float(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_vector_single_float(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1252,11 +1255,11 @@ size_vector_single_float(lispobj *where) return nwords; } -static long +static sword_t scav_vector_double_float(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1269,7 +1272,7 @@ static lispobj trans_vector_double_float(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -1280,11 +1283,11 @@ trans_vector_double_float(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_vector_double_float(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1327,7 +1330,7 @@ static long size_vector_long_float(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1339,11 +1342,11 @@ size_vector_long_float(lispobj *where) #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG -static long +static sword_t scav_vector_complex_single_float(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1356,7 +1359,7 @@ static lispobj trans_vector_complex_single_float(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -1367,11 +1370,11 @@ trans_vector_complex_single_float(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_vector_complex_single_float(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1382,11 +1385,11 @@ size_vector_complex_single_float(lispobj *where) #endif #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG -static long +static sword_t scav_vector_complex_double_float(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1399,7 +1402,7 @@ static lispobj trans_vector_complex_double_float(lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; gc_assert(is_lisp_pointer(object)); @@ -1410,11 +1413,11 @@ trans_vector_complex_double_float(lispobj object) return copy_large_unboxed_object(object, nwords); } -static long +static sword_t size_vector_complex_double_float(lispobj *where) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1430,7 +1433,7 @@ static long scav_vector_complex_long_float(lispobj *where, lispobj object) { struct vector *vector; - long length, nwords; + sword_t length, nwords; vector = (struct vector *) where; length = fixnum_value(vector->length); @@ -1499,7 +1502,7 @@ trans_weak_pointer(lispobj object) return copy; } -static long +static sword_t size_weak_pointer(lispobj *where) { return WEAK_POINTER_NWORDS; @@ -1508,11 +1511,17 @@ size_weak_pointer(lispobj *where) void scan_weak_pointers(void) { - struct weak_pointer *wp; - for (wp = weak_pointers; wp != NULL; wp=wp->next) { + struct weak_pointer *wp, *next_wp; + for (wp = weak_pointers, next_wp = NULL; wp != NULL; wp = next_wp) { lispobj value = wp->value; lispobj *first_pointer; gc_assert(widetag_of(wp->header)==WEAK_POINTER_WIDETAG); + + next_wp = wp->next; + wp->next = NULL; + if (next_wp == wp) /* gencgc uses a ref to self for end of list */ + next_wp = NULL; + if (!(is_lisp_pointer(value) && from_space_p(value))) continue; @@ -1534,18 +1543,322 @@ void scan_weak_pointers(void) } } + +/* Hash tables */ + +#if N_WORD_BITS == 32 +#define EQ_HASH_MASK 0x1fffffff +#elif N_WORD_BITS == 64 +#define EQ_HASH_MASK 0x1fffffffffffffff +#endif + +/* Compute the EQ-hash of KEY. This must match POINTER-HASH in + * target-hash-table.lisp. */ +#define EQ_HASH(key) ((key) & EQ_HASH_MASK) + +/* List of weak hash tables chained through their NEXT-WEAK-HASH-TABLE + * slot. Set to NULL at the end of a collection. + * + * This is not optimal because, when a table is tenured, it won't be + * processed automatically; only the yougest generation is GC'd by + * default. On the other hand, all applications will need an + * occasional full GC anyway, so it's not that bad either. */ +struct hash_table *weak_hash_tables = NULL; + +/* Return true if OBJ has already survived the current GC. */ +static inline int +survived_gc_yet (lispobj obj) +{ + return (!is_lisp_pointer(obj) || !from_space_p(obj) || + forwarding_pointer_p(native_pointer(obj))); +} + +static inline int +weak_hash_entry_alivep (lispobj weakness, lispobj key, lispobj value) +{ + switch (weakness) { + case KEY: + return survived_gc_yet(key); + case VALUE: + return survived_gc_yet(value); + case KEY_OR_VALUE: + return (survived_gc_yet(key) || survived_gc_yet(value)); + case KEY_AND_VALUE: + return (survived_gc_yet(key) && survived_gc_yet(value)); + default: + gc_assert(0); + /* Shut compiler up. */ + return 0; + } +} + +/* Return the beginning of data in ARRAY (skipping the header and the + * length) or NULL if it isn't an array of the specified widetag after + * all. */ +static inline lispobj * +get_array_data (lispobj array, int widetag, uword_t *length) +{ + if (is_lisp_pointer(array) && + (widetag_of(*(lispobj *)native_pointer(array)) == widetag)) { + if (length != NULL) + *length = fixnum_value(((lispobj *)native_pointer(array))[1]); + return ((lispobj *)native_pointer(array)) + 2; + } else { + return NULL; + } +} + +/* Only need to worry about scavenging the _real_ entries in the + * table. Phantom entries such as the hash table itself at index 0 and + * the empty marker at index 1 were scavenged by scav_vector that + * either called this function directly or arranged for it to be + * called later by pushing the hash table onto weak_hash_tables. */ +static void +scav_hash_table_entries (struct hash_table *hash_table) +{ + lispobj *kv_vector; + uword_t kv_length; + lispobj *index_vector; + uword_t length; + lispobj *next_vector; + uword_t next_vector_length; + lispobj *hash_vector; + uword_t hash_vector_length; + lispobj empty_symbol; + lispobj weakness = hash_table->weakness; + uword_t i; + + kv_vector = get_array_data(hash_table->table, + SIMPLE_VECTOR_WIDETAG, &kv_length); + if (kv_vector == NULL) + lose("invalid kv_vector %x\n", hash_table->table); + + index_vector = get_array_data(hash_table->index_vector, + SIMPLE_ARRAY_WORD_WIDETAG, &length); + if (index_vector == NULL) + lose("invalid index_vector %x\n", hash_table->index_vector); + + next_vector = get_array_data(hash_table->next_vector, + SIMPLE_ARRAY_WORD_WIDETAG, + &next_vector_length); + if (next_vector == NULL) + lose("invalid next_vector %x\n", hash_table->next_vector); + + hash_vector = get_array_data(hash_table->hash_vector, + SIMPLE_ARRAY_WORD_WIDETAG, + &hash_vector_length); + if (hash_vector != NULL) + gc_assert(hash_vector_length == next_vector_length); + + /* These lengths could be different as the index_vector can be a + * different length from the others, a larger index_vector could + * help reduce collisions. */ + gc_assert(next_vector_length*2 == kv_length); + + empty_symbol = kv_vector[1]; + /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/ + if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) != + SYMBOL_HEADER_WIDETAG) { + lose("not a symbol where empty-hash-table-slot symbol expected: %x\n", + *(lispobj *)native_pointer(empty_symbol)); + } + + /* Work through the KV vector. */ + for (i = 1; i < next_vector_length; i++) { + lispobj old_key = kv_vector[2*i]; + lispobj value = kv_vector[2*i+1]; + if ((weakness == NIL) || + weak_hash_entry_alivep(weakness, old_key, value)) { + + /* Scavenge the key and value. */ + scavenge(&kv_vector[2*i],2); + + /* If an EQ-based key has moved, mark the hash-table for + * rehashing. */ + if (!hash_vector || hash_vector[i] == MAGIC_HASH_VECTOR_VALUE) { + lispobj new_key = kv_vector[2*i]; + + if (old_key != new_key && new_key != empty_symbol) { + hash_table->needs_rehash_p = T; + } + } + } + } +} + +sword_t +scav_vector (lispobj *where, lispobj object) +{ + uword_t kv_length; + struct hash_table *hash_table; + + /* SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based and weak + * hash tables in the Lisp HASH-TABLE code to indicate need for + * special GC support. */ + if (HeaderValue(object) == subtype_VectorNormal) + return 1; + + kv_length = fixnum_value(where[1]); + /*FSHOW((stderr,"/kv_length = %d\n", kv_length));*/ + + /* Scavenge element 0, which may be a hash-table structure. */ + scavenge(where+2, 1); + if (!is_lisp_pointer(where[2])) { + /* This'll happen when REHASH clears the header of old-kv-vector + * and fills it with zero, but some other thread simulatenously + * sets the header in %%PUTHASH. + */ + fprintf(stderr, + "Warning: no pointer at %p in hash table: this indicates " + "non-fatal corruption caused by concurrent access to a " + "hash-table from multiple threads. Any accesses to " + "hash-tables shared between threads should be protected " + "by locks.\n", (uword_t)&where[2]); + // We've scavenged three words. + return 3; + } + hash_table = (struct hash_table *)native_pointer(where[2]); + /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/ + if (widetag_of(hash_table->header) != INSTANCE_HEADER_WIDETAG) { + lose("hash table not instance (%x at %x)\n", + hash_table->header, + hash_table); + } + + /* Scavenge element 1, which should be some internal symbol that + * the hash table code reserves for marking empty slots. */ + scavenge(where+3, 1); + if (!is_lisp_pointer(where[3])) { + lose("not empty-hash-table-slot symbol pointer: %x\n", where[3]); + } + + /* Scavenge hash table, which will fix the positions of the other + * needed objects. */ + scavenge((lispobj *)hash_table, + sizeof(struct hash_table) / sizeof(lispobj)); + + /* Cross-check the kv_vector. */ + if (where != (lispobj *)native_pointer(hash_table->table)) { + lose("hash_table table!=this table %x\n", hash_table->table); + } + + if (hash_table->weakness == NIL) { + scav_hash_table_entries(hash_table); + } else { + /* Delay scavenging of this table by pushing it onto + * weak_hash_tables (if it's not there already) for the weak + * object phase. */ + if (hash_table->next_weak_hash_table == NIL) { + hash_table->next_weak_hash_table = (lispobj)weak_hash_tables; + weak_hash_tables = hash_table; + } + } + + return (CEILING(kv_length + 2, 2)); +} + +void +scav_weak_hash_tables (void) +{ + struct hash_table *table; + + /* Scavenge entries whose triggers are known to survive. */ + for (table = weak_hash_tables; table != NULL; + table = (struct hash_table *)table->next_weak_hash_table) { + scav_hash_table_entries(table); + } +} + +/* Walk through the chain whose first element is *FIRST and remove + * dead weak entries. */ +static inline void +scan_weak_hash_table_chain (struct hash_table *hash_table, lispobj *prev, + lispobj *kv_vector, lispobj *index_vector, + lispobj *next_vector, lispobj *hash_vector, + lispobj empty_symbol, lispobj weakness) +{ + unsigned index = *prev; + while (index) { + unsigned next = next_vector[index]; + lispobj key = kv_vector[2 * index]; + lispobj value = kv_vector[2 * index + 1]; + gc_assert(key != empty_symbol); + gc_assert(value != empty_symbol); + if (!weak_hash_entry_alivep(weakness, key, value)) { + unsigned count = fixnum_value(hash_table->number_entries); + gc_assert(count > 0); + *prev = next; + hash_table->number_entries = make_fixnum(count - 1); + next_vector[index] = fixnum_value(hash_table->next_free_kv); + hash_table->next_free_kv = make_fixnum(index); + kv_vector[2 * index] = empty_symbol; + kv_vector[2 * index + 1] = empty_symbol; + if (hash_vector) + hash_vector[index] = MAGIC_HASH_VECTOR_VALUE; + } else { + prev = &next_vector[index]; + } + index = next; + } +} + +static void +scan_weak_hash_table (struct hash_table *hash_table) +{ + lispobj *kv_vector; + lispobj *index_vector; + uword_t length = 0; /* prevent warning */ + lispobj *next_vector; + uword_t next_vector_length = 0; /* prevent warning */ + lispobj *hash_vector; + lispobj empty_symbol; + lispobj weakness = hash_table->weakness; + uword_t i; + + kv_vector = get_array_data(hash_table->table, + SIMPLE_VECTOR_WIDETAG, NULL); + index_vector = get_array_data(hash_table->index_vector, + SIMPLE_ARRAY_WORD_WIDETAG, &length); + next_vector = get_array_data(hash_table->next_vector, + SIMPLE_ARRAY_WORD_WIDETAG, + &next_vector_length); + hash_vector = get_array_data(hash_table->hash_vector, + SIMPLE_ARRAY_WORD_WIDETAG, NULL); + empty_symbol = kv_vector[1]; + + for (i = 0; i < length; i++) { + scan_weak_hash_table_chain(hash_table, &index_vector[i], + kv_vector, index_vector, next_vector, + hash_vector, empty_symbol, weakness); + } +} + +/* Remove dead entries from weak hash tables. */ +void +scan_weak_hash_tables (void) +{ + struct hash_table *table, *next; + + for (table = weak_hash_tables; table != NULL; table = next) { + next = (struct hash_table *)table->next_weak_hash_table; + table->next_weak_hash_table = NIL; + scan_weak_hash_table(table); + } + + weak_hash_tables = NULL; +} /* * initialization */ -static long +static sword_t scav_lose(lispobj *where, lispobj object) { lose("no scavenge function for object 0x%08x (widetag 0x%x)\n", - (unsigned long)object, - widetag_of(*(lispobj*)native_pointer(object))); + (uword_t)object, + widetag_of(*where)); return 0; /* bogus return value to satisfy static type checking */ } @@ -1554,17 +1867,17 @@ static lispobj trans_lose(lispobj object) { lose("no transport function for object 0x%08x (widetag 0x%x)\n", - (unsigned long)object, + (uword_t)object, widetag_of(*(lispobj*)native_pointer(object))); return NIL; /* bogus return value to satisfy static type checking */ } -static long +static sword_t size_lose(lispobj *where) { lose("no size function for object at 0x%08x (widetag 0x%x)\n", - (unsigned long)where, - widetag_of(LOW_WORD(where))); + (uword_t)where, + widetag_of(*where)); return 1; /* bogus return value to satisfy static type checking */ } @@ -1576,7 +1889,7 @@ size_lose(lispobj *where) void gc_init_tables(void) { - long i; + uword_t i, j; /* Set default value in all slots of scavenge table. FIXME * replace this gnarly sizeof with something based on @@ -1591,12 +1904,16 @@ gc_init_tables(void) */ for (i = 0; i < (1<<(N_WIDETAG_BITS-N_LOWTAG_BITS)); i++) { - scavtab[EVEN_FIXNUM_LOWTAG|(i<= hard_guard_page_address)) || + (((os_vm_address_t)sp < (guard_page_address + os_vm_page_size)) && + ((os_vm_address_t)sp >= guard_page_address) && + (th->control_stack_guard_page_protected != NIL))) + return; +#ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD + do { + *sp = 0; + } while (((uword_t)sp--) & (BYTES_ZERO_BEFORE_END - 1)); + if ((os_vm_address_t)sp < (hard_guard_page_address + os_vm_page_size)) + return; + do { + if (*sp) + goto scrub; + } while (((uword_t)sp--) & (BYTES_ZERO_BEFORE_END - 1)); +#else + do { + *sp = 0; + } while (((uword_t)++sp) & (BYTES_ZERO_BEFORE_END - 1)); + if ((os_vm_address_t)sp >= hard_guard_page_address) + return; + do { + if (*sp) + goto scrub; + } while (((uword_t)++sp) & (BYTES_ZERO_BEFORE_END - 1)); +#endif +#endif /* LISP_FEATURE_C_STACK_IS_CONTROL_STACK */ +} + +#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) + +void +scavenge_control_stack(struct thread *th) +{ + lispobj *object_ptr; + + /* In order to properly support dynamic-extent allocation of + * non-CONS objects, the control stack requires special handling. + * Rather than calling scavenge() directly, grovel over it fixing + * broken hearts, scavenging pointers to oldspace, and pitching a + * fit when encountering unboxed data. This prevents stray object + * headers from causing the scavenger to blow past the end of the + * stack (an error case checked in scavenge()). We don't worry + * about treating unboxed words as boxed or vice versa, because + * the compiler isn't allowed to store unboxed objects on the + * control stack. -- AB, 2011-Dec-02 */ + + for (object_ptr = th->control_stack_start; + object_ptr < access_control_stack_pointer(th); + object_ptr++) { + + lispobj object = *object_ptr; +#ifdef LISP_FEATURE_GENCGC + if (forwarding_pointer_p(object_ptr)) + lose("unexpected forwarding pointer in scavenge_control_stack: %p, start=%p, end=%p\n", + object_ptr, th->control_stack_start, access_control_stack_pointer(th)); +#endif + if (is_lisp_pointer(object) && 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)); + } else { + /* Scavenge that pointer. */ + long n_words_scavenged = + (scavtab[widetag_of(object)])(object_ptr, object); + gc_assert(n_words_scavenged == 1); + } + } else if (scavtab[widetag_of(object)] == scav_lose) { + lose("unboxed object in scavenge_control_stack: %p->%x, start=%p, end=%p\n", + object_ptr, object, th->control_stack_start, access_control_stack_pointer(th)); + } + } +} + +/* Scavenging Interrupt Contexts */ + +static int boxed_registers[] = BOXED_REGISTERS; + +/* The GC has a notion of an "interior pointer" register, an unboxed + * register that typically contains a pointer to inside an object + * referenced by another pointer. The most obvious of these is the + * program counter, although many compiler backends define a "Lisp + * Interior Pointer" register known to the runtime as reg_LIP, and + * various CPU architectures have other registers that also partake of + * the interior-pointer nature. As the code for pairing an interior + * pointer value up with its "base" register, and fixing it up after + * scavenging is complete is horribly repetitive, a few macros paper + * over the monotony. --AB, 2010-Jul-14 */ + +/* These macros are only ever used over a lexical environment which + * defines a pointer to an os_context_t called context, thus we don't + * bother to pass that context in as a parameter. */ + +/* Define how to access a given interior pointer. */ +#define ACCESS_INTERIOR_POINTER_pc \ + *os_context_pc_addr(context) +#define ACCESS_INTERIOR_POINTER_lip \ + *os_context_register_addr(context, reg_LIP) +#define ACCESS_INTERIOR_POINTER_lr \ + *os_context_lr_addr(context) +#define ACCESS_INTERIOR_POINTER_npc \ + *os_context_npc_addr(context) +#define ACCESS_INTERIOR_POINTER_ctr \ + *os_context_ctr_addr(context) + +#define INTERIOR_POINTER_VARS(name) \ + uword_t name##_offset; \ + int name##_register_pair + +#define PAIR_INTERIOR_POINTER(name) \ + pair_interior_pointer(context, \ + ACCESS_INTERIOR_POINTER_##name, \ + &name##_offset, \ + &name##_register_pair) + +/* One complexity here is that if a paired register is not found for + * an interior pointer, then that pointer does not get updated. + * Originally, there was some commentary about using an index of -1 + * when calling os_context_register_addr() on SPARC referring to the + * program counter, but the real reason is to allow an interior + * pointer register to point to the runtime, read-only space, or + * static space without problems. */ +#define FIXUP_INTERIOR_POINTER(name) \ + do { \ + if (name##_register_pair >= 0) { \ + ACCESS_INTERIOR_POINTER_##name = \ + (*os_context_register_addr(context, \ + name##_register_pair) \ + & ~LOWTAG_MASK) \ + + name##_offset; \ + } \ + } while (0) + + +static void +pair_interior_pointer(os_context_t *context, uword_t pointer, + uword_t *saved_offset, int *register_pair) +{ + int i; + + /* + * I (RLT) think this is trying to find the boxed register that is + * closest to the LIP address, without going past it. Usually, it's + * reg_CODE or reg_LRA. But sometimes, nothing can be found. + */ + /* 0x7FFFFFFF on 32-bit platforms; + 0x7FFFFFFFFFFFFFFF on 64-bit platforms */ + *saved_offset = (((uword_t)1) << (N_WORD_BITS - 1)) - 1; + *register_pair = -1; + for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { + uword_t reg; + sword_t offset; + int index; + + index = boxed_registers[i]; + reg = *os_context_register_addr(context, index); + + /* An interior pointer is never relative to a non-pointer + * register (an oversight in the original implementation). + * The simplest argument for why this is true is to consider + * the fixnum that happens by coincide to be the word-index in + * memory of the header for some object plus two. This is + * happenstance would cause the register containing the fixnum + * to be selected as the register_pair if the interior pointer + * is to anywhere after the first two words of the object. + * The fixnum won't be changed during GC, but the object might + * move, thus destroying the interior pointer. --AB, + * 2010-Jul-14 */ + + if (is_lisp_pointer(reg) && + ((reg & ~LOWTAG_MASK) <= pointer)) { + offset = pointer - (reg & ~LOWTAG_MASK); + if (offset < *saved_offset) { + *saved_offset = offset; + *register_pair = index; + } + } + } +} + +static void +scavenge_interrupt_context(os_context_t * context) +{ + int i; + + /* FIXME: The various #ifdef noise here is precisely that: noise. + * Is it possible to fold it into the macrology so that we have + * one set of #ifdefs and then INTERIOR_POINTER_VARS /et alia/ + * compile out for the registers that don't exist on a given + * platform? */ + + INTERIOR_POINTER_VARS(pc); +#ifdef reg_LIP + INTERIOR_POINTER_VARS(lip); +#endif +#ifdef ARCH_HAS_LINK_REGISTER + INTERIOR_POINTER_VARS(lr); +#endif +#ifdef ARCH_HAS_NPC_REGISTER + INTERIOR_POINTER_VARS(npc); +#endif +#ifdef LISP_FEATURE_PPC + INTERIOR_POINTER_VARS(ctr); +#endif + + PAIR_INTERIOR_POINTER(pc); +#ifdef reg_LIP + PAIR_INTERIOR_POINTER(lip); +#endif +#ifdef ARCH_HAS_LINK_REGISTER + PAIR_INTERIOR_POINTER(lr); +#endif +#ifdef ARCH_HAS_NPC_REGISTER + PAIR_INTERIOR_POINTER(npc); +#endif +#ifdef LISP_FEATURE_PPC + PAIR_INTERIOR_POINTER(ctr); +#endif + + /* Scavenge all boxed registers in the context. */ + for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { + int index; + lispobj foo; + + index = boxed_registers[i]; + foo = *os_context_register_addr(context, index); + scavenge(&foo, 1); + *os_context_register_addr(context, index) = foo; + + /* this is unlikely to work as intended on bigendian + * 64 bit platforms */ + + scavenge((lispobj *) os_context_register_addr(context, index), 1); + } + + /* Now that the scavenging is done, repair the various interior + * pointers. */ + FIXUP_INTERIOR_POINTER(pc); +#ifdef reg_LIP + FIXUP_INTERIOR_POINTER(lip); +#endif +#ifdef ARCH_HAS_LINK_REGISTER + FIXUP_INTERIOR_POINTER(lr); +#endif +#ifdef ARCH_HAS_NPC_REGISTER + FIXUP_INTERIOR_POINTER(npc); +#endif +#ifdef LISP_FEATURE_PPC + FIXUP_INTERIOR_POINTER(ctr); +#endif +} + +void +scavenge_interrupt_contexts(struct thread *th) +{ + int i, index; + os_context_t *context; + + index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,th)); + +#if defined(DEBUG_PRINT_CONTEXT_INDEX) + printf("Number of active contexts: %d\n", index); +#endif + + for (i = 0; i < index; i++) { + context = th->interrupt_contexts[i]; + scavenge_interrupt_context(context); + } +} +#endif /* x86oid targets */