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

diff --git a/src/runtime/gencgc.c b/src/runtime/gencgc.c
index 0df9e92..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?
@@ -3362,6 +3379,23 @@ print_ptr(lispobj *addr)
 }
 #endif
 
+static int
+is_in_stack_space(lispobj ptr)
+{
+    /* For space verification: Pointers can be valid if they point
+     * to a thread stack space.  This would be faster if the thread
+     * structures had page-table entries as if they were part of
+     * the heap space. */
+    struct thread *th;
+    for_each_thread(th) {
+        if ((th->control_stack_start <= (lispobj *)ptr) &&
+            (th->control_stack_end >= (lispobj *)ptr)) {
+            return 1;
+        }
+    }
+    return 0;
+}
+
 static void
 verify_space(lispobj *start, size_t words)
 {
@@ -3389,15 +3423,15 @@ verify_space(lispobj *start, size_t words)
                  * page. XX Could check the offset too. */
                 if (page_allocated_p(page_index)
                     && (page_table[page_index].bytes_used == 0))
-                    lose ("Ptr %x @ %x sees free page.\n", thing, start);
+                    lose ("Ptr %p @ %p sees free page.\n", thing, start);
                 /* Check that it doesn't point to a forwarding pointer! */
                 if (*((lispobj *)native_pointer(thing)) == 0x01) {
-                    lose("Ptr %x @ %x sees forwarding ptr.\n", thing, start);
+                    lose("Ptr %p @ %p sees forwarding ptr.\n", thing, start);
                 }
                 /* Check that its not in the RO space as it would then be a
                  * pointer from the RO to the dynamic space. */
                 if (is_in_readonly_space) {
-                    lose("ptr to dynamic space %x from RO space %x\n",
+                    lose("ptr to dynamic space %p from RO space %x\n",
                          thing, start);
                 }
                 /* Does it point to a plausible object? This check slows
@@ -3411,13 +3445,16 @@ verify_space(lispobj *start, size_t words)
                  * dynamically. */
                 /*
                 if (!possibly_valid_dynamic_space_pointer((lispobj *)thing)) {
-                    lose("ptr %x to invalid object %x\n", thing, start);
+                    lose("ptr %p to invalid object %p\n", thing, start);
                 }
                 */
             } else {
+                extern void funcallable_instance_tramp;
                 /* Verify that it points to another valid space. */
-                if (!to_readonly_space && !to_static_space) {
-                    lose("Ptr %x @ %x sees junk.\n", thing, start);
+                if (!to_readonly_space && !to_static_space
+                    && (thing != (lispobj)&funcallable_instance_tramp)
+                    && !is_in_stack_space(thing)) {
+                    lose("Ptr %p @ %p sees junk.\n", thing, start);
                 }
             }
         } else {
@@ -3494,7 +3531,7 @@ verify_space(lispobj *start, size_t words)
                             /* Only when enabled */
                             && verify_dynamic_code_check) {
                             FSHOW((stderr,
-                                   "/code object at %x in the dynamic space\n",
+                                   "/code object at %p in the dynamic space\n",
                                    start));
                         }
 
@@ -3610,7 +3647,7 @@ verify_space(lispobj *start, size_t words)
                     break;
 
                 default:
-                    lose("Unhandled widetag 0x%x at 0x%x\n",
+                    lose("Unhandled widetag %p at %p\n",
                          widetag_of(*start), start);
                 }
             }
@@ -3799,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 */
@@ -3943,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)
 {