(mark_object) [GC_CHECK_MARKED_OBJECTS]: Check that no

bogus objects are marked.  This slows down GC by ~80 percent, but
it might be worth trying when debugging GC-related problems.
This feature requires conservative stack marking to be enabled.

1 files changed, 81 insertions, 2 deletions

diff --git a/src/alloc.c b/src/alloc.c
index 0c58f3cc1be..0c568f5fa70 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3785,6 +3785,10 @@ mark_object (argptr)
 {
   Lisp_Object *objptr = argptr;
   register Lisp_Object obj;
+#ifdef GC_CHECK_MARKED_OBJECTS
+  void *po;
+  struct mem_node *m;
+#endif
 
  loop:
   obj = *objptr;
@@ -3798,21 +3802,81 @@ mark_object (argptr)
   if (last_marked_index == LAST_MARKED_SIZE)
     last_marked_index = 0;
 
+  /* Perform some sanity checks on the objects marked here.  Abort if
+     we encounter an object we know is bogus.  This increases GC time
+     by ~80%, and requires compilation with GC_MARK_STACK != 0.  */
+#ifdef GC_CHECK_MARKED_OBJECTS
+
+  po = (void *) XPNTR (obj);
+
+  /* Check that the object pointed to by PO is known to be a Lisp
+     structure allocated from the heap.  */
+#define CHECK_ALLOCATED()			\
+  do {						\
+    m = mem_find (po);				\
+    if (m == MEM_NIL)				\
+      abort ();					\
+  } while (0)
+
+  /* Check that the object pointed to by PO is live, using predicate
+     function LIVEP.  */
+#define CHECK_LIVE(LIVEP)			\
+  do {						\
+    if (!LIVEP (m, po))				\
+      abort ();					\
+  } while (0)
+
+  /* Check both of the above conditions.  */
+#define CHECK_ALLOCATED_AND_LIVE(LIVEP)		\
+  do {						\
+    CHECK_ALLOCATED ();				\
+    CHECK_LIVE (LIVEP);				\
+  } while (0)					\
+  
+#else /* not GC_CHECK_MARKED_OBJECTS */
+  
+#define CHECK_ALLOCATED()		(void) 0
+#define CHECK_LIVE(LIVEP)		(void) 0
+#define CHECK_ALLOCATED_AND_LIVE(LIVEP)	(void) 0
+  
+#endif /* not GC_CHECK_MARKED_OBJECTS */
+
   switch (SWITCH_ENUM_CAST (XGCTYPE (obj)))
     {
     case Lisp_String:
       {
 	register struct Lisp_String *ptr = XSTRING (obj);
+	CHECK_ALLOCATED_AND_LIVE (live_string_p);
 	MARK_INTERVAL_TREE (ptr->intervals);
 	MARK_STRING (ptr);
       }
       break;
 
     case Lisp_Vectorlike:
+#ifdef GC_CHECK_MARKED_OBJECTS
+      m = mem_find (po);
+      if (m == MEM_NIL && !GC_SUBRP (obj)
+	  && po != &buffer_defaults
+	  && po != &buffer_local_symbols)
+	abort ();
+#endif /* GC_CHECK_MARKED_OBJECTS */
+      
       if (GC_BUFFERP (obj))
 	{
 	  if (!XMARKBIT (XBUFFER (obj)->name))
-	    mark_buffer (obj);
+	    {
+#ifdef GC_CHECK_MARKED_OBJECTS
+	      if (po != &buffer_defaults && po != &buffer_local_symbols)
+		{
+		  struct buffer *b;
+		  for (b = all_buffers; b && b != po; b = b->next)
+		    ;
+		  if (b == NULL)
+		    abort ();
+		}
+#endif /* GC_CHECK_MARKED_OBJECTS */
+	      mark_buffer (obj);
+	    }
 	}
       else if (GC_SUBRP (obj))
 	break;
@@ -3829,6 +3893,8 @@ mark_object (argptr)
 
 	  if (size & ARRAY_MARK_FLAG)
 	    break;   /* Already marked */
+	  
+	  CHECK_LIVE (live_vector_p);
 	  ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
 	  size &= PSEUDOVECTOR_SIZE_MASK;
 	  for (i = 0; i < size; i++) /* and then mark its elements */
@@ -3850,6 +3916,7 @@ mark_object (argptr)
 	  if (size & ARRAY_MARK_FLAG) break;   /* Already marked */
 	  ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
 
+	  CHECK_LIVE (live_vector_p);
 	  mark_object (&ptr->name);
 	  mark_object (&ptr->icon_name);
 	  mark_object (&ptr->title);
@@ -3881,6 +3948,7 @@ mark_object (argptr)
 
 	  if (ptr->size & ARRAY_MARK_FLAG)
 	    break;   /* Already marked */
+	  CHECK_LIVE (live_vector_p);
 	  ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
 	}
       else if (GC_WINDOWP (obj))
@@ -3902,6 +3970,7 @@ mark_object (argptr)
 	    break;
 
 	  /* Mark it.  */
+	  CHECK_LIVE (live_vector_p);
 	  ptr->size |= ARRAY_MARK_FLAG;
 
 	  /* There is no Lisp data above The member CURRENT_MATRIX in
@@ -3930,8 +3999,9 @@ mark_object (argptr)
 	  /* Stop if already marked.  */
 	  if (size & ARRAY_MARK_FLAG)
 	    break;
-
+	  
 	  /* Mark it.  */
+	  CHECK_LIVE (live_vector_p);
 	  h->size |= ARRAY_MARK_FLAG;
 
 	  /* Mark contents.  */
@@ -3967,6 +4037,7 @@ mark_object (argptr)
 	  register int i;
 
 	  if (size & ARRAY_MARK_FLAG) break; /* Already marked */
+	  CHECK_LIVE (live_vector_p);
 	  ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
 	  if (size & PSEUDOVECTOR_FLAG)
 	    size &= PSEUDOVECTOR_SIZE_MASK;
@@ -3983,6 +4054,7 @@ mark_object (argptr)
 	struct Lisp_Symbol *ptrx;
 
 	if (XMARKBIT (ptr->plist)) break;
+	CHECK_ALLOCATED_AND_LIVE (live_symbol_p);
 	XMARK (ptr->plist);
 	mark_object ((Lisp_Object *) &ptr->value);
 	mark_object (&ptr->function);
@@ -4010,6 +4082,7 @@ mark_object (argptr)
       break;
 
     case Lisp_Misc:
+      CHECK_ALLOCATED_AND_LIVE (live_misc_p);
       switch (XMISCTYPE (obj))
 	{
 	case Lisp_Misc_Marker:
@@ -4074,6 +4147,7 @@ mark_object (argptr)
       {
 	register struct Lisp_Cons *ptr = XCONS (obj);
 	if (XMARKBIT (ptr->car)) break;
+	CHECK_ALLOCATED_AND_LIVE (live_cons_p);
 	XMARK (ptr->car);
 	/* If the cdr is nil, avoid recursion for the car.  */
 	if (EQ (ptr->cdr, Qnil))
@@ -4088,6 +4162,7 @@ mark_object (argptr)
       }
 
     case Lisp_Float:
+      CHECK_ALLOCATED_AND_LIVE (live_float_p);
       XMARK (XFLOAT (obj)->type);
       break;
 
@@ -4097,6 +4172,10 @@ mark_object (argptr)
     default:
       abort ();
     }
+
+#undef CHECK_LIVE
+#undef CHECK_ALLOCATED
+#undef CHECK_ALLOCATED_AND_LIVE
 }
 
 /* Mark the pointers in a buffer structure.  */