X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fpurify.c;h=91b4232244375de74aa5f29c6d44f2660fdada37;hb=64db34d6fce16b93652fe8185ec6eeffac908fc8;hp=fc8bbd56fa0c09bd4140326ee25fdad5ef489d4c;hpb=b27fb452f72190637b03a6ef2e1333091da42a98;p=sbcl.git diff --git a/src/runtime/purify.c b/src/runtime/purify.c index fc8bbd5..91b4232 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -37,17 +37,7 @@ #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; +static lispobj *dynamic_space_purify_pointer; /* These hold the original end of the read_only and static spaces so @@ -78,14 +68,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) @@ -102,12 +84,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 } @@ -376,6 +358,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: @@ -537,8 +522,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: @@ -669,7 +655,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); @@ -715,21 +701,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; } } @@ -814,7 +800,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; @@ -952,6 +938,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: @@ -1141,7 +1132,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); @@ -1363,7 +1354,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. */ { @@ -1452,8 +1442,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 = @@ -1515,10 +1511,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 } @@ -1580,7 +1578,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. */ @@ -1596,15 +1594,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 */