[PATCH] KKCC backtrace

I added some backtrace functionality to the KKCC mark algorithm. This simplifies debugging of the gc mark phase. For example, if an invalid memory description type occurs, a backtrace like this is printed to stderr: KKCC mark stack backtrace : [62] ephemeron (addr: 0x88d4ce0, desc: 0x8281ea0, pos: 2) [61] hash-table (addr: 0x88d2288, desc: 0x8281f60, pos: 2) [60] keymap (addr: 0x88d2258, desc: 0x8297b20, pos: 2) [59] symbol (addr: 0x88ce904, desc: 0x82a5e80, pos: 1) [58] vector (addr: 0x88d3278, desc: 0x8277640, pos: 3) [57] compiled-function (addr: 0x88d11a4, desc: 0x827b1e0, pos: 3) ... snip ... [5] cons (addr: 0x87f79e8, desc: 0x8277520, pos: 0) [4] cons (addr: 0x87f79f4, desc: 0x8277520, pos: 1) [3] cons (addr: 0x87f7988, desc: 0x8277520, pos: 0) [2] cons (addr: 0x87f7994, desc: 0x8277520, pos: 1) [1] cons (addr: 0x87f79a0, desc: 0x8277520, pos: 4) [0] symbol (addr: 0x872f3dc, desc: 0x82a5e80, root set) I'll commit this in a few days, if no one objects. src/ChangeLog addition: 2005-03-01 Marcus Crestani <crestani(a)informatik.uni-tuebingen.de&gt; * 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. xemacs-21.5 source patch: Diff command: cvs -q diff -u Files affected: src/profile.c src/lisp.h src/elhash.c src/data.c src/alloc.c Index: src/alloc.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v retrieving revision 1.106 diff -u -r1.106 alloc.c --- src/alloc.c 3 Feb 2005 16:14:04 -0000 1.106 +++ src/alloc.c 2 Mar 2005 21:58:19 -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,8 ＠＠ { void *data; const struct memory_description *desc; + int level; + int pos; } kkcc_gc_stack_entry; static kkcc_gc_stack_entry *kkcc_gc_stack_ptr; ＠＠ -3314,6 +3320,73 ＠＠ static kkcc_gc_stack_entry *kkcc_gc_stack_last_entry; static int kkcc_gc_stack_size; +#ifdef ERROR_CHECK_GC +#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 ERROR_CHECK_GC */ +#define KKCC_BT_INIT() +#define kkcc_backtrace() +#define kkcc_bt_push(obj, desc, level, pos) +#endif /* not ERROR_CHECK_GC */ + static void kkcc_gc_stack_init (void) { ＠＠ -3359,13 +3432,16 ＠＠ #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) +kkcc_gc_stack_push (void *data, const struct memory_description *desc, + int level, int pos) { 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; + kkcc_gc_stack_top->level = level; + kkcc_gc_stack_top->pos = pos; } static kkcc_gc_stack_entry * ＠＠ -3378,7 +3454,7 ＠＠ } void -kkcc_gc_stack_push_lisp_object (Lisp_Object obj) +kkcc_gc_stack_push_lisp_object (Lisp_Object obj, int level, int pos) { if (XTYPE (obj) == Lisp_Type_Record) { ＠＠ -3389,7 +3465,7 ＠＠ 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); } } } ＠＠ -3410,14 +3486,15 ＠＠ #ifdef ERROR_CHECK_GC static void -mark_object_maybe_checking_free (Lisp_Object obj, int allow_free) +mark_object_maybe_checking_free (Lisp_Object obj, int allow_free, + int level, int pos) { KKCC_DO_CHECK_FREE (obj, allow_free); - kkcc_gc_stack_push_lisp_object (obj); + kkcc_gc_stack_push_lisp_object (obj, level, pos); } #else -#define mark_object_maybe_checking_free(obj, allow_free) \ - kkcc_gc_stack_push_lisp_object (obj) +#define mark_object_maybe_checking_free(obj, allow_free, level, pos) \ + kkcc_gc_stack_push_lisp_object (obj, level, pos) #endif /* ERROR_CHECK_GC */ ＠＠ -3426,7 +3503,7 ＠＠ static void mark_struct_contents (const void *data, const struct sized_memory_description *sdesc, - int count) + int count, int level, int pos) { int i; Bytecount elsize; ＠＠ -3434,7 +3511,8 ＠＠ 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); } } ＠＠ -3449,12 +3527,17 ＠＠ kkcc_gc_stack_entry *stack_entry = 0; void *data = 0; const struct memory_description *desc = 0; + int level = 0; int pos; + KKCC_BT_INIT (); while ((stack_entry = kkcc_gc_stack_pop ()) != 0) { data = stack_entry->data; desc = stack_entry->desc; + level = stack_entry->level + 1; + + kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos); for (pos = 0; desc[pos].type != XD_END; pos++) { ＠＠ -3493,7 +3576,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; } ＠＠ -3510,9 +3594,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 +3608,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 +3618,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 +3630,7 ＠＠ default: stderr_out ("Unsupported description type : %d\n", desc1->type); + kkcc_backtrace (); ABORT (); } } ＠＠ -4735,7 +4820,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() */ Index: src/data.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/data.c,v retrieving revision 1.62 diff -u -r1.62 data.c --- src/data.c 3 Feb 2005 16:14:04 -0000 1.62 +++ src/data.c 2 Mar 2005 21:58:21 -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 */ Index: src/elhash.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/elhash.c,v retrieving revision 1.40 diff -u -r1.40 elhash.c --- src/elhash.c 3 Feb 2005 16:14:05 -0000 1.40 +++ src/elhash.c 2 Mar 2005 21:58:22 -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 */ Index: src/lisp.h =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v retrieving revision 1.124 diff -u -r1.124 lisp.h --- src/lisp.h 3 Feb 2005 16:30:37 -0000 1.124 +++ src/lisp.h 2 Mar 2005 21:58:26 -0000 ＠＠ -3585,7 +3585,10 ＠＠ 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); +void kkcc_gc_stack_push_lisp_object (Lisp_Object obj, int level, int pos); +#ifdef ERROR_CHECK_GC +void kkcc_backtrace (void); +#endif #endif /* USE_KKCC */ int marked_p (Lisp_Object obj); extern int funcall_allocation_flag; Index: src/profile.c =================================================================== RCS file: /pack/xemacscvs/XEmacs/xemacs/src/profile.c,v retrieving revision 1.24 diff -u -r1.24 profile.c --- src/profile.c 3 Feb 2005 16:14:08 -0000 1.24 +++ src/profile.c 2 Mar 2005 21:58:27 -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 */ -- Marcus