#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;
+static lispobj *dynamic_space_purify_pointer;
+
\f
/* These hold the original end of the read_only and static spaces so
* we can tell what are forwarding pointers. */
#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:
#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:
}
#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 =
(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
}
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 */