#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;
-#define gc_abort() \
- lose("GC invariant lost, file \"%s\", line %d", __FILE__, __LINE__)
-
-#if 1
-#define gc_assert(ex) do { \
- if (!(ex)) gc_abort(); \
-} while (0)
-#else
-#define gc_assert(ex)
-#endif
+static lispobj *dynamic_space_purify_pointer;
\f
/* These hold the original end of the read_only and static spaces so
#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
\f
static boolean
forwarding_pointer_p(lispobj obj)
#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
}
lispobj *ret;
nwords=CEILING(nwords,2);
if(constantp) {
+ if(read_only_free + nwords >= (lispobj *)READ_ONLY_SPACE_END) {
+ lose("Ran out of read-only space while purifying!\n");
+ }
ret=read_only_free;
read_only_free+=nwords;
} else {
+ if(static_free + nwords >= (lispobj *)STATIC_SPACE_END) {
+ lose("Ran out of static space while purifying!\n");
+ }
ret=static_free;
static_free+=nwords;
}
case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
if ((long)pointer != ((long)start_addr+FUN_POINTER_LOWTAG)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wf2: %x %x %x\n",
- (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wf2: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
}
return 0;
}
break;
default:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wf3: %x %x %x\n", (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wf3: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
}
return 0;
}
case LIST_POINTER_LOWTAG:
if ((long)pointer != ((long)start_addr+LIST_POINTER_LOWTAG)) {
if (pointer_filter_verbose)
- fprintf(stderr,"*Wl1: %x %x %x\n", (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wl1: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
return 0;
}
/* Is it plausible cons? */
break;
} else {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wl2: %x %x %x\n", (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wl2: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
}
return 0;
}
case INSTANCE_POINTER_LOWTAG:
if ((long)pointer != ((long)start_addr+INSTANCE_POINTER_LOWTAG)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wi1: %x %x %x\n", (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wi1: %p %p %p\n",
+ pointer, start_addr, (void *)*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 long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wi2: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
}
return 0;
}
case OTHER_POINTER_LOWTAG:
if ((long)pointer != ((long)start_addr+OTHER_POINTER_LOWTAG)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo1: %x %x %x\n", (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wo1: %p %p %p\n",
+ pointer, start_addr, (void *)*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] & FIXNUM_TAG_MASK) == 0)) {
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wo2: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
}
return 0;
}
case SINGLE_FLOAT_WIDETAG:
#endif
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wo3: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
}
return 0;
case CLOSURE_HEADER_WIDETAG:
case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wo4: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
}
return 0;
case INSTANCE_HEADER_WIDETAG:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo5: %x %x %x\n", (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wo5: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
}
return 0;
#endif
case SAP_WIDETAG:
case WEAK_POINTER_WIDETAG:
+#ifdef LUTEX_WIDETAG
+ case LUTEX_WIDETAG:
+#endif
break;
default:
if (pointer_filter_verbose) {
- fprintf(stderr,"*Wo6: %x %x %x\n", (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*Wo6: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
}
return 0;
}
break;
default:
if (pointer_filter_verbose) {
- fprintf(stderr,"*W?: %x %x %x\n", (unsigned long) pointer,
- (unsigned long) start_addr, *start_addr);
+ fprintf(stderr,"*W?: %p %p %p\n",
+ pointer, start_addr, (void *)*start_addr);
}
return 0;
}
}
}
if (pointer_filter_verbose) {
- fprintf(stderr, "number of valid stack pointers = %d\n",
+ fprintf(stderr, "number of valid stack pointers = %ld\n",
num_valid_stack_locations);
- fprintf(stderr, "number of stack return addresses = %d\n",
+ fprintf(stderr, "number of stack return addresses = %ld\n",
num_valid_stack_ra_locations);
}
}
lispobj code_obj = (lispobj)valid_stack_ra_code_objects[i];
pscav(&code_obj, 1, 0);
if (pointer_filter_verbose) {
- fprintf(stderr,"*C moved RA %x to %x; for code object %x to %x\n",
- *valid_stack_ra_locations[i],
- (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);
+ fprintf(stderr,"*C moved RA %p to %p; for code object %p to %p\n",
+ (void *)*valid_stack_ra_locations[i],
+ (void *)(*valid_stack_ra_locations[i]) -
+ ((void *)valid_stack_ra_code_objects[i] -
+ (void *)code_obj),
+ valid_stack_ra_code_objects[i], (void *)code_obj);
}
*valid_stack_ra_locations[i] =
((long)(*valid_stack_ra_locations[i])
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:
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);
for (i=0; i<length; i++) {
unsigned offset = fixups_vector->data[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;
}
}
((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;
#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:
((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);
#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. */
{
}
#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 =
printf(" handlers");
fflush(stdout);
#endif
- pscav((lispobj *) all_threads->interrupt_data->interrupt_handlers,
- sizeof(all_threads->interrupt_data->interrupt_handlers)
- / sizeof(lispobj),
+ pscav((lispobj *) interrupt_handlers,
+ sizeof(interrupt_handlers) / sizeof(lispobj),
0);
#ifdef PRINTNOISE
(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
}
#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. */
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 */