Re: [S21.5] KKCC backtrace

SUPERSEDES <200503030215.50827.crestani(a)informatik.uni-tuebingen.de&gt; Now the whole backtrace code is conditioned on DEBUG_XEMACS. 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. kkcc-bt-test 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 7 Mar 2005 17:19:20 -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,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,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() */ 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 7 Mar 2005 17:19:22 -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 7 Mar 2005 17:19:23 -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 7 Mar 2005 17:19:27 -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; 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 7 Mar 2005 17:19:28 -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