X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgencgc.c;h=d833733430e1cef4df371990d88e1be15e8dd5c9;hb=ea50d9ffd5315389ff378e4580724b0c2a939c85;hp=8c61a09b1014f45d2af59b4e7591f1e95e4ebd8d;hpb=b2bc5f9149d87e177830afb1104ea07e4ffe318e;p=sbcl.git

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 8c61a09..d833733 100644
--- a/src/runtime/gencgc.c
+++ b/src/runtime/gencgc.c
@@ -2214,8 +2214,6 @@ search_dynamic_space(void *pointer)
                             (lispobj *)pointer));
 }
 
-#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
-
 /* Helper for valid_lisp_pointer_p and
  * possibly_valid_dynamic_space_pointer.
  *
@@ -2304,6 +2302,23 @@ looks_like_valid_lisp_pointer_p(lispobj *pointer, lispobj *start_addr)
         }
         break;
     case OTHER_POINTER_LOWTAG:
+
+#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64)
+        /* The all-architecture test below is good as far as it goes,
+         * but an LRA object is similar to a FUN-POINTER: It is
+         * embedded within a CODE-OBJECT pointed to by start_addr, and
+         * 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);
+            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 (gencgc_verbose) {
@@ -2499,6 +2514,8 @@ valid_lisp_pointer_p(lispobj *pointer)
         return 0;
 }
 
+#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)
+
 /* Is there any possibility that pointer is a valid Lisp object
  * reference, and/or something else (e.g. subroutine call return
  * address) which should prevent us from moving the referred-to thing?
@@ -3819,6 +3836,10 @@ scavenge_control_stack()
 
     control_stack_size = current_control_stack_pointer - control_stack;
     scavenge(control_stack, control_stack_size);
+
+    /* Scrub the unscavenged control stack space, so that we can't run
+     * into any stale pointers in a later GC. */
+    scrub_control_stack();
 }
 
 /* Scavenging Interrupt Contexts */
@@ -3963,7 +3984,7 @@ scavenge_interrupt_contexts(void)
 
 #endif
 
-#if defined(LISP_FEATURE_SB_THREAD)
+#if defined(LISP_FEATURE_SB_THREAD) && (defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
 static void
 preserve_context_registers (os_context_t *c)
 {