#include "interrupt.h"
#include "purify.h"
#include "interr.h"
-#ifdef GENCGC
-#include "gencgc.h"
-#endif
+#include "gc.h"
+#include "gc-internal.h"
+#include "genesis/primitive-objects.h"
+#include "genesis/static-symbols.h"
#define PRINTNOISE
#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
#define NWORDS(x,y) (CEILING((x),(y)) / (y))
-/* FIXME: (1) Shouldn't this be defined in sbcl.h? */
+/* FIXME: Shouldn't this be defined in sbcl.h? See also notes in
+ * cheneygc.c */
+
#ifdef sparc
#define FUN_RAW_ADDR_OFFSET 0
#else
static boolean
forwarding_pointer_p(lispobj obj)
{
- lispobj *ptr;
-
- ptr = (lispobj *)obj;
+ lispobj *ptr = native_pointer(obj);
return ((static_end <= ptr && ptr <= static_free) ||
(read_only_end <= ptr && ptr <= read_only_free));
\f
#ifdef __i386__
-#ifdef GENCGC
+#ifdef LISP_FEATURE_GENCGC
/*
* enhanced x86/GENCGC stack scavenging by Douglas Crosher
*
* return addresses. This will also pick up pointers to
* functions in code objects. */
if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) {
+ /* FIXME asserting here is a really dumb thing to do.
+ * If we've overflowed some arbitrary static limit, we
+ * should just refuse to purify, instead of killing
+ * the whole lisp session
+ */
gc_assert(num_valid_stack_ra_locations <
MAX_STACK_RETURN_ADDRESSES);
valid_stack_ra_locations[num_valid_stack_ra_locations] = sp;
bcopy(old, new, nwords * sizeof(lispobj));
/* Deposit forwarding pointer. */
- result = (lispobj)new | lowtag_of(thing);
+ result = make_lispobj(new, lowtag_of(thing));
*old = result;
/* Scavenge it. */
bcopy(old, new, nwords * sizeof(lispobj));
/* Deposit forwarding pointer. */
- result = (lispobj)new | lowtag_of(thing);
+ result = make_lispobj(new, lowtag_of(thing));
*old = result;
/* Scavenge it. */
bcopy(old, new, nwords * sizeof(lispobj));
/* Deposit forwarding pointer. */
- result = (lispobj)new | lowtag_of(thing);
+ result = make_lispobj(new, lowtag_of(thing));
*old = result;
/* Scavenge the function. */
{
int nwords;
lispobj result, *new, *old;
-
+
nwords = 1 + HeaderValue(header);
-
+
/* Allocate it */
old = (lispobj *)native_pointer(thing);
new = read_only_free;
read_only_free += CEILING(nwords, 2);
-
+
/* Copy it. */
bcopy(old, new, nwords * sizeof(lispobj));
-
+
/* Deposit forwarding pointer. */
- result = (lispobj)new | lowtag_of(thing);
+ result = make_lispobj(new , lowtag_of(thing));
*old = result;
return result;
bcopy(vector, new, nwords * sizeof(lispobj));
- result = (lispobj)new | lowtag_of(thing);
+ result = make_lispobj(new, lowtag_of(thing));
vector->header = result;
if (boxed)
if ((fixups==0) ||
(fixups==UNBOUND_MARKER_WIDETAG) ||
!is_lisp_pointer(fixups)) {
-#ifdef GENCGC
+#ifdef LISP_FEATURE_GENCGC
/* Check for a possible errors. */
sniff_code_object(new_code,displacement);
#endif
/* No longer need the fixups. */
new_code->constants[0] = 0;
-#ifdef GENCGC
+#ifdef LISP_FEATURE_GENCGC
/* Check for possible errors. */
sniff_code_object(new_code,displacement);
#endif
bcopy(code, new, nwords * sizeof(lispobj));
-#ifdef __i386__
+#ifdef LISP_FEATURE_X86
apply_code_fixups_during_purify(code,new);
#endif
- result = (lispobj)new | OTHER_POINTER_LOWTAG;
+ result = make_lispobj(new, OTHER_POINTER_LOWTAG);
/* Stick in a forwarding pointer for the code object. */
*(lispobj *)code = result;
function = (struct simple_fun *)native_pointer(thing);
code =
- (native_pointer(thing) -
- (HeaderValue(function->header)*sizeof(lispobj))) |
- OTHER_POINTER_LOWTAG;
-
+ make_lispobj
+ ((native_pointer(thing) -
+ (HeaderValue(function->header))), OTHER_POINTER_LOWTAG);
+
/* This will cause the function's header to be replaced with a
* forwarding pointer. */
+
ptrans_code(code);
/* So we can just return that. */
bcopy(old, new, nwords * sizeof(lispobj));
/* Deposit forwarding pointer. */
- result = (lispobj)new | lowtag_of(thing);
+ result = make_lispobj(new, lowtag_of(thing));
*old = result;
/* Scavenge it. */
thing = new->cdr = old->cdr;
/* Set up the forwarding pointer. */
- *(lispobj *)old = ((lispobj)new) | LIST_POINTER_LOWTAG;
+ *(lispobj *)old = make_lispobj(new, LIST_POINTER_LOWTAG);
/* And count this cell. */
length++;
/* Scavenge the list we just copied. */
pscav((lispobj *)orig, length * WORDS_PER_CONS, constant);
- return ((lispobj)orig) | LIST_POINTER_LOWTAG;
+ return make_lispobj(orig, LIST_POINTER_LOWTAG);
}
static lispobj
int count, i;
struct later *laters, *next;
+
#ifdef PRINTNOISE
printf("[doing purification:");
fflush(stdout);
#endif
-
+#ifdef LISP_FEATURE_GENCGC
+ gc_alloc_update_all_page_tables();
+#endif
if (fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)) != 0) {
/* FIXME: 1. What does this mean? 2. It shouldn't be reporting
* its error simply by a. printing a string b. to stdout instead
fflush(stdout);
#endif
-#ifdef GENCGC
+#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86))
gc_assert((lispobj *)CONTROL_STACK_END > ((&read_only_roots)+1));
setup_i386_stack_scav(((&static_roots)-2), (lispobj *)CONTROL_STACK_END);
#endif
current_control_stack_pointer - (lispobj *)CONTROL_STACK_START,
0);
#else
-#ifdef GENCGC
+#ifdef LISP_FEATURE_GENCGC
pscav_i386_stack();
#endif
#endif
#if !defined(__i386__)
dynamic_space_free_pointer = current_dynamic_space;
#else
-#if defined GENCGC
+#if defined LISP_FEATURE_GENCGC
gc_free_heap();
#else
#error unsupported case /* in CMU CL, was "ibmrt using GC" */