X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fpurify.c;h=1c92c0a080b46b73011bafefb9f7a69e681c567b;hb=eaa8a506790bb6ed627da617247bfd13802eb365;hp=2d87694ee0757edb16e271114616bf0fbccfce12;hpb=ded744f74ab2f1a97679ad4f91e0eb8d995daef2;p=sbcl.git diff --git a/src/runtime/purify.c b/src/runtime/purify.c index 2d87694..1c92c0a 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -27,6 +27,7 @@ #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 @@ -62,7 +66,7 @@ static lispobj *read_only_end, *static_end; static lispobj *read_only_free, *static_free; -static lispobj *pscav(lispobj *addr, int nwords, boolean constant); +static lispobj *pscav(lispobj *addr, long nwords, boolean constant); #define LATERBLOCKSIZE 1020 #define LATERMAXCOUNT 10 @@ -72,13 +76,16 @@ later { struct later *next; union { lispobj *ptr; - int count; + long count; } u[LATERBLOCKSIZE]; } *later_blocks = NULL; -static int later_count = 0; +static long later_count = 0; -#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) -#define NWORDS(x,y) (CEILING((x),(y)) / (y)) +#if N_WORD_BITS == 32 + #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG +#elif N_WORD_BITS == 64 + #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 */ @@ -113,7 +120,8 @@ dynamic_pointer_p(lispobj ptr) #endif } -static inline newspace_alloc(int nwords, int constantp) +static inline lispobj * +newspace_alloc(long nwords, int constantp) { lispobj *ret; nwords=CEILING(nwords,2); @@ -129,7 +137,7 @@ static inline newspace_alloc(int nwords, int constantp) -#ifdef LISP_FEATURE_X86 +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) #ifdef LISP_FEATURE_GENCGC /* @@ -171,84 +179,94 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) break; case CLOSURE_HEADER_WIDETAG: case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: - if ((int)pointer != ((int)start_addr+FUN_POINTER_LOWTAG)) { + if ((long)pointer != ((long)start_addr+FUN_POINTER_LOWTAG)) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wf2: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wf2: %x %x %x\n", + (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 0; } break; default: if (pointer_filter_verbose) { - fprintf(stderr,"*Wf3: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wf3: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 0; } break; case LIST_POINTER_LOWTAG: - if ((int)pointer != ((int)start_addr+LIST_POINTER_LOWTAG)) { + if ((long)pointer != ((long)start_addr+LIST_POINTER_LOWTAG)) { if (pointer_filter_verbose) - fprintf(stderr,"*Wl1: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wl1: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); return 0; } /* 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) + || ((start_addr[0] & FIXNUM_TAG_MASK) == 0) /* fixnum */ + || (widetag_of(start_addr[0]) == CHARACTER_WIDETAG) +#if N_WORD_BITS == 64 + || (widetag_of(start_addr[0]) == SINGLE_FLOAT_WIDETAG) +#endif || (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) + || ((start_addr[1] & FIXNUM_TAG_MASK) == 0) /* fixnum */ + || (widetag_of(start_addr[1]) == CHARACTER_WIDETAG) +#if N_WORD_BITS == 64 + || (widetag_of(start_addr[1]) == SINGLE_FLOAT_WIDETAG) +#endif || (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG))) { break; } else { if (pointer_filter_verbose) { - fprintf(stderr,"*Wl2: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wl2: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 0; } case INSTANCE_POINTER_LOWTAG: - if ((int)pointer != ((int)start_addr+INSTANCE_POINTER_LOWTAG)) { + if ((long)pointer != ((long)start_addr+INSTANCE_POINTER_LOWTAG)) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wi1: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wi1: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 0; } if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wi2: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wi2: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 0; } break; case OTHER_POINTER_LOWTAG: - if ((int)pointer != ((int)start_addr+OTHER_POINTER_LOWTAG)) { + if ((long)pointer != ((long)start_addr+OTHER_POINTER_LOWTAG)) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wo1: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wo1: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 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 (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & FIXNUM_TAG_MASK) == 0)) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 0; } switch (widetag_of(start_addr[0])) { case UNBOUND_MARKER_WIDETAG: - case BASE_CHAR_WIDETAG: + case CHARACTER_WIDETAG: +#if N_WORD_BITS == 64 + case SINGLE_FLOAT_WIDETAG: +#endif if (pointer_filter_verbose) { - fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 0; @@ -256,15 +274,15 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) case CLOSURE_HEADER_WIDETAG: case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: if (pointer_filter_verbose) { - fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 0; case INSTANCE_HEADER_WIDETAG: if (pointer_filter_verbose) { - fprintf(stderr,"*Wo5: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wo5: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 0; @@ -283,6 +301,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: @@ -292,13 +313,18 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) case FDEFN_WIDETAG: case CODE_HEADER_WIDETAG: case BIGNUM_WIDETAG: +#if N_WORD_BITS != 64 case SINGLE_FLOAT_WIDETAG: +#endif case DOUBLE_FLOAT_WIDETAG: #ifdef LONG_FLOAT_WIDETAG case LONG_FLOAT_WIDETAG: #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: @@ -306,9 +332,20 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG: +#endif case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG + case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG + case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG + case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG: +#endif #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: #endif @@ -321,6 +358,12 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG: #endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG: +#endif case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG: case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG: #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG @@ -341,16 +384,16 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) default: if (pointer_filter_verbose) { - fprintf(stderr,"*Wo6: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*Wo6: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 0; } break; default: if (pointer_filter_verbose) { - fprintf(stderr,"*W?: %x %x %x\n", (unsigned int) pointer, - (unsigned int) start_addr, *start_addr); + fprintf(stderr,"*W?: %x %x %x\n", (unsigned long) pointer, + (unsigned long) start_addr, *start_addr); } return 0; } @@ -361,12 +404,12 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) #define MAX_STACK_POINTERS 256 lispobj *valid_stack_locations[MAX_STACK_POINTERS]; -unsigned int num_valid_stack_locations; +unsigned long num_valid_stack_locations; #define MAX_STACK_RETURN_ADDRESSES 128 lispobj *valid_stack_ra_locations[MAX_STACK_RETURN_ADDRESSES]; lispobj *valid_stack_ra_code_objects[MAX_STACK_RETURN_ADDRESSES]; -unsigned int num_valid_stack_ra_locations; +unsigned long num_valid_stack_ra_locations; /* Identify valid stack slots. */ static void @@ -393,7 +436,7 @@ setup_i386_stack_scav(lispobj *lowaddr, lispobj *base) MAX_STACK_RETURN_ADDRESSES); valid_stack_ra_locations[num_valid_stack_ra_locations] = sp; valid_stack_ra_code_objects[num_valid_stack_ra_locations++] = - (lispobj *)((int)start_addr + OTHER_POINTER_LOWTAG); + (lispobj *)((long)start_addr + OTHER_POINTER_LOWTAG); } else { if (valid_dynamic_space_pointer((void *)thing, start_addr)) { gc_assert(num_valid_stack_locations < MAX_STACK_POINTERS); @@ -413,7 +456,7 @@ setup_i386_stack_scav(lispobj *lowaddr, lispobj *base) static void pscav_i386_stack(void) { - int i; + long i; for (i = 0; i < num_valid_stack_locations; i++) pscav(valid_stack_locations[i], 1, 0); @@ -424,13 +467,13 @@ pscav_i386_stack(void) if (pointer_filter_verbose) { fprintf(stderr,"*C moved RA %x to %x; for code object %x to %x\n", *valid_stack_ra_locations[i], - (int)(*valid_stack_ra_locations[i]) - - ((int)valid_stack_ra_code_objects[i] - (int)code_obj), - (unsigned int) valid_stack_ra_code_objects[i], code_obj); + (long)(*valid_stack_ra_locations[i]) + - ((long)valid_stack_ra_code_objects[i] - (long)code_obj), + (unsigned long) valid_stack_ra_code_objects[i], code_obj); } *valid_stack_ra_locations[i] = - ((int)(*valid_stack_ra_locations[i]) - - ((int)valid_stack_ra_code_objects[i] - (int)code_obj)); + ((long)(*valid_stack_ra_locations[i]) + - ((long)valid_stack_ra_code_objects[i] - (long)code_obj)); } } #endif @@ -438,7 +481,7 @@ pscav_i386_stack(void) static void -pscav_later(lispobj *where, int count) +pscav_later(lispobj *where, long count) { struct later *new; @@ -469,10 +512,10 @@ pscav_later(lispobj *where, int count) static lispobj ptrans_boxed(lispobj thing, lispobj header, boolean constant) { - int nwords; + long nwords; lispobj result, *new, *old; - nwords = 1 + HeaderValue(header); + nwords = CEILING(1 + HeaderValue(header), 2); /* Allocate it */ old = (lispobj *)native_pointer(thing); @@ -512,10 +555,10 @@ ptrans_instance(lispobj thing, lispobj header, boolean /* ignored */ constant) * space placed into it (e.g. the cache-name slot), but * the lists and arrays at the time of a purify can be * moved to the RO space. */ - int nwords; + long nwords; lispobj result, *new, *old; - nwords = 1 + HeaderValue(header); + nwords = CEILING(1 + HeaderValue(header), 2); /* Allocate it */ old = (lispobj *)native_pointer(thing); @@ -542,11 +585,11 @@ ptrans_instance(lispobj thing, lispobj header, boolean /* ignored */ constant) static lispobj ptrans_fdefn(lispobj thing, lispobj header) { - int nwords; + long nwords; lispobj result, *new, *old, oldfn; struct fdefn *fdefn; - nwords = 1 + HeaderValue(header); + nwords = CEILING(1 + HeaderValue(header), 2); /* Allocate it */ old = (lispobj *)native_pointer(thing); @@ -572,10 +615,10 @@ ptrans_fdefn(lispobj thing, lispobj header) static lispobj ptrans_unboxed(lispobj thing, lispobj header) { - int nwords; + long nwords; lispobj result, *new, *old; - nwords = 1 + HeaderValue(header); + nwords = CEILING(1 + HeaderValue(header), 2); /* Allocate it */ old = (lispobj *)native_pointer(thing); @@ -592,15 +635,22 @@ ptrans_unboxed(lispobj thing, lispobj header) } static lispobj -ptrans_vector(lispobj thing, int bits, int extra, +ptrans_vector(lispobj thing, long bits, long extra, boolean boxed, boolean constant) { struct vector *vector; - int nwords; + long nwords; lispobj result, *new; + long length; vector = (struct vector *)native_pointer(thing); - nwords = 2 + (CEILING((fixnum_value(vector->length)+extra)*bits,32)>>5); + length = fixnum_value(vector->length)+extra; + // Argh, handle simple-vector-nil separately. + if (bits == 0) { + nwords = 2; + } else { + nwords = CEILING(NWORDS(length, bits) + 2, 2); + } new=newspace_alloc(nwords, (constant || !boxed)); bcopy(vector, new, nwords * sizeof(lispobj)); @@ -614,11 +664,11 @@ ptrans_vector(lispobj thing, int bits, int extra, return result; } -#ifdef LISP_FEATURE_X86 +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) static void apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) { - int nheader_words, ncode_words, nwords; + long nheader_words, ncode_words, nwords; void *constants_start_addr, *constants_end_addr; void *code_start_addr, *code_end_addr; lispobj fixups = NIL; @@ -629,10 +679,10 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) 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; + constants_start_addr = (void *)new_code + 5 * N_WORD_BYTES; + constants_end_addr = (void *)new_code + nheader_words*N_WORD_BYTES; + code_start_addr = (void *)new_code + nheader_words*N_WORD_BYTES; + code_end_addr = (void *)new_code + nwords*N_WORD_BYTES; /* The first constant should be a pointer to the fixups for this * code objects. Check. */ @@ -660,12 +710,11 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) (struct vector *)native_pointer(*(lispobj *)fixups_vector); } - if (widetag_of(fixups_vector->header) == - SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) { + if (widetag_of(fixups_vector->header) == SIMPLE_ARRAY_WORD_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; + long length = fixnum_value(fixups_vector->length); + long i; for (i=0; idata[i]; /* Now check the current value of offset. */ @@ -675,7 +724,7 @@ apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) /* 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))) + && (old_value<((unsigned)old_code + nwords * N_WORD_BYTES))) /* So add the dispacement. */ *(unsigned *)((unsigned)code_start_addr + offset) = old_value + displacement; @@ -702,17 +751,18 @@ static lispobj ptrans_code(lispobj thing) { struct code *code, *new; - int nwords; + long nwords; lispobj func, result; code = (struct code *)native_pointer(thing); - nwords = HeaderValue(code->header) + fixnum_value(code->code_size); + nwords = CEILING(HeaderValue(code->header) + fixnum_value(code->code_size), + 2); new = (struct code *)newspace_alloc(nwords,1); /* constant */ bcopy(code, new, nwords * sizeof(lispobj)); -#ifdef LISP_FEATURE_X86 +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) apply_code_fixups_during_purify(code,new); #endif @@ -757,13 +807,13 @@ ptrans_code(lispobj thing) gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG); gc_assert(!dynamic_pointer_p(func)); -#ifdef LISP_FEATURE_X86 +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) /* Temporarily convert the self pointer to a real function pointer. */ ((struct simple_fun *)native_pointer(func))->self -= FUN_RAW_ADDR_OFFSET; #endif pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1); -#ifdef LISP_FEATURE_X86 +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) ((struct simple_fun *)native_pointer(func))->self += FUN_RAW_ADDR_OFFSET; #endif @@ -776,7 +826,7 @@ ptrans_code(lispobj thing) static lispobj ptrans_func(lispobj thing, lispobj header) { - int nwords; + long nwords; lispobj code, *new, *old, result; struct simple_fun *function; @@ -808,7 +858,7 @@ ptrans_func(lispobj thing, lispobj header) } else { /* It's some kind of closure-like thing. */ - nwords = 1 + HeaderValue(header); + nwords = CEILING(1 + HeaderValue(header), 2); old = (lispobj *)native_pointer(thing); /* Allocate the new one. FINs *must* not go in read_only @@ -854,9 +904,9 @@ static lispobj ptrans_list(lispobj thing, boolean constant) { struct cons *old, *new, *orig; - int length; + long length; - orig = newspace_alloc(0,constant); + orig = (struct cons *) newspace_alloc(0,constant); length = 0; do { @@ -910,6 +960,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: @@ -929,11 +982,16 @@ 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); case SIMPLE_VECTOR_WIDETAG: - return ptrans_vector(thing, 32, 0, 1, constant); + return ptrans_vector(thing, N_WORD_BITS, 0, 1, constant); case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: return ptrans_vector(thing, 2, 0, 0, constant); @@ -966,6 +1024,25 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) #endif return ptrans_vector(thing, 32, 0, 0, constant); +#if N_WORD_BITS == 64 +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG + case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG + case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG + case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG: +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG + case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG: +#endif + return ptrans_vector(thing, 64, 0, 0, constant); +#endif + case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG: return ptrans_vector(thing, 32, 0, 0, constant); @@ -1012,13 +1089,14 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) return ptrans_fdefn(thing, header); default: + fprintf(stderr, "Invalid widetag: %d\n", widetag_of(header)); /* Should only come across other pointers to the above stuff. */ gc_abort(); return NIL; } } -static int +static long pscav_fdefn(struct fdefn *fdefn) { boolean fix_func; @@ -1031,14 +1109,15 @@ pscav_fdefn(struct fdefn *fdefn) return sizeof(struct fdefn) / sizeof(lispobj); } -#ifdef LISP_FEATURE_X86 +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) /* now putting code objects in static space */ -static int +static long pscav_code(struct code*code) { - int nwords; + long nwords; lispobj func; - nwords = HeaderValue(code->header) + fixnum_value(code->code_size); + nwords = CEILING(HeaderValue(code->header) + fixnum_value(code->code_size), + 2); /* Arrange to scavenge the debug info later. */ pscav_later(&code->debug_info, 1); @@ -1054,14 +1133,14 @@ pscav_code(struct code*code) gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG); gc_assert(!dynamic_pointer_p(func)); -#ifdef LISP_FEATURE_X86 +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) /* Temporarily convert the self pointer to a real function * pointer. */ ((struct simple_fun *)native_pointer(func))->self -= FUN_RAW_ADDR_OFFSET; #endif pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1); -#ifdef LISP_FEATURE_X86 +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) ((struct simple_fun *)native_pointer(func))->self += FUN_RAW_ADDR_OFFSET; #endif @@ -1073,10 +1152,10 @@ pscav_code(struct code*code) #endif static lispobj * -pscav(lispobj *addr, int nwords, boolean constant) +pscav(lispobj *addr, long nwords, boolean constant) { lispobj thing, *thingp, header; - int count = 0; /* (0 = dummy init value to stop GCC warning) */ + long count = 0; /* (0 = dummy init value to stop GCC warning) */ struct vector *vector; while (nwords > 0) { @@ -1118,7 +1197,12 @@ pscav(lispobj *addr, int nwords, boolean constant) } count = 1; } - else if (thing & 3) { /* FIXME: 3? not 2? */ +#if N_WORD_BITS == 64 + else if (widetag_of(thing) == SINGLE_FLOAT_WIDETAG) { + count = 1; + } +#endif + else if (thing & FIXNUM_TAG_MASK) { /* It's an other immediate. Maybe the header for an unboxed */ /* object. */ switch (widetag_of(thing)) { @@ -1130,7 +1214,7 @@ pscav(lispobj *addr, int nwords, boolean constant) #endif case SAP_WIDETAG: /* It's an unboxed simple object. */ - count = HeaderValue(thing)+1; + count = CEILING(HeaderValue(thing)+1, 2); break; case SIMPLE_VECTOR_WIDETAG: @@ -1138,7 +1222,7 @@ pscav(lispobj *addr, int nwords, boolean constant) *addr = (subtype_VectorMustRehash << N_WIDETAG_BITS) | SIMPLE_VECTOR_WIDETAG; } - count = 1; + count = 2; break; case SIMPLE_ARRAY_NIL_WIDETAG: @@ -1147,22 +1231,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: @@ -1171,7 +1262,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: @@ -1180,7 +1271,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: @@ -1193,12 +1284,28 @@ 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; - count = CEILING(fixnum_value(vector->length)+2,2); + count = CEILING(NWORDS(fixnum_value(vector->length), 32) + 2, + 2); break; case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG: @@ -1206,7 +1313,8 @@ pscav(lispobj *addr, int nwords, boolean constant) case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG: #endif vector = (struct vector *)addr; - count = fixnum_value(vector->length)*2+2; + count = CEILING(NWORDS(fixnum_value(vector->length), 64) + 2, + 2); break; #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG @@ -1224,7 +1332,8 @@ pscav(lispobj *addr, int nwords, boolean constant) #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG: vector = (struct vector *)addr; - count = fixnum_value(vector->length)*4+2; + count = CEILING(NWORDS(fixnum_value(vector->length), 128) + 2, + 2); break; #endif @@ -1241,7 +1350,7 @@ pscav(lispobj *addr, int nwords, boolean constant) #endif case CODE_HEADER_WIDETAG: -#ifndef LISP_FEATURE_X86 +#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) gc_abort(); /* no code headers in static space */ #else count = pscav_code((struct code*)addr); @@ -1255,7 +1364,7 @@ pscav(lispobj *addr, int nwords, boolean constant) gc_abort(); break; -#ifdef LISP_FEATURE_X86 +#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 @@ -1304,7 +1413,7 @@ int purify(lispobj static_roots, lispobj read_only_roots) { lispobj *clean; - int count, i; + long count, i; struct later *laters, *next; struct thread *thread; @@ -1333,7 +1442,7 @@ purify(lispobj static_roots, lispobj read_only_roots) return 0; } -#if defined(LISP_FEATURE_X86) +#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) dynamic_space_free_pointer = (lispobj*)SymbolValue(ALLOCATION_POINTER,0); #endif @@ -1348,7 +1457,7 @@ purify(lispobj static_roots, lispobj read_only_roots) fflush(stdout); #endif -#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86)) +#if defined(LISP_FEATURE_GENCGC) && (defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)) /* 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 */ @@ -1372,7 +1481,7 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" stack"); fflush(stdout); #endif -#ifndef LISP_FEATURE_X86 +#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) pscav((lispobj *)all_threads->control_stack_start, current_control_stack_pointer - all_threads->control_stack_start, @@ -1387,7 +1496,7 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" bindings"); fflush(stdout); #endif -#if !defined(LISP_FEATURE_X86) +#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)) pscav( (lispobj *)all_threads->binding_stack_start, (lispobj *)current_binding_stack_pointer - all_threads->binding_stack_start, @@ -1467,7 +1576,7 @@ purify(lispobj static_roots, lispobj read_only_roots) /* Zero the stack. Note that the stack is also zeroed by SUB-GC * calling SCRUB-CONTROL-STACK - this zeros the stack on the x86. */ -#ifndef LISP_FEATURE_X86 +#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) os_zero((os_vm_address_t) current_control_stack_pointer, (os_vm_size_t) ((all_threads->control_stack_end - @@ -1479,7 +1588,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 @@ -1490,6 +1599,10 @@ purify(lispobj static_roots, lispobj read_only_roots) #endif #endif + /* Blast away instruction cache */ + os_flush_icache((os_vm_address_t)READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE); + os_flush_icache((os_vm_address_t)STATIC_SPACE_START, STATIC_SPACE_SIZE); + #ifdef PRINTNOISE printf(" done]\n"); fflush(stdout);