X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fpurify.c;h=ac0bfd8af2526bffbfdd64946bb41c445558445c;hb=63817d29028c8551cda23f432a3328acd7fdd62f;hp=772b905b58385f47160f6fcd97cab5337c7ef7eb;hpb=34dcb46f78a01d543756703d7ccdf3d999a134d0;p=sbcl.git diff --git a/src/runtime/purify.c b/src/runtime/purify.c index 772b905..ac0bfd8 100644 --- a/src/runtime/purify.c +++ b/src/runtime/purify.c @@ -17,20 +17,17 @@ #include #include #include -#if (defined(LISP_FEATURE_SB_THREAD) && defined(LISP_FEATURE_LINUX)) -#include -#include -#endif #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" @@ -39,12 +36,16 @@ #define PRINTNOISE -#if defined(__i386__) -/* 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 +extern unsigned long bytes_consed_between_gcs; #define gc_abort() \ lose("GC invariant lost, file \"%s\", line %d", __FILE__, __LINE__) @@ -80,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 */ @@ -104,7 +102,7 @@ forwarding_pointer_p(lispobj obj) static boolean dynamic_pointer_p(lispobj ptr) { -#ifndef __i386__ +#ifndef LISP_FEATURE_GENCGC return (ptr >= (lispobj)current_dynamic_space && ptr < (lispobj)dynamic_space_free_pointer); @@ -116,8 +114,24 @@ dynamic_pointer_p(lispobj ptr) #endif } +static inline lispobj * +newspace_alloc(int nwords, int constantp) +{ + lispobj *ret; + nwords=CEILING(nwords,2); + if(constantp) { + ret=read_only_free; + read_only_free+=nwords; + } else { + ret=static_free; + static_free+=nwords; + } + return ret; +} + + -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 #ifdef LISP_FEATURE_GENCGC /* @@ -132,17 +146,13 @@ dynamic_pointer_p(lispobj ptr) static unsigned pointer_filter_verbose = 0; -/* FIXME: This is substantially the same code as in gencgc.c. (There - * are some differences, at least (1) the gencgc.c code needs to worry - * about return addresses on the stack pinning code objects, (2) the - * gencgc.c code needs to worry about the GC maybe happening in an - * interrupt service routine when the main thread of control was - * interrupted just as it had allocated memory and before it - * initialized it, while PURIFY needn't worry about that, and (3) the - * gencgc.c code has mutated more under maintenance since the fork - * from CMU CL than the code here has.) The two versions should be - * made to explicitly share common code, instead of just two different - * cut-and-pasted versions. */ +/* FIXME: This is substantially the same code as + * possibly_valid_dynamic_space_pointer in gencgc.c. The only + * relevant difference seems to be that the gencgc code also checks + * for raw pointers into Code objects, whereas in purify these are + * checked separately in setup_i386_stack_scav - they go onto + * valid_stack_ra_locations instead of just valid_stack_locations */ + static int valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) { @@ -189,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 { @@ -237,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); @@ -274,7 +284,8 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) case COMPLEX_LONG_FLOAT_WIDETAG: #endif case SIMPLE_ARRAY_WIDETAG: - case COMPLEX_STRING_WIDETAG: + case COMPLEX_BASE_STRING_WIDETAG: + case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_BIT_VECTOR_WIDETAG: case COMPLEX_VECTOR_WIDETAG: case COMPLEX_ARRAY_WIDETAG: @@ -288,12 +299,17 @@ valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) #ifdef LONG_FLOAT_WIDETAG case LONG_FLOAT_WIDETAG: #endif - case SIMPLE_STRING_WIDETAG: + case SIMPLE_ARRAY_NIL_WIDETAG: + case SIMPLE_BASE_STRING_WIDETAG: case SIMPLE_BIT_VECTOR_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: @@ -462,14 +478,7 @@ ptrans_boxed(lispobj thing, lispobj header, boolean constant) /* Allocate it */ old = (lispobj *)native_pointer(thing); - if (constant) { - new = read_only_free; - read_only_free += CEILING(nwords, 2); - } - else { - new = static_free; - static_free += CEILING(nwords, 2); - } + new = newspace_alloc(nwords,constant); /* Copy it. */ bcopy(old, new, nwords * sizeof(lispobj)); @@ -488,7 +497,7 @@ ptrans_boxed(lispobj thing, lispobj header, boolean constant) * class, and only then can we transport as constant. If it is pure, * we can ALWAYS transport as a constant. */ static lispobj -ptrans_instance(lispobj thing, lispobj header, boolean constant) +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]; @@ -512,8 +521,7 @@ ptrans_instance(lispobj thing, lispobj header, boolean constant) /* Allocate it */ old = (lispobj *)native_pointer(thing); - new = static_free; - static_free += CEILING(nwords, 2); + new = newspace_alloc(nwords, 0); /* inconstant */ /* Copy it. */ bcopy(old, new, nwords * sizeof(lispobj)); @@ -544,8 +552,7 @@ ptrans_fdefn(lispobj thing, lispobj header) /* Allocate it */ old = (lispobj *)native_pointer(thing); - new = static_free; - static_free += CEILING(nwords, 2); + new = newspace_alloc(nwords, 0); /* inconstant */ /* Copy it. */ bcopy(old, new, nwords * sizeof(lispobj)); @@ -574,10 +581,9 @@ ptrans_unboxed(lispobj thing, lispobj header) /* Allocate it */ old = (lispobj *)native_pointer(thing); - new = read_only_free; - read_only_free += CEILING(nwords, 2); + new = newspace_alloc(nwords,1); /* always constant */ - /* Copy it. */ + /* copy it. */ bcopy(old, new, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ @@ -598,15 +604,7 @@ ptrans_vector(lispobj thing, int bits, int extra, vector = (struct vector *)native_pointer(thing); nwords = 2 + (CEILING((fixnum_value(vector->length)+extra)*bits,32)>>5); - if (boxed && !constant) { - new = static_free; - static_free += CEILING(nwords, 2); - } - else { - new = read_only_free; - read_only_free += CEILING(nwords, 2); - } - + new=newspace_alloc(nwords, (constant || !boxed)); bcopy(vector, new, nwords * sizeof(lispobj)); result = make_lispobj(new, lowtag_of(thing)); @@ -618,7 +616,7 @@ ptrans_vector(lispobj thing, int bits, int extra, return result; } -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 static void apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) { @@ -712,8 +710,7 @@ ptrans_code(lispobj thing) code = (struct code *)native_pointer(thing); nwords = HeaderValue(code->header) + fixnum_value(code->code_size); - new = (struct code *)read_only_free; - read_only_free += CEILING(nwords, 2); + new = (struct code *)newspace_alloc(nwords,1); /* constant */ bcopy(code, new, nwords * sizeof(lispobj)); @@ -739,11 +736,16 @@ ptrans_code(lispobj thing) /* Arrange to scavenge the debug info later. */ pscav_later(&new->debug_info, 1); - if (new->trace_table_offset & 0x3) + /* FIXME: why would this be a fixnum? */ + /* "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); + pscav(&new->trace_table_offset, 1, 0); #else - new->trace_table_offset = NIL; /* limit lifetime */ + new->trace_table_offset = NIL; /* limit lifetime */ #endif /* Scavenge the constants. */ @@ -757,13 +759,13 @@ ptrans_code(lispobj thing) gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG); gc_assert(!dynamic_pointer_p(func)); -#ifdef __i386__ - /* Temporarly convert the self pointer to a real function pointer. */ +#ifdef LISP_FEATURE_X86 + /* 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 __i386__ +#ifdef LISP_FEATURE_X86 ((struct simple_fun *)native_pointer(func))->self += FUN_RAW_ADDR_OFFSET; #endif @@ -786,8 +788,7 @@ ptrans_func(lispobj thing, lispobj header) * Otherwise we have to do something strange, 'cause it is buried * inside a code object. */ - if (widetag_of(header) == SIMPLE_FUN_HEADER_WIDETAG || - widetag_of(header) == CLOSURE_FUN_HEADER_WIDETAG) { + if (widetag_of(header) == SIMPLE_FUN_HEADER_WIDETAG) { /* We can only end up here if the code object has not been * scavenged, because if it had been scavenged, forwarding pointers @@ -812,19 +813,12 @@ ptrans_func(lispobj thing, lispobj header) nwords = 1 + HeaderValue(header); old = (lispobj *)native_pointer(thing); - /* Allocate the new one. */ - if (widetag_of(header) == FUNCALLABLE_INSTANCE_HEADER_WIDETAG) { - /* FINs *must* not go in read_only space. */ - new = static_free; - static_free += CEILING(nwords, 2); - } - else { - /* Closures can always go in read-only space, 'cause they - * never change. */ + /* Allocate the new one. FINs *must* not go in read_only + * space. Closures can; they never change */ - new = read_only_free; - read_only_free += CEILING(nwords, 2); - } + new = newspace_alloc + (nwords,(widetag_of(header)!=FUNCALLABLE_INSTANCE_HEADER_WIDETAG)); + /* Copy it. */ bcopy(old, new, nwords * sizeof(lispobj)); @@ -864,23 +858,13 @@ ptrans_list(lispobj thing, boolean constant) struct cons *old, *new, *orig; int length; - if (constant) - orig = (struct cons *)read_only_free; - else - orig = (struct cons *)static_free; + orig = (struct cons *) newspace_alloc(0,constant); length = 0; do { /* Allocate a new cons cell. */ old = (struct cons *)native_pointer(thing); - if (constant) { - new = (struct cons *)read_only_free; - read_only_free += WORDS_PER_CONS; - } - else { - new = (struct cons *)static_free; - static_free += WORDS_PER_CONS; - } + new = (struct cons *) newspace_alloc(WORDS_PER_CONS,constant); /* Copy the cons cell and keep a pointer to the cdr. */ new->car = old->car; @@ -905,6 +889,7 @@ static lispobj ptrans_otherptr(lispobj thing, lispobj header, boolean constant) { switch (widetag_of(header)) { + /* FIXME: this needs a reindent */ case BIGNUM_WIDETAG: case SINGLE_FLOAT_WIDETAG: case DOUBLE_FLOAT_WIDETAG: @@ -921,12 +906,14 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case COMPLEX_LONG_FLOAT_WIDETAG: #endif case SAP_WIDETAG: - return ptrans_unboxed(thing, header); + return ptrans_unboxed(thing, header); case RATIO_WIDETAG: case COMPLEX_WIDETAG: case SIMPLE_ARRAY_WIDETAG: - case COMPLEX_STRING_WIDETAG: + case COMPLEX_BASE_STRING_WIDETAG: + case COMPLEX_BIT_VECTOR_WIDETAG: + case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_VECTOR_WIDETAG: case COMPLEX_ARRAY_WIDETAG: return ptrans_boxed(thing, header, constant); @@ -938,7 +925,10 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case SYMBOL_HEADER_WIDETAG: return ptrans_boxed(thing, header, 0); - case SIMPLE_STRING_WIDETAG: + case SIMPLE_ARRAY_NIL_WIDETAG: + return ptrans_vector(thing, 0, 0, 0, constant); + + case SIMPLE_BASE_STRING_WIDETAG: return ptrans_vector(thing, 8, 1, 0, constant); case SIMPLE_BIT_VECTOR_WIDETAG: @@ -956,21 +946,25 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG: #endif return ptrans_vector(thing, 8, 0, 0, constant); case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG: #endif return ptrans_vector(thing, 16, 0, 0, constant); case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG: #endif #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG: #endif return ptrans_vector(thing, 32, 0, 0, constant); @@ -982,7 +976,7 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG: -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 return ptrans_vector(thing, 96, 0, 0, constant); #endif #ifdef sparc @@ -1002,7 +996,7 @@ ptrans_otherptr(lispobj thing, lispobj header, boolean constant) #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG: -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 return ptrans_vector(thing, 192, 0, 0, constant); #endif #ifdef sparc @@ -1039,7 +1033,7 @@ pscav_fdefn(struct fdefn *fdefn) return sizeof(struct fdefn) / sizeof(lispobj); } -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 /* now putting code objects in static space */ static int pscav_code(struct code*code) @@ -1062,14 +1056,14 @@ pscav_code(struct code*code) gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG); gc_assert(!dynamic_pointer_p(func)); -#ifdef __i386__ - /* Temporarly convert the self pointer to a real function +#ifdef LISP_FEATURE_X86 + /* 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 __i386__ +#ifdef LISP_FEATURE_X86 ((struct simple_fun *)native_pointer(func))->self += FUN_RAW_ADDR_OFFSET; #endif @@ -1126,7 +1120,7 @@ pscav(lispobj *addr, int nwords, boolean constant) } count = 1; } - else if (thing & 3) { + else if (thing & 3) { /* FIXME: 3? not 2? */ /* It's an other immediate. Maybe the header for an unboxed */ /* object. */ switch (widetag_of(thing)) { @@ -1149,52 +1143,75 @@ pscav(lispobj *addr, int nwords, boolean constant) count = 1; break; - case SIMPLE_STRING_WIDETAG: + case SIMPLE_ARRAY_NIL_WIDETAG: + count = 2; + break; + + 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; 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: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: + 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: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG: + 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: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG: #endif #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG: + 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; @@ -1212,7 +1229,7 @@ pscav(lispobj *addr, int nwords, boolean constant) #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG: vector = (struct vector *)addr; -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 count = fixnum_value(vector->length)*3+2; #endif #ifdef sparc @@ -1231,7 +1248,7 @@ pscav(lispobj *addr, int nwords, boolean constant) #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG: vector = (struct vector *)addr; -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 count = fixnum_value(vector->length)*6+2; #endif #ifdef sparc @@ -1241,7 +1258,7 @@ pscav(lispobj *addr, int nwords, boolean constant) #endif case CODE_HEADER_WIDETAG: -#ifndef __i386__ +#ifndef LISP_FEATURE_X86 gc_abort(); /* no code headers in static space */ #else count = pscav_code((struct code*)addr); @@ -1249,14 +1266,13 @@ pscav(lispobj *addr, int nwords, boolean constant) break; case SIMPLE_FUN_HEADER_WIDETAG: - case CLOSURE_FUN_HEADER_WIDETAG: case RETURN_PC_HEADER_WIDETAG: /* We should never hit any of these, 'cause they occur * buried in the middle of code objects. */ gc_abort(); break; -#ifdef __i386__ +#ifdef LISP_FEATURE_X86 case CLOSURE_HEADER_WIDETAG: case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: /* The function self pointer needs special care on the @@ -1309,6 +1325,14 @@ purify(lispobj static_roots, lispobj read_only_roots) struct later *laters, *next; struct thread *thread; + if(all_threads->next) { + /* FIXME: there should be _some_ sensible error reporting + * convention. See following comment too */ + fprintf(stderr,"Can't purify when more than one thread exists\n"); + fflush(stderr); + return 0; + } + #ifdef PRINTNOISE printf("[doing purification:"); fflush(stdout); @@ -1326,7 +1350,7 @@ purify(lispobj static_roots, lispobj read_only_roots) return 0; } -#if defined(__i386__) +#if defined(LISP_FEATURE_X86) dynamic_space_free_pointer = (lispobj*)SymbolValue(ALLOCATION_POINTER,0); #endif @@ -1342,23 +1366,9 @@ purify(lispobj static_roots, lispobj read_only_roots) #endif #if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86)) -#if 0 - /* This is what we should do, but can't unless the threads in - * question are suspended with ptrace. That's right, purify is not - * threadsafe - */ - for_each_thread(thread) { - void **ptr; - struct user_regs_struct regs; - if(ptrace(PTRACE_GETREGS,thread->pid,0,®s)){ - fprintf(stderr,"child pid %d, %s\n",thread->pid,strerror(errno)); - lose("PTRACE_GETREGS"); - } - setup_i386_stack_scav(regs.ebp, - ((void *)thread->control_stack_end)); - } -#endif /* 0 */ - /* stopgap until we can set things up as in preceding comment */ + /* 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 @@ -1379,7 +1389,7 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" stack"); fflush(stdout); #endif -#ifndef __i386__ +#ifndef LISP_FEATURE_X86 pscav((lispobj *)all_threads->control_stack_start, current_control_stack_pointer - all_threads->control_stack_start, @@ -1394,7 +1404,7 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" bindings"); fflush(stdout); #endif -#if !defined(__i386__) +#if !defined(LISP_FEATURE_X86) pscav( (lispobj *)all_threads->binding_stack_start, (lispobj *)current_binding_stack_pointer - all_threads->binding_stack_start, @@ -1474,7 +1484,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 __i386__ +#ifndef LISP_FEATURE_X86 os_zero((os_vm_address_t) current_control_stack_pointer, (os_vm_size_t) ((all_threads->control_stack_end - @@ -1486,8 +1496,9 @@ 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(__i386__) +#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(); @@ -1500,6 +1511,5 @@ purify(lispobj static_roots, lispobj read_only_roots) printf(" done]\n"); fflush(stdout); #endif - return 0; }