X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fpurify.c;h=dc66cd2aa4530df12823a9cb7873036aa3b224e7;hb=48f92d19cf12f3aff81a29a786970264a523bc7a;hp=858169210e5024b28e835d8614fd45d5acb2317a;hpb=3c65762b927af861c9c8bc416e4cbac9a14ec0c3;p=sbcl.git diff --git a/src/runtime/purify.c b/src/runtime/purify.c index 8581692..dc66cd2 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -16,6 +16,7 @@ #include #include #include +#include #include "runtime.h" #include "os.h" @@ -97,11 +98,9 @@ static boolean dynamic_pointer_p(lispobj ptr) { #ifndef __i386__ - /* KLUDGE: This has an implicit dependence on the ordering of - * address spaces, and is therefore basically wrong. I'd fix it, - * but I don't have a non-386 port to test it on. Porters are - * encouraged to fix it. -- WHN 2000-10-17 */ - return (ptr >= (lispobj)DYNAMIC_SPACE_START); + return (ptr >= (lispobj)current_dynamic_space + && + ptr < (lispobj)dynamic_space_free_pointer); #else /* Be more conservative, and remember, this is a maybe. */ return (ptr >= (lispobj)DYNAMIC_SPACE_START @@ -181,7 +180,7 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) return 0; } /* Is it plausible cons? */ - if((is_lisp_pointer(start_addr[0]) + if ((is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0) /* fixnum */ || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG) || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG)) @@ -221,8 +220,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) } return 0; } - /* Is it plausible? Not a cons. X should check the headers. */ - if(is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) { + /* Is it plausible? Not a cons. XXX should check the headers. */ + if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) { if (pointer_filter_verbose) { fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned int) pointer, (unsigned int) start_addr, *start_addr); @@ -611,80 +610,82 @@ ptrans_vector(lispobj thing, int bits, int extra, static void apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) { - int nheader_words, ncode_words, nwords; - 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; - struct vector *fixups_vector; - - ncode_words = fixnum_value(new_code->code_size); - nheader_words = HeaderValue(*(lispobj *)new_code); - nwords = ncode_words + nheader_words; - - constants_start_addr = (void *)new_code + 5*4; - constants_end_addr = (void *)new_code + nheader_words*4; - code_start_addr = (void *)new_code + nheader_words*4; - code_end_addr = (void *)new_code + nwords*4; - - /* The first constant should be a pointer to the fixups for this - * code objects. Check. */ - fixups = new_code->constants[0]; - - /* It will be 0 or the unbound-marker if there are no fixups, and - * will be an other-pointer to a vector if it is valid. */ - if ((fixups==0) || - (fixups==UNBOUND_MARKER_WIDETAG) || - !is_lisp_pointer(fixups)) { + int nheader_words, ncode_words, nwords; + 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; + struct vector *fixups_vector; + + ncode_words = fixnum_value(new_code->code_size); + nheader_words = HeaderValue(*(lispobj *)new_code); + nwords = ncode_words + nheader_words; + + constants_start_addr = (void *)new_code + 5*4; + constants_end_addr = (void *)new_code + nheader_words*4; + code_start_addr = (void *)new_code + nheader_words*4; + code_end_addr = (void *)new_code + nwords*4; + + /* The first constant should be a pointer to the fixups for this + * code objects. Check. */ + fixups = new_code->constants[0]; + + /* It will be 0 or the unbound-marker if there are no fixups, and + * will be an other-pointer to a vector if it is valid. */ + if ((fixups==0) || + (fixups==UNBOUND_MARKER_WIDETAG) || + !is_lisp_pointer(fixups)) { #ifdef GENCGC - /* Check for a possible errors. */ - sniff_code_object(new_code,displacement); + /* Check for a possible errors. */ + sniff_code_object(new_code,displacement); #endif - return; - } + return; + } - fixups_vector = (struct vector *)native_pointer(fixups); + fixups_vector = (struct vector *)native_pointer(fixups); - /* Could be pointing to a forwarding pointer. */ - if (is_lisp_pointer(fixups) && (dynamic_pointer_p(fixups)) - && forwarding_pointer_p(*(lispobj *)fixups_vector)) { - /* If so then follow it. */ - fixups_vector = (struct vector *)native_pointer(*(lispobj *)fixups_vector); - } + /* Could be pointing to a forwarding pointer. */ + if (is_lisp_pointer(fixups) && (dynamic_pointer_p(fixups)) + && forwarding_pointer_p(*(lispobj *)fixups_vector)) { + /* If so then follow it. */ + fixups_vector = + (struct vector *)native_pointer(*(lispobj *)fixups_vector); + } - if (widetag_of(fixups_vector->header) == - SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) { - /* We got the fixups for the code block. Now work through the vector, - * and apply a fixup at each address. */ - int length = fixnum_value(fixups_vector->length); - int i; - for (i=0; idata[i]; - /* Now check the current value of offset. */ - unsigned old_value = *(unsigned *)((unsigned)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*4))) - /* So add the dispacement. */ - *(unsigned *)((unsigned)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 - - displacement; + if (widetag_of(fixups_vector->header) == + SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) { + /* We got the fixups for the code block. Now work through the + * vector, and apply a fixup at each address. */ + int length = fixnum_value(fixups_vector->length); + int i; + for (i=0; idata[i]; + /* Now check the current value of offset. */ + unsigned old_value = + *(unsigned *)((unsigned)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*4))) + /* So add the dispacement. */ + *(unsigned *)((unsigned)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 + - displacement; + } } - } - /* No longer need the fixups. */ - new_code->constants[0] = 0; + /* No longer need the fixups. */ + new_code->constants[0] = 0; #ifdef GENCGC - /* Check for possible errors. */ - sniff_code_object(new_code,displacement); + /* Check for possible errors. */ + sniff_code_object(new_code,displacement); #endif } #endif @@ -726,7 +727,7 @@ ptrans_code(lispobj thing) /* Arrange to scavenge the debug info later. */ pscav_later(&new->debug_info, 1); - if(new->trace_table_offset & 0x3) + if (new->trace_table_offset & 0x3) #if 0 pscav(&new->trace_table_offset, 1, 0); #else