X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fpurify.c;h=b7b6ecdd04b0f18162af5344c4991896c821ffae;hb=c3699db2053ff3b5ac6a98d4431c3789496002d8;hp=ba5d88e0977d1e34e6e8a7d365b881495cdc86cd;hpb=6e662062162ad5a6f09d6d3a5ec1249520e813a5;p=sbcl.git diff --git a/src/runtime/purify.c b/src/runtime/purify.c index ba5d88e..b7b6ecd 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -16,6 +16,12 @@ #include #include #include +#include +#if (defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_LINUX)) +#include +#include +#endif +#include #include "runtime.h" #include "os.h" @@ -25,18 +31,21 @@ #include "interrupt.h" #include "purify.h" #include "interr.h" -#ifdef GENCGC -#include "gencgc.h" -#endif +#include "gc.h" +#include "gc-internal.h" +#include "thread.h" +#include "genesis/primitive-objects.h" +#include "genesis/static-symbols.h" #define PRINTNOISE -#if defined(__i386__) +#if defined(LISP_FEATURE_X86) /* again, what's so special about the x86 that this is differently * visible there than on other platforms? -dan 20010125 */ static lispobj *dynamic_space_free_pointer; #endif +extern unsigned long bytes_consed_between_gcs; #define gc_abort() \ lose("GC invariant lost, file \"%s\", line %d", __FILE__, __LINE__) @@ -75,7 +84,9 @@ static int later_count = 0; #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) #define NWORDS(x,y) (CEILING((x),(y)) / (y)) -/* FIXME: (1) Shouldn't this be defined in sbcl.h? */ +/* FIXME: Shouldn't this be defined in sbcl.h? See also notes in + * cheneygc.c */ + #ifdef sparc #define FUN_RAW_ADDR_OFFSET 0 #else @@ -85,9 +96,7 @@ static int later_count = 0; static boolean forwarding_pointer_p(lispobj obj) { - lispobj *ptr; - - ptr = (lispobj *)obj; + lispobj *ptr = native_pointer(obj); return ((static_end <= ptr && ptr <= static_free) || (read_only_end <= ptr && ptr <= read_only_free)); @@ -96,12 +105,10 @@ forwarding_pointer_p(lispobj obj) static boolean dynamic_pointer_p(lispobj ptr) { -#ifndef __i386__ - /* KLUDGE: This has an implicit dependence on the ordering of - * address spaces, and is therefore basically wrong. I'd fix it, - * but I don't have a non-386 port to test it on. Porters are - * encouraged to fix it. -- WHN 2000-10-17 */ - return (ptr >= (lispobj)DYNAMIC_SPACE_START); +#ifndef LISP_FEATURE_X86 + return (ptr >= (lispobj)current_dynamic_space + && + ptr < (lispobj)dynamic_space_free_pointer); #else /* Be more conservative, and remember, this is a maybe. */ return (ptr >= (lispobj)DYNAMIC_SPACE_START @@ -111,9 +118,9 @@ dynamic_pointer_p(lispobj ptr) } -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 -#ifdef GENCGC +#ifdef LISP_FEATURE_GENCGC /* * enhanced x86/GENCGC stack scavenging by Douglas Crosher * @@ -126,17 +133,11 @@ dynamic_pointer_p(lispobj ptr) static unsigned pointer_filter_verbose = 0; -/* FIXME: This is substantially the same code as in gencgc.c. (There - * are some differences, at least (1) the gencgc.c code needs to worry - * about return addresses on the stack pinning code objects, (2) the - * gencgc.c code needs to worry about the GC maybe happening in an - * interrupt service routine when the main thread of control was - * interrupted just as it had allocated memory and before it - * initialized it, while PURIFY needn't worry about that, and (3) the - * gencgc.c code has mutated more under maintenance since the fork - * from CMU CL than the code here has.) The two versions should be - * made to explicitly share common code, instead of just two different - * cut-and-pasted versions. */ +/* FIXME: This is substantially the same code as + * possibly_valid_dynamic_space_pointer in gencgc.c. The only + * relevant difference seems to be that the gencgc code also checks + * for raw pointers into Code objects */ + static int valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) { @@ -181,7 +182,7 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) return 0; } /* Is it plausible cons? */ - if((is_lisp_pointer(start_addr[0]) + if ((is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0) /* fixnum */ || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG) || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG)) @@ -221,8 +222,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) } return 0; } - /* Is it plausible? Not a cons. X should check the headers. */ - if(is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) { + /* Is it plausible? Not a cons. XXX should check the headers. */ + if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) { if (pointer_filter_verbose) { fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned int) pointer, (unsigned int) start_addr, *start_addr); @@ -268,7 +269,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) case COMPLEX_LONG_FLOAT_WIDETAG: #endif case SIMPLE_ARRAY_WIDETAG: - case COMPLEX_STRING_WIDETAG: + case COMPLEX_BASE_STRING_WIDETAG: + case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_BIT_VECTOR_WIDETAG: case COMPLEX_VECTOR_WIDETAG: case COMPLEX_ARRAY_WIDETAG: @@ -282,12 +284,17 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) #ifdef LONG_FLOAT_WIDETAG case LONG_FLOAT_WIDETAG: #endif - case SIMPLE_STRING_WIDETAG: + case SIMPLE_ARRAY_NIL_WIDETAG: + case SIMPLE_BASE_STRING_WIDETAG: case SIMPLE_BIT_VECTOR_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: @@ -364,6 +371,11 @@ setup_i386_stack_scav(lispobj *lowaddr, lispobj *base) * return addresses. This will also pick up pointers to * functions in code objects. */ if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) { + /* FIXME asserting here is a really dumb thing to do. + * If we've overflowed some arbitrary static limit, we + * should just refuse to purify, instead of killing + * the whole lisp session + */ gc_assert(num_valid_stack_ra_locations < MAX_STACK_RETURN_ADDRESSES); valid_stack_ra_locations[num_valid_stack_ra_locations] = sp; @@ -464,7 +476,7 @@ ptrans_boxed(lispobj thing, lispobj header, boolean constant) bcopy(old, new, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | lowtag_of(thing); + result = make_lispobj(new, lowtag_of(thing)); *old = result; /* Scavenge it. */ @@ -508,7 +520,7 @@ ptrans_instance(lispobj thing, lispobj header, boolean constant) bcopy(old, new, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | lowtag_of(thing); + result = make_lispobj(new, lowtag_of(thing)); *old = result; /* Scavenge it. */ @@ -540,7 +552,7 @@ ptrans_fdefn(lispobj thing, lispobj header) bcopy(old, new, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | lowtag_of(thing); + result = make_lispobj(new, lowtag_of(thing)); *old = result; /* Scavenge the function. */ @@ -558,19 +570,19 @@ ptrans_unboxed(lispobj thing, lispobj header) { int nwords; lispobj result, *new, *old; - + nwords = 1 + HeaderValue(header); - + /* Allocate it */ old = (lispobj *)native_pointer(thing); new = read_only_free; read_only_free += CEILING(nwords, 2); - + /* Copy it. */ bcopy(old, new, nwords * sizeof(lispobj)); - + /* Deposit forwarding pointer. */ - result = (lispobj)new | lowtag_of(thing); + result = make_lispobj(new , lowtag_of(thing)); *old = result; return result; @@ -598,7 +610,7 @@ ptrans_vector(lispobj thing, int bits, int extra, bcopy(vector, new, nwords * sizeof(lispobj)); - result = (lispobj)new | lowtag_of(thing); + result = make_lispobj(new, lowtag_of(thing)); vector->header = result; if (boxed) @@ -607,7 +619,7 @@ ptrans_vector(lispobj thing, int bits, int extra, return result; } -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 static void apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) { @@ -636,7 +648,7 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) if ((fixups==0) || (fixups==UNBOUND_MARKER_WIDETAG) || !is_lisp_pointer(fixups)) { -#ifdef GENCGC +#ifdef LISP_FEATURE_GENCGC /* Check for a possible errors. */ sniff_code_object(new_code,displacement); #endif @@ -684,7 +696,7 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) /* No longer need the fixups. */ new_code->constants[0] = 0; -#ifdef GENCGC +#ifdef LISP_FEATURE_GENCGC /* Check for possible errors. */ sniff_code_object(new_code,displacement); #endif @@ -706,11 +718,11 @@ ptrans_code(lispobj thing) bcopy(code, new, nwords * sizeof(lispobj)); -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 apply_code_fixups_during_purify(code,new); #endif - result = (lispobj)new | OTHER_POINTER_LOWTAG; + result = make_lispobj(new, OTHER_POINTER_LOWTAG); /* Stick in a forwarding pointer for the code object. */ *(lispobj *)code = result; @@ -728,7 +740,7 @@ ptrans_code(lispobj thing) /* Arrange to scavenge the debug info later. */ pscav_later(&new->debug_info, 1); - if(new->trace_table_offset & 0x3) + if (new->trace_table_offset & 0x3) #if 0 pscav(&new->trace_table_offset, 1, 0); #else @@ -746,13 +758,13 @@ ptrans_code(lispobj thing) gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG); gc_assert(!dynamic_pointer_p(func)); -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 /* Temporarly convert the self pointer to a real function pointer. */ ((struct simple_fun *)native_pointer(func))->self -= FUN_RAW_ADDR_OFFSET; #endif pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1); -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 ((struct simple_fun *)native_pointer(func))->self += FUN_RAW_ADDR_OFFSET; #endif @@ -775,8 +787,7 @@ ptrans_func(lispobj thing, lispobj header) * Otherwise we have to do something strange, 'cause it is buried * inside a code object. */ - if (widetag_of(header) == SIMPLE_FUN_HEADER_WIDETAG || - widetag_of(header) == CLOSURE_FUN_HEADER_WIDETAG) { + if (widetag_of(header) == SIMPLE_FUN_HEADER_WIDETAG) { /* We can only end up here if the code object has not been * scavenged, because if it had been scavenged, forwarding pointers @@ -784,12 +795,13 @@ ptrans_func(lispobj thing, lispobj header) function = (struct simple_fun *)native_pointer(thing); code = - (native_pointer(thing) - - (HeaderValue(function->header)*sizeof(lispobj))) | - OTHER_POINTER_LOWTAG; - + make_lispobj + ((native_pointer(thing) - + (HeaderValue(function->header))), OTHER_POINTER_LOWTAG); + /* This will cause the function's header to be replaced with a * forwarding pointer. */ + ptrans_code(code); /* So we can just return that. */ @@ -817,7 +829,7 @@ ptrans_func(lispobj thing, lispobj header) bcopy(old, new, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | lowtag_of(thing); + result = make_lispobj(new, lowtag_of(thing)); *old = result; /* Scavenge it. */ @@ -875,7 +887,7 @@ ptrans_list(lispobj thing, boolean constant) thing = new->cdr = old->cdr; /* Set up the forwarding pointer. */ - *(lispobj *)old = ((lispobj)new) | LIST_POINTER_LOWTAG; + *(lispobj *)old = make_lispobj(new, LIST_POINTER_LOWTAG); /* And count this cell. */ length++; @@ -886,13 +898,14 @@ ptrans_list(lispobj thing, boolean constant) /* Scavenge the list we just copied. */ pscav((lispobj *)orig, length * WORDS_PER_CONS, constant); - return ((lispobj)orig) | LIST_POINTER_LOWTAG; + return make_lispobj(orig, LIST_POINTER_LOWTAG); } static lispobj ptrans_otherptr(lispobj thing, lispobj header, boolean constant) { switch (widetag_of(header)) { + /* FIXME: this needs a reindent */ case BIGNUM_WIDETAG: case SINGLE_FLOAT_WIDETAG: case DOUBLE_FLOAT_WIDETAG: @@ -909,12 +922,14 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case COMPLEX_LONG_FLOAT_WIDETAG: #endif case SAP_WIDETAG: - return ptrans_unboxed(thing, header); + return ptrans_unboxed(thing, header); case RATIO_WIDETAG: case COMPLEX_WIDETAG: case SIMPLE_ARRAY_WIDETAG: - case COMPLEX_STRING_WIDETAG: + case COMPLEX_BASE_STRING_WIDETAG: + case COMPLEX_BIT_VECTOR_WIDETAG: + case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_VECTOR_WIDETAG: case COMPLEX_ARRAY_WIDETAG: return ptrans_boxed(thing, header, constant); @@ -926,7 +941,10 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case SYMBOL_HEADER_WIDETAG: return ptrans_boxed(thing, header, 0); - case SIMPLE_STRING_WIDETAG: + case SIMPLE_ARRAY_NIL_WIDETAG: + return ptrans_vector(thing, 0, 0, 0, constant); + + case SIMPLE_BASE_STRING_WIDETAG: return ptrans_vector(thing, 8, 1, 0, constant); case SIMPLE_BIT_VECTOR_WIDETAG: @@ -944,21 +962,25 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG: #endif return ptrans_vector(thing, 8, 0, 0, constant); case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG: #endif return ptrans_vector(thing, 16, 0, 0, constant); case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG: #endif #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG: #endif return ptrans_vector(thing, 32, 0, 0, constant); @@ -970,7 +992,7 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG: -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 return ptrans_vector(thing, 96, 0, 0, constant); #endif #ifdef sparc @@ -990,7 +1012,7 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG: -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 return ptrans_vector(thing, 192, 0, 0, constant); #endif #ifdef sparc @@ -1027,7 +1049,7 @@ pscav_fdefn(struct fdefn *fdefn) return sizeof(struct fdefn) / sizeof(lispobj); } -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 /* now putting code objects in static space */ static int pscav_code(struct code*code) @@ -1050,14 +1072,14 @@ pscav_code(struct code*code) gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG); gc_assert(!dynamic_pointer_p(func)); -#ifdef __i386__ - /* Temporarly convert the self pointer to a real function +#ifdef LISP_FEATURE_X86 + /* Temporarily convert the self pointer to a real function * pointer. */ ((struct simple_fun *)native_pointer(func))->self -= FUN_RAW_ADDR_OFFSET; #endif pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1); -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 ((struct simple_fun *)native_pointer(func))->self += FUN_RAW_ADDR_OFFSET; #endif @@ -1137,7 +1159,11 @@ pscav(lispobj *addr, int nwords, boolean constant) count = 1; break; - case SIMPLE_STRING_WIDETAG: + case SIMPLE_ARRAY_NIL_WIDETAG: + count = 2; + break; + + case SIMPLE_BASE_STRING_WIDETAG: vector = (struct vector *)addr; count = CEILING(NWORDS(fixnum_value(vector->length)+1,4)+2,2); break; @@ -1160,6 +1186,7 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG: #endif vector = (struct vector *)addr; count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2); @@ -1168,6 +1195,7 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG: #endif vector = (struct vector *)addr; count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2); @@ -1176,9 +1204,11 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG: #endif #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG: #endif vector = (struct vector *)addr; count = CEILING(fixnum_value(vector->length)+2,2); @@ -1200,7 +1230,7 @@ pscav(lispobj *addr, int nwords, boolean constant) #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG: vector = (struct vector *)addr; -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 count = fixnum_value(vector->length)*3+2; #endif #ifdef sparc @@ -1219,7 +1249,7 @@ pscav(lispobj *addr, int nwords, boolean constant) #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG: vector = (struct vector *)addr; -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 count = fixnum_value(vector->length)*6+2; #endif #ifdef sparc @@ -1229,7 +1259,7 @@ pscav(lispobj *addr, int nwords, boolean constant) #endif case CODE_HEADER_WIDETAG: -#ifndef __i386__ +#ifndef LISP_FEATURE_X86 gc_abort(); /* no code headers in static space */ #else count = pscav_code((struct code*)addr); @@ -1237,14 +1267,13 @@ pscav(lispobj *addr, int nwords, boolean constant) break; case SIMPLE_FUN_HEADER_WIDETAG: - case CLOSURE_FUN_HEADER_WIDETAG: case RETURN_PC_HEADER_WIDETAG: /* We should never hit any of these, 'cause they occur * buried in the middle of code objects. */ gc_abort(); break; -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 case CLOSURE_HEADER_WIDETAG: case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: /* The function self pointer needs special care on the @@ -1295,13 +1324,17 @@ purify(lispobj static_roots, lispobj read_only_roots) lispobj *clean; int count, i; struct later *laters, *next; + struct thread *thread; #ifdef PRINTNOISE printf("[doing purification:"); fflush(stdout); #endif - - if (fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)) != 0) { +#ifdef LISP_FEATURE_GENCGC + gc_alloc_update_all_page_tables(); +#endif + for_each_thread(thread) + if (fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)) != 0) { /* FIXME: 1. What does this mean? 2. It shouldn't be reporting * its error simply by a. printing a string b. to stdout instead * of stderr. */ @@ -1310,24 +1343,41 @@ purify(lispobj static_roots, lispobj read_only_roots) return 0; } -#if defined(__i386__) +#if defined(LISP_FEATURE_X86) dynamic_space_free_pointer = - (lispobj*)SymbolValue(ALLOCATION_POINTER); + (lispobj*)SymbolValue(ALLOCATION_POINTER,0); #endif read_only_end = read_only_free = - (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER); + (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0); static_end = static_free = - (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER); + (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0); #ifdef PRINTNOISE printf(" roots"); fflush(stdout); #endif -#ifdef GENCGC - gc_assert((lispobj *)CONTROL_STACK_END > ((&read_only_roots)+1)); - setup_i386_stack_scav(((&static_roots)-2), (lispobj *)CONTROL_STACK_END); +#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86)) +#if 0 + /* This is what we should do, but can't unless the threads in + * question are suspended with ptrace. That's right, purify is not + * threadsafe + */ + for_each_thread(thread) { + void **ptr; + struct user_regs_struct regs; + if(ptrace(PTRACE_GETREGS,thread->pid,0,®s)){ + fprintf(stderr,"child pid %d, %s\n",thread->pid,strerror(errno)); + lose("PTRACE_GETREGS"); + } + setup_i386_stack_scav(regs.ebp, + ((void *)thread->control_stack_end)); + } +#endif /* 0 */ + /* stopgap until we can set things up as in preceding comment */ + setup_i386_stack_scav(((&static_roots)-2), + ((void *)all_threads->control_stack_end)); #endif pscav(&static_roots, 1, 0); @@ -1337,20 +1387,22 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" handlers"); fflush(stdout); #endif - pscav((lispobj *) interrupt_handlers, - sizeof(interrupt_handlers) / sizeof(lispobj), + pscav((lispobj *) all_threads->interrupt_data->interrupt_handlers, + sizeof(all_threads->interrupt_data->interrupt_handlers) + / sizeof(lispobj), 0); #ifdef PRINTNOISE printf(" stack"); fflush(stdout); #endif -#ifndef __i386__ - pscav((lispobj *)CONTROL_STACK_START, - current_control_stack_pointer - (lispobj *)CONTROL_STACK_START, +#ifndef LISP_FEATURE_X86 + pscav((lispobj *)all_threads->control_stack_start, + current_control_stack_pointer - + all_threads->control_stack_start, 0); #else -#ifdef GENCGC +#ifdef LISP_FEATURE_GENCGC pscav_i386_stack(); #endif #endif @@ -1359,15 +1411,24 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" bindings"); fflush(stdout); #endif -#if !defined(__i386__) - pscav( (lispobj *)BINDING_STACK_START, - (lispobj *)current_binding_stack_pointer - (lispobj *)BINDING_STACK_START, +#if !defined(LISP_FEATURE_X86) + pscav( (lispobj *)all_threads->binding_stack_start, + (lispobj *)current_binding_stack_pointer - + all_threads->binding_stack_start, 0); #else - pscav( (lispobj *)BINDING_STACK_START, - (lispobj *)SymbolValue(BINDING_STACK_POINTER) - - (lispobj *)BINDING_STACK_START, + for_each_thread(thread) { + pscav( (lispobj *)thread->binding_stack_start, + (lispobj *)SymbolValue(BINDING_STACK_POINTER,thread) - + (lispobj *)thread->binding_stack_start, 0); + pscav( (lispobj *) (thread+1), + fixnum_value(SymbolValue(FREE_TLS_INDEX,0)) - + (sizeof (struct thread))/(sizeof (lispobj)), + 0); + } + + #endif /* The original CMU CL code had scavenge-read-only-space code @@ -1430,23 +1491,23 @@ purify(lispobj static_roots, lispobj read_only_roots) /* Zero the stack. Note that the stack is also zeroed by SUB-GC * calling SCRUB-CONTROL-STACK - this zeros the stack on the x86. */ -#ifndef __i386__ +#ifndef LISP_FEATURE_X86 os_zero((os_vm_address_t) current_control_stack_pointer, - (os_vm_size_t) (CONTROL_STACK_SIZE - - ((current_control_stack_pointer - - (lispobj *)CONTROL_STACK_START) * - sizeof(lispobj)))); + (os_vm_size_t) + ((all_threads->control_stack_end - + current_control_stack_pointer) * sizeof(lispobj))); #endif /* It helps to update the heap free pointers so that free_heap can * verify after it's done. */ - SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free); - SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free); + SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free,0); + SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free,0); -#if !defined(__i386__) +#if !defined(LISP_FEATURE_X86) dynamic_space_free_pointer = current_dynamic_space; + set_auto_gc_trigger(bytes_consed_between_gcs); #else -#if defined GENCGC +#if defined LISP_FEATURE_GENCGC gc_free_heap(); #else #error unsupported case /* in CMU CL, was "ibmrt using GC" */ @@ -1457,6 +1518,5 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" done]\n"); fflush(stdout); #endif - return 0; }