9:12 a.m.
User: crestani
Date: 05/03/10 10:12:41
Modified: xemacs/src ChangeLog alloc.c data.c elhash.c lisp.h
profile.c
Log:
KKCC backtrace.
2005-03-01 Marcus Crestani <crestani(a)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.
Revision Changes Path
1.805 +21 -0 XEmacs/xemacs/src/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.804
retrieving revision 1.805
diff -u -r1.804 -r1.805
--- ChangeLog 2005/03/10 09:05:44 1.804
+++ ChangeLog 2005/03/10 09:12:36 1.805
＠＠ -1,3 +1,24 ＠＠
+2005-03-01 Marcus Crestani <crestani(a)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(a)arbortext.com>
* Makefile.in.in (obj_src): Fix a typo in the PDUMP section
1.107 +158 -17 XEmacs/xemacs/src/alloc.c
Index: alloc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v
retrieving revision 1.106
retrieving revision 1.107
diff -u -r1.106 -r1.107
--- alloc.c 2005/02/03 16:14:04 1.106
+++ alloc.c 2005/03/10 09:12:37 1.107
＠＠ -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,15 +3433,32 ＠＠
#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_1 (Lisp_Object obj, int allow_free,
+ int level, int pos)
+#else
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)
+#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,12 +3581,21 ＠＠
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++)
{
const struct memory_description *desc1 = &desc[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() */
1.63 +4 -4 XEmacs/xemacs/src/data.c
Index: data.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/data.c,v
retrieving revision 1.62
retrieving revision 1.63
diff -u -r1.62 -r1.63
--- data.c 2005/02/03 16:14:04 1.62
+++ data.c 2005/03/10 09:12:38 1.63
＠＠ -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 */
1.41 +7 -7 XEmacs/xemacs/src/elhash.c
Index: elhash.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/elhash.c,v
retrieving revision 1.40
retrieving revision 1.41
diff -u -r1.40 -r1.41
--- elhash.c 2005/02/03 16:14:05 1.40
+++ elhash.c 2005/03/10 09:12:38 1.41
＠＠ -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 */
1.125 +11 -1 XEmacs/xemacs/src/lisp.h
Index: lisp.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v
retrieving revision 1.124
retrieving revision 1.125
diff -u -r1.124 -r1.125
--- lisp.h 2005/02/03 16:30:37 1.124
+++ lisp.h 2005/03/10 09:12:38 1.125
＠＠ -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;
1.25 +1 -1 XEmacs/xemacs/src/profile.c
Index: profile.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/profile.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- profile.c 2005/02/03 16:14:08 1.24
+++ profile.c 2005/03/10 09:12:38 1.25
＠＠ -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 */