# HG changeset patch # User crestani # Date 1110445958 0 # Node ID e6854ec89f8ec2834c8aecdb72991b78daac3943 # Parent 0b4097b3552f1f1574da59dec7ec83dff00177bd [xemacs-hg @ 2005-03-10 09:12:36 by crestani] KKCC backtrace. 2005-03-01 Marcus Crestani * 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. diff -r 0b4097b3552f -r e6854ec89f8e src/ChangeLog --- 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 + + * 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 * Makefile.in.in (obj_src): Fix a typo in the PDUMP section diff -r 0b4097b3552f -r e6854ec89f8e src/alloc.c --- 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() */ diff -r 0b4097b3552f -r e6854ec89f8e src/data.c --- 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 */ diff -r 0b4097b3552f -r e6854ec89f8e src/elhash.c --- 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 */ diff -r 0b4097b3552f -r e6854ec89f8e src/lisp.h --- 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; diff -r 0b4097b3552f -r e6854ec89f8e src/profile.c --- 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 */