Mercurial > hg > xemacs-beta

changeset 2645:e6854ec89f8e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-03-10 09:12:36 by crestani] KKCC backtrace. 2005-03-01 Marcus Crestani <crestani@informatik.uni-tuebingen.de> * alloc.c: Add functionality for backtracing the KKCC mark algorithm. * alloc.c (kkcc_backtrace): New. * alloc.c (kkcc_bt_push): New. * alloc.c (kkcc_gc_stack_push): * alloc.c (kkcc_gc_stack_push_lisp_object): * alloc.c (mark_object_maybe_checking_free): * alloc.c (mark_struct_contents): * alloc.c (kkcc_marking): * alloc.c (mark_object): * data.c (finish_marking_weak_lists): * data.c (continue_marking_ephemerons): * data.c (finish_marking_ephemerons): * elhash.c (MARK_OBJ): * lisp.h: * profile.c (mark_profiling_info_maphash): Add level (current depth of mark tree) and pos (position within description) as additional arguments to KKCC mark functions.
author crestani
date Thu, 10 Mar 2005 09:12:38 +0000
parents 0b4097b3552f
children 5e4893b16f7c
files src/ChangeLog src/alloc.c src/data.c src/elhash.c src/lisp.h src/profile.c
diffstat 6 files changed, 204 insertions(+), 32 deletions(-) [+]
line wrap: on
line diff
--- a/src/ChangeLog	Thu Mar 10 09:05:52 2005 +0000
+++ b/src/ChangeLog	Thu Mar 10 09:12:38 2005 +0000
@@ -1,3 +1,24 @@
+2005-03-01  Marcus Crestani  <crestani@informatik.uni-tuebingen.de>
+
+	* alloc.c: Add functionality for backtracing the KKCC mark
+	algorithm.
+	* alloc.c (kkcc_backtrace): New.
+	* alloc.c (kkcc_bt_push): New.
+	* alloc.c (kkcc_gc_stack_push):
+	* alloc.c (kkcc_gc_stack_push_lisp_object):
+	* alloc.c (mark_object_maybe_checking_free):
+	* alloc.c (mark_struct_contents):
+	* alloc.c (kkcc_marking):
+	* alloc.c (mark_object):
+	* data.c (finish_marking_weak_lists):
+	* data.c (continue_marking_ephemerons):
+	* data.c (finish_marking_ephemerons):
+	* elhash.c (MARK_OBJ):
+	* lisp.h:
+	* profile.c (mark_profiling_info_maphash): Add level (current
+	depth of mark tree) and pos (position within description) as
+	additional arguments to KKCC mark functions.
+
 2004-10-25  Mike Alexander  <mta@arbortext.com>
 
 	* Makefile.in.in (obj_src): Fix a typo in the PDUMP section
--- a/src/alloc.c	Thu Mar 10 09:05:52 2005 +0000
+++ b/src/alloc.c	Thu Mar 10 09:12:38 2005 +0000
@@ -3091,6 +3091,10 @@
     default:
       stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n",
 		  idesc[line].type, line, (long) code);
+#ifdef USE_KKCC
+      if (gc_in_progress)
+	kkcc_backtrace ();
+#endif
 #ifdef PDUMP
       if (in_pdump)
 	pdump_backtrace ();
@@ -3307,6 +3311,10 @@
 {
   void *data;
   const struct memory_description *desc;
+#ifdef DEBUG_XEMACS
+  int level;
+  int pos;
+#endif
 } kkcc_gc_stack_entry;
 
 static kkcc_gc_stack_entry *kkcc_gc_stack_ptr;
@@ -3314,6 +3322,72 @@
 static kkcc_gc_stack_entry *kkcc_gc_stack_last_entry;
 static int kkcc_gc_stack_size;
 
+#ifdef DEBUG_XEMACS
+#define KKCC_BT_STACK_SIZE 4096
+
+static struct
+{
+  void *obj;
+  const struct memory_description *desc;
+  int pos;
+} kkcc_bt[KKCC_BT_STACK_SIZE];
+
+static int kkcc_bt_depth = 0;
+
+#define KKCC_BT_INIT() kkcc_bt_depth = 0;
+
+void
+kkcc_backtrace (void)
+{
+  int i;
+  stderr_out ("KKCC mark stack backtrace :\n");
+  for (i = kkcc_bt_depth - 1; i >= 0; i--)
+    {
+      stderr_out (" [%d]", i);
+      if ((((struct lrecord_header *) kkcc_bt[i].obj)->type
+	   >= lrecord_type_free)
+	  || (!LRECORDP (kkcc_bt[i].obj))
+	  || (!XRECORD_LHEADER_IMPLEMENTATION (kkcc_bt[i].obj)))
+	{
+	  stderr_out (" non Lisp Object");
+	}
+      else
+	{
+	  stderr_out (" %s",
+		      XRECORD_LHEADER_IMPLEMENTATION (kkcc_bt[i].obj)->name);
+	}
+      stderr_out (" (addr: 0x%x, desc: 0x%x, ",
+		  (int) kkcc_bt[i].obj,
+		  (int) kkcc_bt[i].desc);
+      if (kkcc_bt[i].pos >= 0)
+	stderr_out ("pos: %d)\n", kkcc_bt[i].pos);
+      else
+	stderr_out ("root set)\n");
+    }
+}
+
+static void
+kkcc_bt_push (void *obj, const struct memory_description *desc, 
+	      int level, int pos)
+{
+  kkcc_bt_depth = level;
+  kkcc_bt[kkcc_bt_depth].obj = obj;
+  kkcc_bt[kkcc_bt_depth].desc = desc;
+  kkcc_bt[kkcc_bt_depth].pos = pos;
+  kkcc_bt_depth++;
+  if (kkcc_bt_depth > KKCC_BT_STACK_SIZE)
+    {
+      stderr_out ("KKCC backtrace overflow, adjust KKCC_BT_STACK_SIZE.\n");
+      stderr_out ("Maybe it is a loop?\n");
+      ABORT ();
+    }
+}
+
+#else /* not DEBUG_XEMACS */
+#define KKCC_BT_INIT()
+#define kkcc_bt_push(obj, desc, level, pos)
+#endif /* not DEBUG_XEMACS */
+
 static void
 kkcc_gc_stack_init (void)
 {
@@ -3359,14 +3433,31 @@
 #define KKCC_GC_STACK_EMPTY (kkcc_gc_stack_top < kkcc_gc_stack_ptr)
 
 static void
-kkcc_gc_stack_push (void *data, const struct memory_description *desc)
+#ifdef DEBUG_XEMACS
+kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc,
+		    int level, int pos)
+#else
+kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc)
+#endif
 {
   if (KKCC_GC_STACK_FULL)
       kkcc_gc_stack_realloc();
   kkcc_gc_stack_top++;
   kkcc_gc_stack_top->data = data;
   kkcc_gc_stack_top->desc = desc;
-}
+#ifdef DEBUG_XEMACS
+  kkcc_gc_stack_top->level = level;
+  kkcc_gc_stack_top->pos = pos;
+#endif
+}
+
+#ifdef DEBUG_XEMACS
+#define kkcc_gc_stack_push(data, desc, level, pos)	\
+  kkcc_gc_stack_push_1 (data, desc, level, pos)
+#else
+#define kkcc_gc_stack_push(data, desc, level, pos)	\
+  kkcc_gc_stack_push_1 (data, desc)
+#endif
 
 static kkcc_gc_stack_entry *
 kkcc_gc_stack_pop (void)
@@ -3378,7 +3469,11 @@
 }
 
 void
-kkcc_gc_stack_push_lisp_object (Lisp_Object obj)
+#ifdef DEBUG_XEMACS
+kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos)
+#else
+kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj)
+#endif
 {
   if (XTYPE (obj) == Lisp_Type_Record)
     {
@@ -3389,11 +3484,19 @@
       if (! MARKED_RECORD_HEADER_P (lheader)) 
 	{
 	  MARK_RECORD_HEADER (lheader);
-	  kkcc_gc_stack_push((void*) lheader, desc);
+	  kkcc_gc_stack_push((void*) lheader, desc, level, pos);
 	}
     }
 }
 
+#ifdef DEBUG_XEMACS
+#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
+  kkcc_gc_stack_push_lisp_object_1 (obj, level, pos)
+#else
+#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
+  kkcc_gc_stack_push_lisp_object_1 (obj)
+#endif
+
 #ifdef ERROR_CHECK_GC
 #define KKCC_DO_CHECK_FREE(obj, allow_free)			\
 do								\
@@ -3409,24 +3512,44 @@
 #endif
 
 #ifdef ERROR_CHECK_GC
+#ifdef DEBUG_XEMACS
 static void
-mark_object_maybe_checking_free (Lisp_Object obj, int allow_free)
+mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free,
+				 int level, int pos)
+#else
+static void
+mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free)
+#endif
 {
   KKCC_DO_CHECK_FREE (obj, allow_free);
-  kkcc_gc_stack_push_lisp_object (obj);
-}
+  kkcc_gc_stack_push_lisp_object (obj, level, pos);
+}
+
+#ifdef DEBUG_XEMACS
+#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
+  mark_object_maybe_checking_free_1 (obj, allow_free, level, pos)
 #else
-#define mark_object_maybe_checking_free(obj, allow_free) 	\
-      kkcc_gc_stack_push_lisp_object (obj)
-#endif /* ERROR_CHECK_GC */
+#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
+  mark_object_maybe_checking_free_1 (obj, allow_free)
+#endif
+#else /* not ERROR_CHECK_GC */
+#define mark_object_maybe_checking_free(obj, allow_free, level, pos) 	\
+  kkcc_gc_stack_push_lisp_object (obj, level, pos)
+#endif /* not ERROR_CHECK_GC */
 
 
 /* This function loops all elements of a struct pointer and calls 
    mark_with_description with each element. */
 static void
-mark_struct_contents (const void *data,
+#ifdef DEBUG_XEMACS
+mark_struct_contents_1 (const void *data,
+		      const struct sized_memory_description *sdesc,
+		      int count, int level, int pos)
+#else
+mark_struct_contents_1 (const void *data,
 		      const struct sized_memory_description *sdesc,
 		      int count)
+#endif
 {
   int i;
   Bytecount elsize;
@@ -3434,10 +3557,18 @@
 
   for (i = 0; i < count; i++)
     {
-      kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description);
+      kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description,
+			  level, pos);
     }
 }
 
+#ifdef DEBUG_XEMACS
+#define mark_struct_contents(data, sdesc, count, level, pos) \
+  mark_struct_contents_1 (data, sdesc, count, level, pos)
+#else
+#define mark_struct_contents(data, sdesc, count, level, pos) \
+  mark_struct_contents_1 (data, sdesc, count)
+#endif
 
 /* This function implements the KKCC mark algorithm.
    Instead of calling mark_object, all the alive Lisp_Objects are pushed
@@ -3450,11 +3581,20 @@
   void *data = 0;
   const struct memory_description *desc = 0;
   int pos;
+#ifdef DEBUG_XEMACS
+  int level = 0;
+  KKCC_BT_INIT ();
+#endif
   
   while ((stack_entry = kkcc_gc_stack_pop ()) != 0)
     {
       data = stack_entry->data;
       desc = stack_entry->desc;
+#ifdef DEBUG_XEMACS
+      level = stack_entry->level + 1;
+#endif
+
+      kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos);
 
       for (pos = 0; desc[pos].type != XD_END; pos++)
 	{
@@ -3493,8 +3633,8 @@
 		if (EQ (*stored_obj, Qnull_pointer))
 		  break;
 		mark_object_maybe_checking_free
-		  (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT);
-	    
+		  (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT,
+		   level, pos);
 		break;
 	      }
 	    case XD_LISP_OBJECT_ARRAY:
@@ -3510,9 +3650,9 @@
 
 		    if (EQ (*stored_obj, Qnull_pointer))
 		      break;
-
 		    mark_object_maybe_checking_free
-		      (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT);
+		      (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT,
+		       level, pos);
 		  }
 		break;
 	      }
@@ -3524,7 +3664,7 @@
 		  lispdesc_indirect_description (data, desc1->data2.descr);
 		const char *dobj = * (const char **) rdata;
 		if (dobj)
-		  mark_struct_contents (dobj, sdesc, count);
+		  mark_struct_contents (dobj, sdesc, count, level, pos);
 		break;
 	      }
 	    case XD_BLOCK_ARRAY:
@@ -3534,7 +3674,7 @@
 		const struct sized_memory_description *sdesc =
 		  lispdesc_indirect_description (data, desc1->data2.descr);
 		      
-		mark_struct_contents (rdata, sdesc, count);
+		mark_struct_contents (rdata, sdesc, count, level, pos);
 		break;
 	      }
 	    case XD_UNION:
@@ -3546,6 +3686,7 @@
 		    
 	    default:
 	      stderr_out ("Unsupported description type : %d\n", desc1->type);
+	      kkcc_backtrace ();
 	      ABORT ();
 	    }
 	}
@@ -4735,7 +4876,7 @@
 #ifdef USE_KKCC
   /* initialize kkcc stack */
   kkcc_gc_stack_init();
-#define mark_object kkcc_gc_stack_push_lisp_object
+#define mark_object(obj) kkcc_gc_stack_push_lisp_object (obj, 0, -1)
 #endif /* USE_KKCC */
 
   { /* staticpro() */
--- a/src/data.c	Thu Mar 10 09:05:52 2005 +0000
+++ b/src/data.c	Thu Mar 10 09:12:38 2005 +0000
@@ -2739,7 +2739,7 @@
 	  if (need_to_mark_elem && ! marked_p (elem))
 	    {
 #ifdef USE_KKCC
-	      kkcc_gc_stack_push_lisp_object (elem);
+	      kkcc_gc_stack_push_lisp_object (elem, 0, -1);
 #else /* NOT USE_KKCC */
 	      mark_object (elem);
 #endif /* NOT USE_KKCC */
@@ -2767,7 +2767,7 @@
       if (!NILP (rest2) && ! marked_p (rest2))
 	{
 #ifdef USE_KKCC
-	  kkcc_gc_stack_push_lisp_object (rest2);
+	  kkcc_gc_stack_push_lisp_object (rest2, 0, -1);
 #else /* NOT USE_KKCC */
 	  mark_object (rest2);
 #endif /* NOT USE_KKCC */
@@ -3148,7 +3148,7 @@
 	    {
 #ifdef USE_KKCC
 	      kkcc_gc_stack_push_lisp_object 
-	      (XCAR (XEPHEMERON (rest)->cons_chain));
+		(XCAR (XEPHEMERON (rest)->cons_chain), 0, -1);
 #else /* NOT USE_KKCC */
 	      mark_object (XCAR (XEPHEMERON (rest)->cons_chain));
 #endif /* NOT USE_KKCC */
@@ -3198,7 +3198,7 @@
 	      MARK_CONS (XCONS (XEPHEMERON (rest)->cons_chain));
 #ifdef USE_KKCC
 	      kkcc_gc_stack_push_lisp_object 
-	      (XCAR (XEPHEMERON (rest)->cons_chain));
+		(XCAR (XEPHEMERON (rest)->cons_chain), 0, -1);
 #else /* NOT USE_KKCC */
 	      mark_object (XCAR (XEPHEMERON (rest)->cons_chain));
 #endif /* NOT USE_KKCC */
--- a/src/elhash.c	Thu Mar 10 09:05:52 2005 +0000
+++ b/src/elhash.c	Thu Mar 10 09:12:38 2005 +0000
@@ -1460,13 +1460,13 @@
 /*		   garbage collecting weak hash tables			*/
 /************************************************************************/
 #ifdef USE_KKCC
-#define MARK_OBJ(obj) do {		       \
-  Lisp_Object mo_obj = (obj);		       \
-  if (!marked_p (mo_obj))		       \
-    {					       \
-      kkcc_gc_stack_push_lisp_object (mo_obj); \
-      did_mark = 1;			       \
-    }					       \
+#define MARK_OBJ(obj) do {				\
+  Lisp_Object mo_obj = (obj);				\
+  if (!marked_p (mo_obj))				\
+    {							\
+      kkcc_gc_stack_push_lisp_object (mo_obj, 0, -1);	\
+      did_mark = 1;					\
+    }							\
 } while (0)
 
 #else /* NO USE_KKCC */
--- a/src/lisp.h	Thu Mar 10 09:05:52 2005 +0000
+++ b/src/lisp.h	Thu Mar 10 09:12:38 2005 +0000
@@ -3585,7 +3585,17 @@
 int object_dead_p (Lisp_Object);
 void mark_object (Lisp_Object obj);
 #ifdef USE_KKCC
-void kkcc_gc_stack_push_lisp_object (Lisp_Object obj);
+#ifdef DEBUG_XEMACS
+void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos);
+#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
+  kkcc_gc_stack_push_lisp_object_1 (obj, level, pos)
+void kkcc_backtrace (void);
+#else
+void kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj);
+#define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
+  kkcc_gc_stack_push_lisp_object_1 (obj)
+#define kkcc_backtrace()
+#endif
 #endif /* USE_KKCC */
 int marked_p (Lisp_Object obj);
 extern int funcall_allocation_flag;
--- a/src/profile.c	Thu Mar 10 09:05:52 2005 +0000
+++ b/src/profile.c	Thu Mar 10 09:12:38 2005 +0000
@@ -609,7 +609,7 @@
 			     void *UNUSED (void_closure))
 {
 #ifdef USE_KKCC
-  kkcc_gc_stack_push_lisp_object (VOID_TO_LISP (void_key));
+  kkcc_gc_stack_push_lisp_object (VOID_TO_LISP (void_key), 0, -1);
 #else /* NOT USE_KKCC */
   mark_object (VOID_TO_LISP (void_key));
 #endif /* NOT USE_KKCC */