X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fruntime%2Fpurify.c;h=944a5e7713f6ca5ce34579c638a09290666e2ec2;hb=a7002797a1fb36ec3a7c30f6ebcb314b0e58e817;hp=5e86276657fc20b46cf65341f6860c0834683262;hpb=aaf74d586de62692c83c43f1359083d6e3eaf107;p=sbcl.git diff --git a/src/runtime/purify.c b/src/runtime/purify.c index 5e86276..944a5e7 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -37,27 +37,9 @@ #define PRINTNOISE -#if defined(LISP_FEATURE_GENCGC) -/* this is another artifact of the poor integration between gencgc and - * the rest of the runtime: on cheney gc there is a global - * dynamic_space_free_pointer which is valid whenever foreign function - * call is active, but in gencgc there's no such variable and we have - * to keep our own - */ -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__) - -#if 1 -#define gc_assert(ex) do { \ - if (!(ex)) gc_abort(); \ -} while (0) -#else -#define gc_assert(ex) -#endif +static lispobj *dynamic_space_purify_pointer; /* These hold the original end of the read_only and static spaces so @@ -112,12 +94,12 @@ dynamic_pointer_p(lispobj ptr) #ifndef LISP_FEATURE_GENCGC return (ptr >= (lispobj)current_dynamic_space && - ptr < (lispobj)dynamic_space_free_pointer); + ptr < (lispobj)dynamic_space_purify_pointer); #else /* Be more conservative, and remember, this is a maybe. */ return (ptr >= (lispobj)DYNAMIC_SPACE_START && - ptr < (lispobj)dynamic_space_free_pointer); + ptr < (lispobj)dynamic_space_purify_pointer); #endif } @@ -127,14 +109,14 @@ newspace_alloc(long nwords, int constantp) lispobj *ret; nwords=CEILING(nwords,2); if(constantp) { - if(read_only_free + nwords >= READ_ONLY_SPACE_END) { - lose("Ran out of read-only space while purifying!"); + if(read_only_free + nwords >= (lispobj *)READ_ONLY_SPACE_END) { + lose("Ran out of read-only space while purifying!\n"); } ret=read_only_free; read_only_free+=nwords; } else { - if(static_free + nwords >= STATIC_SPACE_END) { - lose("Ran out of static space while purifying!"); + if(static_free + nwords >= (lispobj *)STATIC_SPACE_END) { + lose("Ran out of static space while purifying!\n"); } ret=static_free; static_free+=nwords; @@ -386,6 +368,9 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) #endif case SAP_WIDETAG: case WEAK_POINTER_WIDETAG: +#ifdef LUTEX_WIDETAG + case LUTEX_WIDETAG: +#endif break; default: @@ -547,8 +532,9 @@ ptrans_boxed(lispobj thing, lispobj header, boolean constant) static lispobj ptrans_instance(lispobj thing, lispobj header, boolean /* ignored */ constant) { - lispobj layout = ((struct instance *)native_pointer(thing))->slots[0]; - lispobj pure = ((struct instance *)native_pointer(layout))->slots[15]; + struct layout *layout = + (struct layout *) native_pointer(((struct instance *)native_pointer(thing))->slots[0]); + lispobj pure = layout->pure; switch (pure) { case T: @@ -962,6 +948,11 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) #endif case SAP_WIDETAG: return ptrans_unboxed(thing, header); +#ifdef LUTEX_WIDETAG + case LUTEX_WIDETAG: + gencgc_unregister_lutex(native_pointer(thing)); + return ptrans_unboxed(thing, header); +#endif case RATIO_WIDETAG: case COMPLEX_WIDETAG: @@ -1373,7 +1364,6 @@ pscav(lispobj *addr, long nwords, boolean constant) #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) case CLOSURE_HEADER_WIDETAG: - case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: /* The function self pointer needs special care on the * x86 because it is the real entry point. */ { @@ -1462,8 +1452,14 @@ purify(lispobj static_roots, lispobj read_only_roots) } #if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) - dynamic_space_free_pointer = + dynamic_space_purify_pointer = (lispobj*)SymbolValue(ALLOCATION_POINTER,0); +#else +#if defined(LISP_FEATURE_GENCGC) + dynamic_space_purify_pointer = get_alloc_pointer(); +#else + dynamic_space_purify_pointer = dynamic_space_free_pointer; +#endif #endif read_only_end = read_only_free = @@ -1491,9 +1487,8 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" handlers"); fflush(stdout); #endif - pscav((lispobj *) all_threads->interrupt_data->interrupt_handlers, - sizeof(all_threads->interrupt_data->interrupt_handlers) - / sizeof(lispobj), + pscav((lispobj *) interrupt_handlers, + sizeof(interrupt_handlers) / sizeof(lispobj), 0); #ifdef PRINTNOISE @@ -1526,10 +1521,12 @@ purify(lispobj static_roots, lispobj read_only_roots) (lispobj *)SymbolValue(BINDING_STACK_POINTER,thread) - (lispobj *)thread->binding_stack_start, 0); +#ifdef LISP_FEATURE_SB_THREAD pscav( (lispobj *) (thread+1), fixnum_value(SymbolValue(FREE_TLS_INDEX,0)) - (sizeof (struct thread))/(sizeof (lispobj)), 0); +#endif } @@ -1591,7 +1588,7 @@ purify(lispobj static_roots, lispobj read_only_roots) #endif os_zero((os_vm_address_t) current_dynamic_space, - (os_vm_size_t) DYNAMIC_SPACE_SIZE); + (os_vm_size_t) dynamic_space_size); /* Zero the stack. Note that the stack is also zeroed by SUB-GC * calling SCRUB-CONTROL-STACK - this zeros the stack on the x86. */ @@ -1607,15 +1604,11 @@ purify(lispobj static_roots, lispobj read_only_roots) SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free,0); SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free,0); -#if !defined(ALLOCATION_POINTER) - dynamic_space_free_pointer = current_dynamic_space; - set_auto_gc_trigger(bytes_consed_between_gcs); -#else #if defined LISP_FEATURE_GENCGC gc_free_heap(); #else -#error unsupported case /* in CMU CL, was "ibmrt using GC" */ -#endif + dynamic_space_free_pointer = current_dynamic_space; + set_auto_gc_trigger(bytes_consed_between_gcs); #endif /* Blast away instruction cache */