X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fpurify.c;h=3750895a703819e28f253716ed946caa59f931cc;hb=11b388bac03fea3220e058eb93466bef7b66af75;hp=cb7ed3f77d3ea5ed132303b31ca88ceeb256520f;hpb=582503547d172f95aaf118311f09fe6828a6ea72;p=sbcl.git diff --git a/src/runtime/purify.c b/src/runtime/purify.c index cb7ed3f..3750895 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -19,14 +19,15 @@ #include #include +#include "sbcl.h" #include "runtime.h" #include "os.h" -#include "sbcl.h" #include "globals.h" #include "validate.h" #include "interrupt.h" #include "purify.h" #include "interr.h" +#include "fixnump.h" #include "gc.h" #include "gc-internal.h" #include "thread.h" @@ -35,9 +36,12 @@ #define PRINTNOISE -#if defined(LISP_FEATURE_X86) -/* again, what's so special about the x86 that this is differently - * visible there than on other platforms? -dan 20010125 +#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 @@ -77,9 +81,6 @@ later { } *later_blocks = NULL; static int later_count = 0; -#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) -#define NWORDS(x,y) (CEILING((x),(y)) / (y)) - /* FIXME: Shouldn't this be defined in sbcl.h? See also notes in * cheneygc.c */ @@ -113,7 +114,8 @@ dynamic_pointer_p(lispobj ptr) #endif } -static inline newspace_alloc(int nwords, int constantp) +static inline lispobj * +newspace_alloc(int nwords, int constantp) { lispobj *ret; nwords=CEILING(nwords,2); @@ -197,11 +199,11 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) /* Is it plausible cons? */ 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]) == CHARACTER_WIDETAG) || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG)) && (is_lisp_pointer(start_addr[1]) || ((start_addr[1] & 3) == 0) /* fixnum */ - || (widetag_of(start_addr[1]) == BASE_CHAR_WIDETAG) + || (widetag_of(start_addr[1]) == CHARACTER_WIDETAG) || (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG))) { break; } else { @@ -245,7 +247,7 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) } switch (widetag_of(start_addr[0])) { case UNBOUND_MARKER_WIDETAG: - case BASE_CHAR_WIDETAG: + case CHARACTER_WIDETAG: if (pointer_filter_verbose) { fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned int) pointer, (unsigned int) start_addr, *start_addr); @@ -283,6 +285,9 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) #endif case SIMPLE_ARRAY_WIDETAG: case COMPLEX_BASE_STRING_WIDETAG: +#ifdef COMPLEX_CHARACTER_STRING_WIDETAG + case COMPLEX_CHARACTER_STRING_WIDETAG: +#endif case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_BIT_VECTOR_WIDETAG: case COMPLEX_VECTOR_WIDETAG: @@ -299,6 +304,9 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) #endif case SIMPLE_ARRAY_NIL_WIDETAG: case SIMPLE_BASE_STRING_WIDETAG: +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + case SIMPLE_CHARACTER_STRING_WIDETAG: +#endif case SIMPLE_BIT_VECTOR_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: @@ -735,7 +743,11 @@ ptrans_code(lispobj thing) pscav_later(&new->debug_info, 1); /* FIXME: why would this be a fixnum? */ - if (!(new->trace_table_offset & (EVEN_FIXNUM_LOWTAG|ODD_FIXNUM_LOWTAG))) + /* "why" is a hard word, but apparently for compiled functions the + trace_table_offset contains the length of the instructions, as + a fixnum. See CODE-INST-AREA-LENGTH in + src/compiler/target-disassem.lisp. -- CSR, 2004-01-08 */ + if (!(fixnump(new->trace_table_offset))) #if 0 pscav(&new->trace_table_offset, 1, 0); #else @@ -852,7 +864,7 @@ ptrans_list(lispobj thing, boolean constant) struct cons *old, *new, *orig; int length; - orig = newspace_alloc(0,constant); + orig = (struct cons *) newspace_alloc(0,constant); length = 0; do { @@ -906,6 +918,9 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case COMPLEX_WIDETAG: case SIMPLE_ARRAY_WIDETAG: case COMPLEX_BASE_STRING_WIDETAG: +#ifdef COMPLEX_CHARACTER_STRING_WIDETAG + case COMPLEX_CHARACTER_STRING_WIDETAG: +#endif case COMPLEX_BIT_VECTOR_WIDETAG: case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_VECTOR_WIDETAG: @@ -925,6 +940,11 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case SIMPLE_BASE_STRING_WIDETAG: return ptrans_vector(thing, 8, 1, 0, constant); +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + case SIMPLE_CHARACTER_STRING_WIDETAG: + return ptrans_vector(thing, 32, 1, 0, constant); +#endif + case SIMPLE_BIT_VECTOR_WIDETAG: return ptrans_vector(thing, 1, 0, 0, constant); @@ -1143,22 +1163,29 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_BASE_STRING_WIDETAG: vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length)+1,4)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length)+1,8)+2,2); break; +#ifdef SIMPLE_CHARACTER_STRING_WIDETAG + case SIMPLE_CHARACTER_STRING_WIDETAG: + vector = (struct vector *)addr; + count = CEILING(NWORDS(fixnum_value(vector->length)+1,32)+2,2); + break; +#endif + case SIMPLE_BIT_VECTOR_WIDETAG: vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),1)+2,2); break; case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length),16)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2); break; case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length),8)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2); break; case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: @@ -1167,7 +1194,7 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG: #endif vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),8)+2,2); break; case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: @@ -1176,7 +1203,7 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG: #endif vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),16)+2,2); break; case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: @@ -1189,8 +1216,23 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG: #endif vector = (struct vector *)addr; - count = CEILING(fixnum_value(vector->length)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2); + break; + +#if N_WORD_BITS == 64 + case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG: +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG: +#endif + vector = (struct vector *)addr; + count = CEILING(NWORDS(fixnum_value(vector->length),64)+2,2); break; +#endif case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG: vector = (struct vector *)addr; @@ -1344,12 +1386,14 @@ purify(lispobj static_roots, lispobj read_only_roots) fflush(stdout); #endif +#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86)) /* note this expects only one thread to be active. We'd have to * stop all the others in the same way as GC does if we wanted * PURIFY to work when >1 thread exists */ setup_i386_stack_scav(((&static_roots)-2), ((void *)all_threads->control_stack_end)); - +#endif + pscav(&static_roots, 1, 0); pscav(&read_only_roots, 1, 1); @@ -1473,7 +1517,7 @@ 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(LISP_FEATURE_X86) +#if !defined(ALLOCATION_POINTER) dynamic_space_free_pointer = current_dynamic_space; set_auto_gc_trigger(bytes_consed_between_gcs); #else