X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fpurify.c;h=e753c13337d1925be1a7b0f0ac37cc6204367a3d;hb=0f234877047c56ca945fe54e9e77a9cc2c8141cb;hp=eaa602efcc45445f9ab4bf185b9fa6090875d911;hpb=2805aa2c24f28ea664658d274789a1644fe16f9b;p=sbcl.git diff --git a/src/runtime/purify.c b/src/runtime/purify.c index eaa602e..e753c13 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 @@ -88,14 +70,6 @@ static long later_count = 0; #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG #endif -/* FIXME: Shouldn't this be defined in sbcl.h? See also notes in - * cheneygc.c */ - -#ifdef LISP_FEATURE_SPARC -#define FUN_RAW_ADDR_OFFSET 0 -#else -#define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG) -#endif static boolean forwarding_pointer_p(lispobj obj) @@ -112,12 +86,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 } @@ -128,13 +102,13 @@ newspace_alloc(long nwords, int constantp) nwords=CEILING(nwords,2); if(constantp) { if(read_only_free + nwords >= (lispobj *)READ_ONLY_SPACE_END) { - lose("Ran out of read-only space while purifying!"); + lose("Ran out of read-only space while purifying!\n"); } ret=read_only_free; read_only_free+=nwords; } else { if(static_free + nwords >= (lispobj *)STATIC_SPACE_END) { - lose("Ran out of static space while purifying!"); + lose("Ran out of static space while purifying!\n"); } ret=static_free; static_free+=nwords; @@ -386,6 +360,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 +524,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: @@ -679,7 +657,7 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) void *constants_start_addr, *constants_end_addr; void *code_start_addr, *code_end_addr; lispobj fixups = NIL; - unsigned displacement = (unsigned)new_code - (unsigned)old_code; + unsigned long displacement = (unsigned long)new_code - (unsigned long)old_code; struct vector *fixups_vector; ncode_words = fixnum_value(new_code->code_size); @@ -725,21 +703,21 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) for (i=0; idata[i]; /* Now check the current value of offset. */ - unsigned old_value = - *(unsigned *)((unsigned)code_start_addr + offset); + unsigned long old_value = + *(unsigned long *)((unsigned long)code_start_addr + offset); /* If it's within the old_code object then it must be an * absolute fixup (relative ones are not saved) */ - if ((old_value>=(unsigned)old_code) - && (old_value<((unsigned)old_code + nwords * N_WORD_BYTES))) + if ((old_value>=(unsigned long)old_code) + && (old_value<((unsigned long)old_code + nwords * N_WORD_BYTES))) /* So add the dispacement. */ - *(unsigned *)((unsigned)code_start_addr + offset) = old_value + *(unsigned long *)((unsigned long)code_start_addr + offset) = old_value + displacement; else /* It is outside the old code object so it must be a relative * fixup (absolute fixups are not saved). So subtract the * displacement. */ - *(unsigned *)((unsigned)code_start_addr + offset) = old_value + *(unsigned long *)((unsigned long)code_start_addr + offset) = old_value - displacement; } } @@ -824,7 +802,7 @@ ptrans_code(lispobj thing) ((struct simple_fun *)native_pointer(func))->self += FUN_RAW_ADDR_OFFSET; #endif - pscav_later(&((struct simple_fun *)native_pointer(func))->name, 3); + pscav_later(&((struct simple_fun *)native_pointer(func))->name, 4); } return result; @@ -962,6 +940,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: @@ -1151,7 +1134,7 @@ pscav_code(struct code*code) ((struct simple_fun *)native_pointer(func))->self += FUN_RAW_ADDR_OFFSET; #endif - pscav_later(&((struct simple_fun *)native_pointer(func))->name, 3); + pscav_later(&((struct simple_fun *)native_pointer(func))->name, 4); } return CEILING(nwords,2); @@ -1373,7 +1356,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 +1444,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 = @@ -1525,10 +1513,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 } @@ -1590,7 +1580,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. */ @@ -1606,15 +1596,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 */