X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fpurify.c;h=c4309e24405fc798c45526242209ccc738ba06b2;hb=22c1de0a40df83bb5628974010a879cb2c17ff53;hp=e061156d7fa74355496e5bc9cdd49d7fd3109eca;hpb=e365f2f7a9c66d307b48fee70778f4eaa84bdcc0;p=sbcl.git diff --git a/src/runtime/purify.c b/src/runtime/purify.c index e061156..c4309e2 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -17,8 +17,10 @@ #include #include #include +#if (defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_LINUX)) #include #include +#endif #include #include "runtime.h" @@ -43,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__) @@ -130,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) { @@ -272,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: @@ -286,7 +284,8 @@ 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: @@ -903,6 +902,7 @@ 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: @@ -919,12 +919,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); @@ -936,7 +938,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: @@ -1061,7 +1066,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; @@ -1147,7 +1152,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; @@ -1339,11 +1348,12 @@ purify(lispobj static_roots, lispobj read_only_roots) fflush(stdout); #endif +#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86)) #if 0 - /* can't do this unless the threads in question are suspended with - * ptrace + /* 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 */ -#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86)) for_each_thread(thread) { void **ptr; struct user_regs_struct regs; @@ -1352,16 +1362,13 @@ purify(lispobj static_roots, lispobj read_only_roots) lose("PTRACE_GETREGS"); } setup_i386_stack_scav(regs.ebp, - ((void *)thread->control_stack_start) - +THREAD_CONTROL_STACK_SIZE); + ((void *)thread->control_stack_end)); } -#endif -#endif +#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_start) - +THREAD_CONTROL_STACK_SIZE); - - + ((void *)all_threads->control_stack_end)); +#endif pscav(&static_roots, 1, 0); pscav(&read_only_roots, 1, 1); @@ -1380,8 +1387,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 @@ -1394,8 +1402,9 @@ 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 for_each_thread(thread) { @@ -1474,10 +1483,9 @@ 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 @@ -1487,6 +1495,7 @@ purify(lispobj static_roots, lispobj read_only_roots) #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(); @@ -1499,6 +1508,5 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" done]\n"); fflush(stdout); #endif - return 0; }