X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fpurify.c;h=642dea9361b175b1646270b312a2f151a7de9f2e;hb=a0a413499415738d23cc40baa44e9c404af54a94;hp=dc66cd2aa4530df12823a9cb7873036aa3b224e7;hpb=0d669e68a1ffbea42af6216f2ae8c7d7ca12ffb6;p=sbcl.git diff --git a/src/runtime/purify.c b/src/runtime/purify.c index dc66cd2..642dea9 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -17,6 +17,11 @@ #include #include #include +#if (defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_LINUX)) +#include +#include +#endif +#include #include "runtime.h" #include "os.h" @@ -26,9 +31,11 @@ #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 @@ -38,6 +45,7 @@ */ 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__) @@ -76,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 @@ -86,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)); @@ -112,7 +120,7 @@ dynamic_pointer_p(lispobj ptr) #ifdef __i386__ -#ifdef GENCGC +#ifdef LISP_FEATURE_GENCGC /* * enhanced x86/GENCGC stack scavenging by Douglas Crosher * @@ -125,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) { @@ -363,6 +365,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; @@ -463,7 +470,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. */ @@ -507,7 +514,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. */ @@ -539,7 +546,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. */ @@ -557,19 +564,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; @@ -597,7 +604,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) @@ -635,7 +642,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 @@ -683,7 +690,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 @@ -705,11 +712,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; @@ -783,12 +790,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. */ @@ -816,7 +824,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. */ @@ -874,7 +882,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++; @@ -885,7 +893,7 @@ 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 @@ -1050,7 +1058,7 @@ pscav_code(struct code*code) gc_assert(!dynamic_pointer_p(func)); #ifdef __i386__ - /* Temporarly convert the self pointer to a real function + /* Temporarily convert the self pointer to a real function * pointer. */ ((struct simple_fun *)native_pointer(func))->self -= FUN_RAW_ADDR_OFFSET; @@ -1294,13 +1302,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. */ @@ -1311,22 +1323,39 @@ purify(lispobj static_roots, lispobj read_only_roots) #if defined(__i386__) 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); @@ -1336,8 +1365,9 @@ 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 @@ -1345,11 +1375,12 @@ purify(lispobj static_roots, lispobj read_only_roots) fflush(stdout); #endif #ifndef __i386__ - pscav((lispobj *)CONTROL_STACK_START, - current_control_stack_pointer - (lispobj *)CONTROL_STACK_START, + 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,14 +1390,23 @@ purify(lispobj static_roots, lispobj read_only_roots) fflush(stdout); #endif #if !defined(__i386__) - pscav( (lispobj *)BINDING_STACK_START, - (lispobj *)current_binding_stack_pointer - (lispobj *)BINDING_STACK_START, + 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 @@ -1431,21 +1471,21 @@ purify(lispobj static_roots, lispobj read_only_roots) * calling SCRUB-CONTROL-STACK - this zeros the stack on the x86. */ #ifndef __i386__ 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__) 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" */ @@ -1456,6 +1496,5 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" done]\n"); fflush(stdout); #endif - return 0; }