/*
* copying objects
*/
-static
-lispobj
-gc_general_copy_object(lispobj object, long nwords, int page_type_flag)
-{
- int tag;
- lispobj *new;
-
- gc_assert(is_lisp_pointer(object));
- gc_assert(from_space_p(object));
- gc_assert((nwords & 0x01) == 0);
-
- /* Get tag of object. */
- tag = lowtag_of(object);
-
- /* Allocate space. */
- new = gc_general_alloc(nwords*N_WORD_BYTES, page_type_flag, ALLOC_QUICK);
- /* Copy the object. */
- memcpy(new,native_pointer(object),nwords*N_WORD_BYTES);
- return make_lispobj(new,tag);
-}
+/* gc_general_copy_object is inline from gc-internal.h */
/* to copy a boxed object */
lispobj
* of the enclosing object.
*/
int
-looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
+looks_like_valid_lisp_pointer_p(lispobj pointer, lispobj *start_addr)
{
- if (!is_lisp_pointer((lispobj)pointer)) {
+ if (!is_lisp_pointer(pointer)) {
return 0;
}
/* Check that the object pointed to is consistent with the pointer
* low tag. */
- switch (lowtag_of((lispobj)pointer)) {
+ switch (lowtag_of(pointer)) {
case FUN_POINTER_LOWTAG:
/* Start_addr should be the enclosing code object, or a closure
* header. */
switch (widetag_of(*start_addr)) {
case CODE_HEADER_WIDETAG:
- /* Make sure we actually point to a function in the code object,
- * as opposed to a random point there. */
- if (SIMPLE_FUN_HEADER_WIDETAG==widetag_of(*((lispobj *)(((unsigned long)pointer)-FUN_POINTER_LOWTAG))))
- return 1;
- else
- return 0;
+ /* Make sure we actually point to a function in the code object,
+ * as opposed to a random point there. */
+ if (SIMPLE_FUN_HEADER_WIDETAG==widetag_of(native_pointer(pointer)[0]))
+ return 1;
+ else
+ return 0;
case CLOSURE_HEADER_WIDETAG:
case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
- if ((unsigned long)pointer !=
- ((unsigned long)start_addr+FUN_POINTER_LOWTAG)) {
+ if (pointer != make_lispobj(start_addr, FUN_POINTER_LOWTAG)) {
return 0;
}
break;
}
break;
case LIST_POINTER_LOWTAG:
- if ((unsigned long)pointer !=
- ((unsigned long)start_addr+LIST_POINTER_LOWTAG)) {
+ if (pointer != make_lispobj(start_addr, LIST_POINTER_LOWTAG)) {
return 0;
}
/* Is it plausible cons? */
return 0;
}
case INSTANCE_POINTER_LOWTAG:
- if ((unsigned long)pointer !=
- ((unsigned long)start_addr+INSTANCE_POINTER_LOWTAG)) {
+ if (pointer != make_lispobj(start_addr, INSTANCE_POINTER_LOWTAG)) {
return 0;
}
if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) {
* cannot be found by simply walking the heap, therefore we
* need to check for it. -- AB, 2010-Jun-04 */
if ((widetag_of(start_addr[0]) == CODE_HEADER_WIDETAG)) {
- lispobj *potential_lra =
- (lispobj *)(((unsigned long)pointer) - OTHER_POINTER_LOWTAG);
+ lispobj *potential_lra = native_pointer(pointer);
if ((widetag_of(potential_lra[0]) == RETURN_PC_HEADER_WIDETAG) &&
((potential_lra - HeaderValue(potential_lra[0])) == start_addr)) {
return 1; /* It's as good as we can verify. */
}
#endif
- if ((unsigned long)pointer !=
- ((unsigned long)start_addr+OTHER_POINTER_LOWTAG)) {
+ if (pointer != make_lispobj(start_addr, OTHER_POINTER_LOWTAG)) {
return 0;
}
/* Is it plausible? Not a cons. XXX should check the headers. */
if (((start=search_dynamic_space(pointer))!=NULL) ||
((start=search_static_space(pointer))!=NULL) ||
((start=search_read_only_space(pointer))!=NULL))
- return looks_like_valid_lisp_pointer_p(pointer, start);
+ return looks_like_valid_lisp_pointer_p((lispobj)pointer, start);
else
return 0;
}
struct thread *th = arch_os_get_current_thread();
os_vm_address_t guard_page_address = CONTROL_STACK_GUARD_PAGE(th);
os_vm_address_t hard_guard_page_address = CONTROL_STACK_HARD_GUARD_PAGE(th);
- lispobj *sp;
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
- sp = (lispobj *)&sp - 1;
+ /* On these targets scrubbing from C is a bad idea, so we punt to
+ * a routine in $ARCH-assem.S. */
+ extern void arch_scrub_control_stack(struct thread *, os_vm_address_t, os_vm_address_t);
+ arch_scrub_control_stack(th, guard_page_address, hard_guard_page_address);
#else
- sp = access_control_stack_pointer(th);
-#endif
+ lispobj *sp = access_control_stack_pointer(th);
scrub:
if ((((os_vm_address_t)sp < (hard_guard_page_address + os_vm_page_size)) &&
((os_vm_address_t)sp >= hard_guard_page_address)) ||
goto scrub;
} while (((unsigned long)++sp) & (BYTES_ZERO_BEFORE_END - 1));
#endif
+#endif /* LISP_FEATURE_C_STACK_IS_CONTROL_STACK */
}
\f
#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+void
+scavenge_control_stack(struct thread *th)
+{
+ lispobj *object_ptr;
+
+ /* In order to properly support dynamic-extent allocation of
+ * non-CONS objects, the control stack requires special handling.
+ * Rather than calling scavenge() directly, grovel over it fixing
+ * broken hearts, scavenging pointers to oldspace, and pitching a
+ * fit when encountering unboxed data. This prevents stray object
+ * headers from causing the scavenger to blow past the end of the
+ * stack (an error case checked in scavenge()). We don't worry
+ * about treating unboxed words as boxed or vice versa, because
+ * the compiler isn't allowed to store unboxed objects on the
+ * control stack. -- AB, 2011-Dec-02 */
+
+ for (object_ptr = th->control_stack_start;
+ object_ptr < access_control_stack_pointer(th);
+ object_ptr++) {
+
+ lispobj object = *object_ptr;
+#ifdef LISP_FEATURE_GENCGC
+ if (forwarding_pointer_p(object_ptr))
+ lose("unexpected forwarding pointer in scavenge_control_stack: %p, start=%p, end=%p\n",
+ object_ptr, th->control_stack_start, access_control_stack_pointer(th));
+#endif
+ if (is_lisp_pointer(object) && from_space_p(object)) {
+ /* It currently points to old space. Check for a
+ * forwarding pointer. */
+ lispobj *ptr = native_pointer(object);
+ if (forwarding_pointer_p(ptr)) {
+ /* Yes, there's a forwarding pointer. */
+ *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
+ } else {
+ /* Scavenge that pointer. */
+ long n_words_scavenged =
+ (scavtab[widetag_of(object)])(object_ptr, object);
+ gc_assert(n_words_scavenged == 1);
+ }
+ } else if (scavtab[widetag_of(object)] == scav_lose) {
+ lose("unboxed object in scavenge_control_stack: %p->%x, start=%p, end=%p\n",
+ object_ptr, object, th->control_stack_start, access_control_stack_pointer(th));
+ }
+ }
+}
+
/* Scavenging Interrupt Contexts */
static int boxed_registers[] = BOXED_REGISTERS;
projects / sbcl.git / blobdiff