Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 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 9f70af3ac939
children fc554bcc59e7
comparison
equal deleted inserted replaced
2644:0b4097b3552f 2645:e6854ec89f8e
3089 count = * (long *) irdata; 3089 count = * (long *) irdata;
3090 break; 3090 break;
3091 default: 3091 default:
3092 stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n", 3092 stderr_out ("Unsupported count type : %d (line = %d, code = %ld)\n",
3093 idesc[line].type, line, (long) code); 3093 idesc[line].type, line, (long) code);
3094 #ifdef USE_KKCC
3095 if (gc_in_progress)
3096 kkcc_backtrace ();
3097 #endif
3094 #ifdef PDUMP 3098 #ifdef PDUMP
3095 if (in_pdump) 3099 if (in_pdump)
3096 pdump_backtrace (); 3100 pdump_backtrace ();
3097 #endif 3101 #endif
3098 count = 0; /* warning suppression */ 3102 count = 0; /* warning suppression */
3305 3309
3306 typedef struct 3310 typedef struct
3307 { 3311 {
3308 void *data; 3312 void *data;
3309 const struct memory_description *desc; 3313 const struct memory_description *desc;
3314 #ifdef DEBUG_XEMACS
3315 int level;
3316 int pos;
3317 #endif
3310 } kkcc_gc_stack_entry; 3318 } kkcc_gc_stack_entry;
3311 3319
3312 static kkcc_gc_stack_entry *kkcc_gc_stack_ptr; 3320 static kkcc_gc_stack_entry *kkcc_gc_stack_ptr;
3313 static kkcc_gc_stack_entry *kkcc_gc_stack_top; 3321 static kkcc_gc_stack_entry *kkcc_gc_stack_top;
3314 static kkcc_gc_stack_entry *kkcc_gc_stack_last_entry; 3322 static kkcc_gc_stack_entry *kkcc_gc_stack_last_entry;
3315 static int kkcc_gc_stack_size; 3323 static int kkcc_gc_stack_size;
3324
3325 #ifdef DEBUG_XEMACS
3326 #define KKCC_BT_STACK_SIZE 4096
3327
3328 static struct
3329 {
3330 void *obj;
3331 const struct memory_description *desc;
3332 int pos;
3333 } kkcc_bt[KKCC_BT_STACK_SIZE];
3334
3335 static int kkcc_bt_depth = 0;
3336
3337 #define KKCC_BT_INIT() kkcc_bt_depth = 0;
3338
3339 void
3340 kkcc_backtrace (void)
3341 {
3342 int i;
3343 stderr_out ("KKCC mark stack backtrace :\n");
3344 for (i = kkcc_bt_depth - 1; i >= 0; i--)
3345 {
3346 stderr_out (" [%d]", i);
3347 if ((((struct lrecord_header *) kkcc_bt[i].obj)->type
3348 >= lrecord_type_free)
3349 || (!LRECORDP (kkcc_bt[i].obj))
3350 || (!XRECORD_LHEADER_IMPLEMENTATION (kkcc_bt[i].obj)))
3351 {
3352 stderr_out (" non Lisp Object");
3353 }
3354 else
3355 {
3356 stderr_out (" %s",
3357 XRECORD_LHEADER_IMPLEMENTATION (kkcc_bt[i].obj)->name);
3358 }
3359 stderr_out (" (addr: 0x%x, desc: 0x%x, ",
3360 (int) kkcc_bt[i].obj,
3361 (int) kkcc_bt[i].desc);
3362 if (kkcc_bt[i].pos >= 0)
3363 stderr_out ("pos: %d)\n", kkcc_bt[i].pos);
3364 else
3365 stderr_out ("root set)\n");
3366 }
3367 }
3368
3369 static void
3370 kkcc_bt_push (void *obj, const struct memory_description *desc,
3371 int level, int pos)
3372 {
3373 kkcc_bt_depth = level;
3374 kkcc_bt[kkcc_bt_depth].obj = obj;
3375 kkcc_bt[kkcc_bt_depth].desc = desc;
3376 kkcc_bt[kkcc_bt_depth].pos = pos;
3377 kkcc_bt_depth++;
3378 if (kkcc_bt_depth > KKCC_BT_STACK_SIZE)
3379 {
3380 stderr_out ("KKCC backtrace overflow, adjust KKCC_BT_STACK_SIZE.\n");
3381 stderr_out ("Maybe it is a loop?\n");
3382 ABORT ();
3383 }
3384 }
3385
3386 #else /* not DEBUG_XEMACS */
3387 #define KKCC_BT_INIT()
3388 #define kkcc_bt_push(obj, desc, level, pos)
3389 #endif /* not DEBUG_XEMACS */
3316 3390
3317 static void 3391 static void
3318 kkcc_gc_stack_init (void) 3392 kkcc_gc_stack_init (void)
3319 { 3393 {
3320 kkcc_gc_stack_size = KKCC_INIT_GC_STACK_SIZE; 3394 kkcc_gc_stack_size = KKCC_INIT_GC_STACK_SIZE;
3357 3431
3358 #define KKCC_GC_STACK_FULL (kkcc_gc_stack_top >= kkcc_gc_stack_last_entry) 3432 #define KKCC_GC_STACK_FULL (kkcc_gc_stack_top >= kkcc_gc_stack_last_entry)
3359 #define KKCC_GC_STACK_EMPTY (kkcc_gc_stack_top < kkcc_gc_stack_ptr) 3433 #define KKCC_GC_STACK_EMPTY (kkcc_gc_stack_top < kkcc_gc_stack_ptr)
3360 3434
3361 static void 3435 static void
3362 kkcc_gc_stack_push (void *data, const struct memory_description *desc) 3436 #ifdef DEBUG_XEMACS
3437 kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc,
3438 int level, int pos)
3439 #else
3440 kkcc_gc_stack_push_1 (void *data, const struct memory_description *desc)
3441 #endif
3363 { 3442 {
3364 if (KKCC_GC_STACK_FULL) 3443 if (KKCC_GC_STACK_FULL)
3365 kkcc_gc_stack_realloc(); 3444 kkcc_gc_stack_realloc();
3366 kkcc_gc_stack_top++; 3445 kkcc_gc_stack_top++;
3367 kkcc_gc_stack_top->data = data; 3446 kkcc_gc_stack_top->data = data;
3368 kkcc_gc_stack_top->desc = desc; 3447 kkcc_gc_stack_top->desc = desc;
3369 } 3448 #ifdef DEBUG_XEMACS
3449 kkcc_gc_stack_top->level = level;
3450 kkcc_gc_stack_top->pos = pos;
3451 #endif
3452 }
3453
3454 #ifdef DEBUG_XEMACS
3455 #define kkcc_gc_stack_push(data, desc, level, pos) \
3456 kkcc_gc_stack_push_1 (data, desc, level, pos)
3457 #else
3458 #define kkcc_gc_stack_push(data, desc, level, pos) \
3459 kkcc_gc_stack_push_1 (data, desc)
3460 #endif
3370 3461
3371 static kkcc_gc_stack_entry * 3462 static kkcc_gc_stack_entry *
3372 kkcc_gc_stack_pop (void) 3463 kkcc_gc_stack_pop (void)
3373 { 3464 {
3374 if (KKCC_GC_STACK_EMPTY) 3465 if (KKCC_GC_STACK_EMPTY)
3376 kkcc_gc_stack_top--; 3467 kkcc_gc_stack_top--;
3377 return kkcc_gc_stack_top + 1; 3468 return kkcc_gc_stack_top + 1;
3378 } 3469 }
3379 3470
3380 void 3471 void
3381 kkcc_gc_stack_push_lisp_object (Lisp_Object obj) 3472 #ifdef DEBUG_XEMACS
3473 kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj, int level, int pos)
3474 #else
3475 kkcc_gc_stack_push_lisp_object_1 (Lisp_Object obj)
3476 #endif
3382 { 3477 {
3383 if (XTYPE (obj) == Lisp_Type_Record) 3478 if (XTYPE (obj) == Lisp_Type_Record)
3384 { 3479 {
3385 struct lrecord_header *lheader = XRECORD_LHEADER (obj); 3480 struct lrecord_header *lheader = XRECORD_LHEADER (obj);
3386 const struct memory_description *desc; 3481 const struct memory_description *desc;
3387 GC_CHECK_LHEADER_INVARIANTS (lheader); 3482 GC_CHECK_LHEADER_INVARIANTS (lheader);
3388 desc = RECORD_DESCRIPTION (lheader); 3483 desc = RECORD_DESCRIPTION (lheader);
3389 if (! MARKED_RECORD_HEADER_P (lheader)) 3484 if (! MARKED_RECORD_HEADER_P (lheader))
3390 { 3485 {
3391 MARK_RECORD_HEADER (lheader); 3486 MARK_RECORD_HEADER (lheader);
3392 kkcc_gc_stack_push((void*) lheader, desc); 3487 kkcc_gc_stack_push((void*) lheader, desc, level, pos);
3393 } 3488 }
3394 } 3489 }
3395 } 3490 }
3491
3492 #ifdef DEBUG_XEMACS
3493 #define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
3494 kkcc_gc_stack_push_lisp_object_1 (obj, level, pos)
3495 #else
3496 #define kkcc_gc_stack_push_lisp_object(obj, level, pos) \
3497 kkcc_gc_stack_push_lisp_object_1 (obj)
3498 #endif
3396 3499
3397 #ifdef ERROR_CHECK_GC 3500 #ifdef ERROR_CHECK_GC
3398 #define KKCC_DO_CHECK_FREE(obj, allow_free) \ 3501 #define KKCC_DO_CHECK_FREE(obj, allow_free) \
3399 do \ 3502 do \
3400 { \ 3503 { \
3407 #else 3510 #else
3408 #define KKCC_DO_CHECK_FREE(obj, allow_free) 3511 #define KKCC_DO_CHECK_FREE(obj, allow_free)
3409 #endif 3512 #endif
3410 3513
3411 #ifdef ERROR_CHECK_GC 3514 #ifdef ERROR_CHECK_GC
3515 #ifdef DEBUG_XEMACS
3412 static void 3516 static void
3413 mark_object_maybe_checking_free (Lisp_Object obj, int allow_free) 3517 mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free,
3518 int level, int pos)
3519 #else
3520 static void
3521 mark_object_maybe_checking_free_1 (Lisp_Object obj, int allow_free)
3522 #endif
3414 { 3523 {
3415 KKCC_DO_CHECK_FREE (obj, allow_free); 3524 KKCC_DO_CHECK_FREE (obj, allow_free);
3416 kkcc_gc_stack_push_lisp_object (obj); 3525 kkcc_gc_stack_push_lisp_object (obj, level, pos);
3417 } 3526 }
3527
3528 #ifdef DEBUG_XEMACS
3529 #define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
3530 mark_object_maybe_checking_free_1 (obj, allow_free, level, pos)
3418 #else 3531 #else
3419 #define mark_object_maybe_checking_free(obj, allow_free) \ 3532 #define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
3420 kkcc_gc_stack_push_lisp_object (obj) 3533 mark_object_maybe_checking_free_1 (obj, allow_free)
3421 #endif /* ERROR_CHECK_GC */ 3534 #endif
3535 #else /* not ERROR_CHECK_GC */
3536 #define mark_object_maybe_checking_free(obj, allow_free, level, pos) \
3537 kkcc_gc_stack_push_lisp_object (obj, level, pos)
3538 #endif /* not ERROR_CHECK_GC */
3422 3539
3423 3540
3424 /* This function loops all elements of a struct pointer and calls 3541 /* This function loops all elements of a struct pointer and calls
3425 mark_with_description with each element. */ 3542 mark_with_description with each element. */
3426 static void 3543 static void
3427 mark_struct_contents (const void *data, 3544 #ifdef DEBUG_XEMACS
3545 mark_struct_contents_1 (const void *data,
3546 const struct sized_memory_description *sdesc,
3547 int count, int level, int pos)
3548 #else
3549 mark_struct_contents_1 (const void *data,
3428 const struct sized_memory_description *sdesc, 3550 const struct sized_memory_description *sdesc,
3429 int count) 3551 int count)
3552 #endif
3430 { 3553 {
3431 int i; 3554 int i;
3432 Bytecount elsize; 3555 Bytecount elsize;
3433 elsize = lispdesc_block_size (data, sdesc); 3556 elsize = lispdesc_block_size (data, sdesc);
3434 3557
3435 for (i = 0; i < count; i++) 3558 for (i = 0; i < count; i++)
3436 { 3559 {
3437 kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description); 3560 kkcc_gc_stack_push (((char *) data) + elsize * i, sdesc->description,
3561 level, pos);
3438 } 3562 }
3439 } 3563 }
3440 3564
3565 #ifdef DEBUG_XEMACS
3566 #define mark_struct_contents(data, sdesc, count, level, pos) \
3567 mark_struct_contents_1 (data, sdesc, count, level, pos)
3568 #else
3569 #define mark_struct_contents(data, sdesc, count, level, pos) \
3570 mark_struct_contents_1 (data, sdesc, count)
3571 #endif
3441 3572
3442 /* This function implements the KKCC mark algorithm. 3573 /* This function implements the KKCC mark algorithm.
3443 Instead of calling mark_object, all the alive Lisp_Objects are pushed 3574 Instead of calling mark_object, all the alive Lisp_Objects are pushed
3444 on the kkcc_gc_stack. This function processes all elements on the stack 3575 on the kkcc_gc_stack. This function processes all elements on the stack
3445 according to their descriptions. */ 3576 according to their descriptions. */
3448 { 3579 {
3449 kkcc_gc_stack_entry *stack_entry = 0; 3580 kkcc_gc_stack_entry *stack_entry = 0;
3450 void *data = 0; 3581 void *data = 0;
3451 const struct memory_description *desc = 0; 3582 const struct memory_description *desc = 0;
3452 int pos; 3583 int pos;
3584 #ifdef DEBUG_XEMACS
3585 int level = 0;
3586 KKCC_BT_INIT ();
3587 #endif
3453 3588
3454 while ((stack_entry = kkcc_gc_stack_pop ()) != 0) 3589 while ((stack_entry = kkcc_gc_stack_pop ()) != 0)
3455 { 3590 {
3456 data = stack_entry->data; 3591 data = stack_entry->data;
3457 desc = stack_entry->desc; 3592 desc = stack_entry->desc;
3593 #ifdef DEBUG_XEMACS
3594 level = stack_entry->level + 1;
3595 #endif
3596
3597 kkcc_bt_push (data, desc, stack_entry->level, stack_entry->pos);
3458 3598
3459 for (pos = 0; desc[pos].type != XD_END; pos++) 3599 for (pos = 0; desc[pos].type != XD_END; pos++)
3460 { 3600 {
3461 const struct memory_description *desc1 = &desc[pos]; 3601 const struct memory_description *desc1 = &desc[pos];
3462 const void *rdata = 3602 const void *rdata =
3491 can be used for untagged pointers. They might be NULL, 3631 can be used for untagged pointers. They might be NULL,
3492 though. */ 3632 though. */
3493 if (EQ (*stored_obj, Qnull_pointer)) 3633 if (EQ (*stored_obj, Qnull_pointer))
3494 break; 3634 break;
3495 mark_object_maybe_checking_free 3635 mark_object_maybe_checking_free
3496 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT); 3636 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT,
3497 3637 level, pos);
3498 break; 3638 break;
3499 } 3639 }
3500 case XD_LISP_OBJECT_ARRAY: 3640 case XD_LISP_OBJECT_ARRAY:
3501 { 3641 {
3502 int i; 3642 int i;
3508 const Lisp_Object *stored_obj = 3648 const Lisp_Object *stored_obj =
3509 (const Lisp_Object *) rdata + i; 3649 (const Lisp_Object *) rdata + i;
3510 3650
3511 if (EQ (*stored_obj, Qnull_pointer)) 3651 if (EQ (*stored_obj, Qnull_pointer))
3512 break; 3652 break;
3513
3514 mark_object_maybe_checking_free 3653 mark_object_maybe_checking_free
3515 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT); 3654 (*stored_obj, (desc1->flags) & XD_FLAG_FREE_LISP_OBJECT,
3655 level, pos);
3516 } 3656 }
3517 break; 3657 break;
3518 } 3658 }
3519 case XD_BLOCK_PTR: 3659 case XD_BLOCK_PTR:
3520 { 3660 {
3522 data); 3662 data);
3523 const struct sized_memory_description *sdesc = 3663 const struct sized_memory_description *sdesc =
3524 lispdesc_indirect_description (data, desc1->data2.descr); 3664 lispdesc_indirect_description (data, desc1->data2.descr);
3525 const char *dobj = * (const char **) rdata; 3665 const char *dobj = * (const char **) rdata;
3526 if (dobj) 3666 if (dobj)
3527 mark_struct_contents (dobj, sdesc, count); 3667 mark_struct_contents (dobj, sdesc, count, level, pos);
3528 break; 3668 break;
3529 } 3669 }
3530 case XD_BLOCK_ARRAY: 3670 case XD_BLOCK_ARRAY:
3531 { 3671 {
3532 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc, 3672 EMACS_INT count = lispdesc_indirect_count (desc1->data1, desc,
3533 data); 3673 data);
3534 const struct sized_memory_description *sdesc = 3674 const struct sized_memory_description *sdesc =
3535 lispdesc_indirect_description (data, desc1->data2.descr); 3675 lispdesc_indirect_description (data, desc1->data2.descr);
3536 3676
3537 mark_struct_contents (rdata, sdesc, count); 3677 mark_struct_contents (rdata, sdesc, count, level, pos);
3538 break; 3678 break;
3539 } 3679 }
3540 case XD_UNION: 3680 case XD_UNION:
3541 case XD_UNION_DYNAMIC_SIZE: 3681 case XD_UNION_DYNAMIC_SIZE:
3542 desc1 = lispdesc_process_xd_union (desc1, desc, data); 3682 desc1 = lispdesc_process_xd_union (desc1, desc, data);
3544 goto union_switcheroo; 3684 goto union_switcheroo;
3545 break; 3685 break;
3546 3686
3547 default: 3687 default:
3548 stderr_out ("Unsupported description type : %d\n", desc1->type); 3688 stderr_out ("Unsupported description type : %d\n", desc1->type);
3689 kkcc_backtrace ();
3549 ABORT (); 3690 ABORT ();
3550 } 3691 }
3551 } 3692 }
3552 } 3693 }
3553 } 3694 }
4733 /* Mark all the special slots that serve as the roots of accessibility. */ 4874 /* Mark all the special slots that serve as the roots of accessibility. */
4734 4875
4735 #ifdef USE_KKCC 4876 #ifdef USE_KKCC
4736 /* initialize kkcc stack */ 4877 /* initialize kkcc stack */
4737 kkcc_gc_stack_init(); 4878 kkcc_gc_stack_init();
4738 #define mark_object kkcc_gc_stack_push_lisp_object 4879 #define mark_object(obj) kkcc_gc_stack_push_lisp_object (obj, 0, -1)
4739 #endif /* USE_KKCC */ 4880 #endif /* USE_KKCC */
4740 4881
4741 { /* staticpro() */ 4882 { /* staticpro() */
4742 Lisp_Object **p = Dynarr_begin (staticpros); 4883 Lisp_Object **p = Dynarr_begin (staticpros);
4743 Elemcount count; 4884 Elemcount count;