X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fpurify.c;h=642dea9361b175b1646270b312a2f151a7de9f2e;hb=2d4a0df3457bcd50916b33d374da592d8776db0a;hp=45a0e6d5d9f4f83cbbdea0102e4b3a3f695c50a5;hpb=9f10bc102adce15a820027777a03e49a7b7623da;p=sbcl.git diff --git a/src/runtime/purify.c b/src/runtime/purify.c index 45a0e6d..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" @@ -28,6 +33,9 @@ #include "interr.h" #include "gc.h" #include "gc-internal.h" +#include "thread.h" +#include "genesis/primitive-objects.h" +#include "genesis/static-symbols.h" #define PRINTNOISE @@ -37,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__) @@ -124,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) { @@ -362,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; @@ -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 LISP_FEATURE_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,8 +1375,9 @@ 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 LISP_FEATURE_GENCGC @@ -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,19 +1471,19 @@ 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 LISP_FEATURE_GENCGC gc_free_heap(); @@ -1456,6 +1496,5 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" done]\n"); fflush(stdout); #endif - return 0; }