#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
}
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!");
+ 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!");
+ lose("Ran out of static space while purifying!\n");
}
ret=static_free;
static_free+=nwords;
#endif
case SAP_WIDETAG:
case WEAK_POINTER_WIDETAG:
+#ifdef LUTEX_WIDETAG
+ case LUTEX_WIDETAG:
+#endif
break;
default:
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 */
projects / sbcl.git / blobdiff