Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 5126:2a462149bd6a ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 19:04:27 -0600
parents b5df3737028a 151d425f8ef0
children a9c41067dd88
comparison
equal deleted inserted replaced
5125:b5df3737028a 5126:2a462149bd6a
1183 ADDITIONAL_FREE_##type (FFT_ptr); \ 1183 ADDITIONAL_FREE_##type (FFT_ptr); \
1184 deadbeef_memory (FFT_ptr, sizeof (structtype)); \ 1184 deadbeef_memory (FFT_ptr, sizeof (structtype)); \
1185 PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, FFT_ptr); \ 1185 PUT_FIXED_TYPE_ON_FREE_LIST (type, structtype, FFT_ptr); \
1186 MARK_LRECORD_AS_FREE (FFT_ptr); \ 1186 MARK_LRECORD_AS_FREE (FFT_ptr); \
1187 } while (0) 1187 } while (0)
1188 1188 #endif /* NEW_GC */
1189
1190 #ifdef NEW_GC
1191 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr) \
1192 free_lrecord (lo)
1193 #else /* not NEW_GC */
1189 /* Like FREE_FIXED_TYPE() but used when we are explicitly 1194 /* Like FREE_FIXED_TYPE() but used when we are explicitly
1190 freeing a structure through free_cons(), free_marker(), etc. 1195 freeing a structure through free_cons(), free_marker(), etc.
1191 rather than through the normal process of sweeping. 1196 rather than through the normal process of sweeping.
1192 We attempt to undo the changes made to the allocation counters 1197 We attempt to undo the changes made to the allocation counters
1193 as a result of this structure being allocated. This is not 1198 as a result of this structure being allocated. This is not
1198 1203
1199 We also disable this mechanism entirely when ALLOC_NO_POOLS is 1204 We also disable this mechanism entirely when ALLOC_NO_POOLS is
1200 set, which is used for Purify and the like. */ 1205 set, which is used for Purify and the like. */
1201 1206
1202 #ifndef ALLOC_NO_POOLS 1207 #ifndef ALLOC_NO_POOLS
1203 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) \ 1208 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr) \
1204 do { FREE_FIXED_TYPE (type, structtype, ptr); \ 1209 do { FREE_FIXED_TYPE (type, structtype, ptr); \
1205 DECREMENT_CONS_COUNTER (sizeof (structtype)); \ 1210 DECREMENT_CONS_COUNTER (sizeof (structtype)); \
1206 gc_count_num_##type##_freelist++; \ 1211 gc_count_num_##type##_freelist++; \
1207 } while (0) 1212 } while (0)
1208 #else 1213 #else
1209 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(type, structtype, ptr) 1214 #define FREE_FIXED_TYPE_WHEN_NOT_IN_GC(lo, type, structtype, ptr)
1210 #endif 1215 #endif
1211 #endif /* NEW_GC */ 1216 #endif /* (not) NEW_GC */
1212 1217
1213 #ifdef NEW_GC 1218 #ifdef NEW_GC
1214 #define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr)\ 1219 #define ALLOCATE_FIXED_TYPE_AND_SET_IMPL(type, lisp_type, var, lrec_ptr)\
1215 do { \ 1220 do { \
1216 (var) = (lisp_type *) XPNTR (ALLOC_LISP_OBJECT (type)); \ 1221 (var) = (lisp_type *) XPNTR (ALLOC_LISP_OBJECT (type)); \
3461 { 3466 {
3462 Dynarr_add (mcpros, varaddress); 3467 Dynarr_add (mcpros, varaddress);
3463 Dynarr_add (mcpro_names, varname); 3468 Dynarr_add (mcpro_names, varname);
3464 } 3469 }
3465 3470
3471 const Ascbyte *mcpro_name (int count);
3472
3466 /* External debugging function: Return the name of the variable at offset 3473 /* External debugging function: Return the name of the variable at offset
3467 COUNT. */ 3474 COUNT. */
3468 const Ascbyte * 3475 const Ascbyte *
3469 mcpro_name (int count) 3476 mcpro_name (int count)
3470 { 3477 {
3502 int instances_in_use; 3509 int instances_in_use;
3503 int bytes_in_use; 3510 int bytes_in_use;
3504 int instances_freed; 3511 int instances_freed;
3505 int bytes_freed; 3512 int bytes_freed;
3506 int instances_on_free_list; 3513 int instances_on_free_list;
3507 } lcrecord_stats [countof (lrecord_implementations_table)]; 3514 int bytes_on_free_list;
3508 3515 } lrecord_stats [countof (lrecord_implementations_table)];
3509 static void 3516
3517 void
3518 tick_lrecord_stats (const struct lrecord_header *h,
3519 enum lrecord_alloc_status status)
3520 {
3521 int type_index = h->type;
3522 Bytecount sz = detagged_lisp_object_size (h);
3523
3524 switch (status)
3525 {
3526 case ALLOC_IN_USE:
3527 lrecord_stats[type_index].instances_in_use++;
3528 lrecord_stats[type_index].bytes_in_use += sz;
3529 break;
3530 case ALLOC_FREE:
3531 lrecord_stats[type_index].instances_freed++;
3532 lrecord_stats[type_index].bytes_freed += sz;
3533 break;
3534 case ALLOC_ON_FREE_LIST:
3535 lrecord_stats[type_index].instances_on_free_list++;
3536 lrecord_stats[type_index].bytes_on_free_list += sz;
3537 break;
3538 default:
3539 ABORT ();
3540 }
3541 }
3542
3543 inline static void
3510 tick_lcrecord_stats (const struct lrecord_header *h, int free_p) 3544 tick_lcrecord_stats (const struct lrecord_header *h, int free_p)
3511 { 3545 {
3512 int type_index = h->type;
3513
3514 if (((struct old_lcrecord_header *) h)->free) 3546 if (((struct old_lcrecord_header *) h)->free)
3515 { 3547 {
3516 gc_checking_assert (!free_p); 3548 gc_checking_assert (!free_p);
3517 lcrecord_stats[type_index].instances_on_free_list++; 3549 tick_lrecord_stats (h, ALLOC_ON_FREE_LIST);
3518 } 3550 }
3519 else 3551 else
3520 { 3552 tick_lrecord_stats (h, free_p ? ALLOC_FREE : ALLOC_IN_USE);
3521 Bytecount sz = detagged_lisp_object_size (h);
3522
3523 if (free_p)
3524 {
3525 lcrecord_stats[type_index].instances_freed++;
3526 lcrecord_stats[type_index].bytes_freed += sz;
3527 }
3528 else
3529 {
3530 lcrecord_stats[type_index].instances_in_use++;
3531 lcrecord_stats[type_index].bytes_in_use += sz;
3532 }
3533 }
3534 } 3553 }
3535 #endif /* not NEW_GC */ 3554 #endif /* not NEW_GC */
3536 3555
3537 3556
3538 #ifndef NEW_GC 3557 #ifndef NEW_GC
3541 sweep_lcrecords_1 (struct old_lcrecord_header **prev, int *used) 3560 sweep_lcrecords_1 (struct old_lcrecord_header **prev, int *used)
3542 { 3561 {
3543 struct old_lcrecord_header *header; 3562 struct old_lcrecord_header *header;
3544 int num_used = 0; 3563 int num_used = 0;
3545 /* int total_size = 0; */ 3564 /* int total_size = 0; */
3546
3547 xzero (lcrecord_stats); /* Reset all statistics to 0. */
3548 3565
3549 /* First go through and call all the finalize methods. 3566 /* First go through and call all the finalize methods.
3550 Then go through and free the objects. There used to 3567 Then go through and free the objects. There used to
3551 be only one loop here, with the call to the finalizer 3568 be only one loop here, with the call to the finalizer
3552 occurring directly before the xfree() below. That 3569 occurring directly before the xfree() below. That
3597 /* *total = total_size; */ 3614 /* *total = total_size; */
3598 } 3615 }
3599 3616
3600 /* And the Lord said: Thou shalt use the `c-backslash-region' command 3617 /* And the Lord said: Thou shalt use the `c-backslash-region' command
3601 to make macros prettier. */ 3618 to make macros prettier. */
3619
3620 #define COUNT_FROB_BLOCK_USAGE(type) \
3621 EMACS_INT s = 0; \
3622 struct type##_block *x = current_##type##_block; \
3623 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \
3624 DO_NOTHING
3625
3626 #define COPY_INTO_LRECORD_STATS(type) \
3627 do { \
3628 COUNT_FROB_BLOCK_USAGE (type); \
3629 lrecord_stats[lrecord_type_##type].bytes_in_use += s; \
3630 lrecord_stats[lrecord_type_##type].instances_on_free_list += \
3631 gc_count_num_##type##_freelist; \
3632 lrecord_stats[lrecord_type_##type].instances_in_use += \
3633 gc_count_num_##type##_in_use; \
3634 } while (0)
3602 3635
3603 #ifdef ERROR_CHECK_GC 3636 #ifdef ERROR_CHECK_GC
3604 3637
3605 #define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader) \ 3638 #define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader) \
3606 do { \ 3639 do { \
3642 SFTB_limit = countof (current_##typename##_block->block); \ 3675 SFTB_limit = countof (current_##typename##_block->block); \
3643 } \ 3676 } \
3644 \ 3677 \
3645 gc_count_num_##typename##_in_use = num_used; \ 3678 gc_count_num_##typename##_in_use = num_used; \
3646 gc_count_num_##typename##_freelist = num_free; \ 3679 gc_count_num_##typename##_freelist = num_free; \
3680 COPY_INTO_LRECORD_STATS (typename); \
3647 } while (0) 3681 } while (0)
3648 3682
3649 #else /* !ERROR_CHECK_GC */ 3683 #else /* !ERROR_CHECK_GC */
3650 3684
3651 #define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader) \ 3685 #define SWEEP_FIXED_TYPE_BLOCK_1(typename, obj_type, lheader) \
3652 do { \ 3686 do { \
3653 struct typename##_block *SFTB_current; \ 3687 struct typename##_block *SFTB_current; \
3654 struct typename##_block **SFTB_prev; \ 3688 struct typename##_block **SFTB_prev; \
3655 int SFTB_limit; \ 3689 int SFTB_limit; \
3656 int num_free = 0, num_used = 0; \ 3690 int num_free = 0, num_used = 0; \
3657 \ 3691 \
3658 typename##_free_list = 0; \ 3692 typename##_free_list = 0; \
3659 \ 3693 \
3660 for (SFTB_prev = &current_##typename##_block, \ 3694 for (SFTB_prev = &current_##typename##_block, \
3661 SFTB_current = current_##typename##_block, \ 3695 SFTB_current = current_##typename##_block, \
3662 SFTB_limit = current_##typename##_block_index; \ 3696 SFTB_limit = current_##typename##_block_index; \
3663 SFTB_current; \ 3697 SFTB_current; \
3664 ) \ 3698 ) \
3665 { \ 3699 { \
3666 int SFTB_iii; \ 3700 int SFTB_iii; \
3667 int SFTB_empty = 1; \ 3701 int SFTB_empty = 1; \
3668 Lisp_Free *SFTB_old_free_list = typename##_free_list; \ 3702 Lisp_Free *SFTB_old_free_list = typename##_free_list; \
3669 \ 3703 \
3670 for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++) \ 3704 for (SFTB_iii = 0; SFTB_iii < SFTB_limit; SFTB_iii++) \
3671 { \ 3705 { \
3672 obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]); \ 3706 obj_type *SFTB_victim = &(SFTB_current->block[SFTB_iii]); \
3673 \ 3707 \
3674 if (LRECORD_FREE_P (SFTB_victim)) \ 3708 if (LRECORD_FREE_P (SFTB_victim)) \
3675 { \ 3709 { \
3676 num_free++; \ 3710 num_free++; \
3677 PUT_FIXED_TYPE_ON_FREE_LIST (typename, obj_type, SFTB_victim); \ 3711 PUT_FIXED_TYPE_ON_FREE_LIST (typename, obj_type, SFTB_victim); \
3678 } \ 3712 } \
3679 else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \ 3713 else if (C_READONLY_RECORD_HEADER_P (&SFTB_victim->lheader)) \
3680 { \ 3714 { \
3681 SFTB_empty = 0; \ 3715 SFTB_empty = 0; \
3682 num_used++; \ 3716 num_used++; \
3683 } \ 3717 } \
3684 else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \ 3718 else if (! MARKED_RECORD_HEADER_P (&SFTB_victim->lheader)) \
3685 { \ 3719 { \
3686 num_free++; \ 3720 num_free++; \
3687 FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \ 3721 FREE_FIXED_TYPE (typename, obj_type, SFTB_victim); \
3688 } \ 3722 } \
3689 else \ 3723 else \
3690 { \ 3724 { \
3691 SFTB_empty = 0; \ 3725 SFTB_empty = 0; \
3692 num_used++; \ 3726 num_used++; \
3693 UNMARK_##typename (SFTB_victim); \ 3727 UNMARK_##typename (SFTB_victim); \
3694 } \ 3728 } \
3695 } \ 3729 } \
3696 if (!SFTB_empty) \ 3730 if (!SFTB_empty) \
3697 { \ 3731 { \
3698 SFTB_prev = &(SFTB_current->prev); \ 3732 SFTB_prev = &(SFTB_current->prev); \
3699 SFTB_current = SFTB_current->prev; \ 3733 SFTB_current = SFTB_current->prev; \
3700 } \ 3734 } \
3701 else if (SFTB_current == current_##typename##_block \ 3735 else if (SFTB_current == current_##typename##_block \
3702 && !SFTB_current->prev) \ 3736 && !SFTB_current->prev) \
3703 { \ 3737 { \
3704 /* No real point in freeing sole allocation block */ \ 3738 /* No real point in freeing sole allocation block */ \
3705 break; \ 3739 break; \
3706 } \ 3740 } \
3707 else \ 3741 else \
3708 { \ 3742 { \
3709 struct typename##_block *SFTB_victim_block = SFTB_current; \ 3743 struct typename##_block *SFTB_victim_block = SFTB_current; \
3710 if (SFTB_victim_block == current_##typename##_block) \ 3744 if (SFTB_victim_block == current_##typename##_block) \
3711 current_##typename##_block_index \ 3745 current_##typename##_block_index \
3712 = countof (current_##typename##_block->block); \ 3746 = countof (current_##typename##_block->block); \
3713 SFTB_current = SFTB_current->prev; \ 3747 SFTB_current = SFTB_current->prev; \
3714 { \ 3748 { \
3715 *SFTB_prev = SFTB_current; \ 3749 *SFTB_prev = SFTB_current; \
3716 xfree (SFTB_victim_block); \ 3750 xfree (SFTB_victim_block); \
3717 /* Restore free list to what it was before victim was swept */ \ 3751 /* Restore free list to what it was before victim was swept */ \
3718 typename##_free_list = SFTB_old_free_list; \ 3752 typename##_free_list = SFTB_old_free_list; \
3719 num_free -= SFTB_limit; \ 3753 num_free -= SFTB_limit; \
3720 } \ 3754 } \
3721 } \ 3755 } \
3722 SFTB_limit = countof (current_##typename##_block->block); \ 3756 SFTB_limit = countof (current_##typename##_block->block); \
3723 } \ 3757 } \
3724 \ 3758 \
3725 gc_count_num_##typename##_in_use = num_used; \ 3759 gc_count_num_##typename##_in_use = num_used; \
3726 gc_count_num_##typename##_freelist = num_free; \ 3760 gc_count_num_##typename##_freelist = num_free; \
3761 COPY_INTO_LRECORD_STATS (typename); \
3727 } while (0) 3762 } while (0)
3728 3763
3729 #endif /* !ERROR_CHECK_GC */ 3764 #endif /* !ERROR_CHECK_GC */
3730 3765
3731 #define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \ 3766 #define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type) \
3769 well as a check in FREE_FIXED_TYPE(). */ 3804 well as a check in FREE_FIXED_TYPE(). */
3770 if (POINTER_TYPE_P (XTYPE (cons_car (ptr)))) 3805 if (POINTER_TYPE_P (XTYPE (cons_car (ptr))))
3771 ASSERT_VALID_POINTER (XPNTR (cons_car (ptr))); 3806 ASSERT_VALID_POINTER (XPNTR (cons_car (ptr)));
3772 #endif /* ERROR_CHECK_GC */ 3807 #endif /* ERROR_CHECK_GC */
3773 3808
3774 #ifdef NEW_GC 3809 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, cons, Lisp_Cons, ptr);
3775 free_lrecord (cons);
3776 #else /* not NEW_GC */
3777 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (cons, Lisp_Cons, ptr);
3778 #endif /* not NEW_GC */
3779 } 3810 }
3780 3811
3781 /* explicitly free a list. You **must make sure** that you have 3812 /* explicitly free a list. You **must make sure** that you have
3782 created all the cons cells that make up this list and that there 3813 created all the cons cells that make up this list and that there
3783 are no pointers to any of these cons cells anywhere else. If there 3814 are no pointers to any of these cons cells anywhere else. If there
3908 #endif /* not NEW_GC */ 3939 #endif /* not NEW_GC */
3909 3940
3910 void 3941 void
3911 free_key_data (Lisp_Object ptr) 3942 free_key_data (Lisp_Object ptr)
3912 { 3943 {
3913 #ifdef NEW_GC 3944 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, key_data, Lisp_Key_Data,
3914 free_lrecord (ptr); 3945 XKEY_DATA (ptr));
3915 #else /* not NEW_GC */
3916 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (key_data, Lisp_Key_Data, XKEY_DATA (ptr));
3917 #endif /* not NEW_GC */
3918 } 3946 }
3919 3947
3920 #ifndef NEW_GC 3948 #ifndef NEW_GC
3921 static void 3949 static void
3922 sweep_button_data (void) 3950 sweep_button_data (void)
3929 #endif /* not NEW_GC */ 3957 #endif /* not NEW_GC */
3930 3958
3931 void 3959 void
3932 free_button_data (Lisp_Object ptr) 3960 free_button_data (Lisp_Object ptr)
3933 { 3961 {
3934 #ifdef NEW_GC 3962 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, button_data, Lisp_Button_Data,
3935 free_lrecord (ptr); 3963 XBUTTON_DATA (ptr));
3936 #else /* not NEW_GC */
3937 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (button_data, Lisp_Button_Data, XBUTTON_DATA (ptr));
3938 #endif /* not NEW_GC */
3939 } 3964 }
3940 3965
3941 #ifndef NEW_GC 3966 #ifndef NEW_GC
3942 static void 3967 static void
3943 sweep_motion_data (void) 3968 sweep_motion_data (void)
3950 #endif /* not NEW_GC */ 3975 #endif /* not NEW_GC */
3951 3976
3952 void 3977 void
3953 free_motion_data (Lisp_Object ptr) 3978 free_motion_data (Lisp_Object ptr)
3954 { 3979 {
3955 #ifdef NEW_GC 3980 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, motion_data, Lisp_Motion_Data,
3956 free_lrecord (ptr); 3981 XMOTION_DATA (ptr));
3957 #else /* not NEW_GC */
3958 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (motion_data, Lisp_Motion_Data, XMOTION_DATA (ptr));
3959 #endif /* not NEW_GC */
3960 } 3982 }
3961 3983
3962 #ifndef NEW_GC 3984 #ifndef NEW_GC
3963 static void 3985 static void
3964 sweep_process_data (void) 3986 sweep_process_data (void)
3971 #endif /* not NEW_GC */ 3993 #endif /* not NEW_GC */
3972 3994
3973 void 3995 void
3974 free_process_data (Lisp_Object ptr) 3996 free_process_data (Lisp_Object ptr)
3975 { 3997 {
3976 #ifdef NEW_GC 3998 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, process_data, Lisp_Process_Data,
3977 free_lrecord (ptr); 3999 XPROCESS_DATA (ptr));
3978 #else /* not NEW_GC */
3979 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (process_data, Lisp_Process_Data, XPROCESS_DATA (ptr));
3980 #endif /* not NEW_GC */
3981 } 4000 }
3982 4001
3983 #ifndef NEW_GC 4002 #ifndef NEW_GC
3984 static void 4003 static void
3985 sweep_timeout_data (void) 4004 sweep_timeout_data (void)
3992 #endif /* not NEW_GC */ 4011 #endif /* not NEW_GC */
3993 4012
3994 void 4013 void
3995 free_timeout_data (Lisp_Object ptr) 4014 free_timeout_data (Lisp_Object ptr)
3996 { 4015 {
3997 #ifdef NEW_GC 4016 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, timeout_data, Lisp_Timeout_Data,
3998 free_lrecord (ptr); 4017 XTIMEOUT_DATA (ptr));
3999 #else /* not NEW_GC */
4000 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (timeout_data, Lisp_Timeout_Data, XTIMEOUT_DATA (ptr));
4001 #endif /* not NEW_GC */
4002 } 4018 }
4003 4019
4004 #ifndef NEW_GC 4020 #ifndef NEW_GC
4005 static void 4021 static void
4006 sweep_magic_data (void) 4022 sweep_magic_data (void)
4013 #endif /* not NEW_GC */ 4029 #endif /* not NEW_GC */
4014 4030
4015 void 4031 void
4016 free_magic_data (Lisp_Object ptr) 4032 free_magic_data (Lisp_Object ptr)
4017 { 4033 {
4018 #ifdef NEW_GC 4034 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, magic_data, Lisp_Magic_Data,
4019 free_lrecord (ptr); 4035 XMAGIC_DATA (ptr));
4020 #else /* not NEW_GC */
4021 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_data, Lisp_Magic_Data, XMAGIC_DATA (ptr));
4022 #endif /* not NEW_GC */
4023 } 4036 }
4024 4037
4025 #ifndef NEW_GC 4038 #ifndef NEW_GC
4026 static void 4039 static void
4027 sweep_magic_eval_data (void) 4040 sweep_magic_eval_data (void)
4034 #endif /* not NEW_GC */ 4047 #endif /* not NEW_GC */
4035 4048
4036 void 4049 void
4037 free_magic_eval_data (Lisp_Object ptr) 4050 free_magic_eval_data (Lisp_Object ptr)
4038 { 4051 {
4039 #ifdef NEW_GC 4052 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, magic_eval_data, Lisp_Magic_Eval_Data,
4040 free_lrecord (ptr); 4053 XMAGIC_EVAL_DATA (ptr));
4041 #else /* not NEW_GC */
4042 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (magic_eval_data, Lisp_Magic_Eval_Data, XMAGIC_EVAL_DATA (ptr));
4043 #endif /* not NEW_GC */
4044 } 4054 }
4045 4055
4046 #ifndef NEW_GC 4056 #ifndef NEW_GC
4047 static void 4057 static void
4048 sweep_eval_data (void) 4058 sweep_eval_data (void)
4055 #endif /* not NEW_GC */ 4065 #endif /* not NEW_GC */
4056 4066
4057 void 4067 void
4058 free_eval_data (Lisp_Object ptr) 4068 free_eval_data (Lisp_Object ptr)
4059 { 4069 {
4060 #ifdef NEW_GC 4070 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, eval_data, Lisp_Eval_Data,
4061 free_lrecord (ptr); 4071 XEVAL_DATA (ptr));
4062 #else /* not NEW_GC */
4063 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (eval_data, Lisp_Eval_Data, XEVAL_DATA (ptr));
4064 #endif /* not NEW_GC */
4065 } 4072 }
4066 4073
4067 #ifndef NEW_GC 4074 #ifndef NEW_GC
4068 static void 4075 static void
4069 sweep_misc_user_data (void) 4076 sweep_misc_user_data (void)
4076 #endif /* not NEW_GC */ 4083 #endif /* not NEW_GC */
4077 4084
4078 void 4085 void
4079 free_misc_user_data (Lisp_Object ptr) 4086 free_misc_user_data (Lisp_Object ptr)
4080 { 4087 {
4081 #ifdef NEW_GC 4088 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, misc_user_data, Lisp_Misc_User_Data,
4082 free_lrecord (ptr); 4089 XMISC_USER_DATA (ptr));
4083 #else /* not NEW_GC */
4084 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (misc_user_data, Lisp_Misc_User_Data, XMISC_USER_DATA (ptr));
4085 #endif /* not NEW_GC */
4086 } 4090 }
4087 4091
4088 #endif /* EVENT_DATA_AS_OBJECTS */ 4092 #endif /* EVENT_DATA_AS_OBJECTS */
4089 4093
4090 #ifndef NEW_GC 4094 #ifndef NEW_GC
4104 4108
4105 /* Explicitly free a marker. */ 4109 /* Explicitly free a marker. */
4106 void 4110 void
4107 free_marker (Lisp_Object ptr) 4111 free_marker (Lisp_Object ptr)
4108 { 4112 {
4109 #ifdef NEW_GC 4113 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (ptr, marker, Lisp_Marker, XMARKER (ptr));
4110 free_lrecord (ptr);
4111 #else /* not NEW_GC */
4112 FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, XMARKER (ptr));
4113 #endif /* not NEW_GC */
4114 } 4114 }
4115 4115
4116 4116
4117 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY) 4117 #if defined (MULE) && defined (VERIFY_STRING_CHARS_INTEGRITY)
4118 4118
4325 4325
4326 #ifndef NEW_GC 4326 #ifndef NEW_GC
4327 void 4327 void
4328 gc_sweep_1 (void) 4328 gc_sweep_1 (void)
4329 { 4329 {
4330 /* Reset all statistics to 0. They will be incremented when
4331 sweeping lcrecords, frob-block lrecords and dumped objects. */
4332 xzero (lrecord_stats);
4333
4330 /* Free all unmarked records. Do this at the very beginning, 4334 /* Free all unmarked records. Do this at the very beginning,
4331 before anything else, so that the finalize methods can safely 4335 before anything else, so that the finalize methods can safely
4332 examine items in the objects. sweep_lcrecords_1() makes 4336 examine items in the objects. sweep_lcrecords_1() makes
4333 sure to call all the finalize methods *before* freeing anything, 4337 sure to call all the finalize methods *before* freeing anything,
4334 to complete the safety. */ 4338 to complete the safety. */
4487 or portable numeric datatypes, or bit-vectors, or characters, or 4491 or portable numeric datatypes, or bit-vectors, or characters, or
4488 arrays, or exceptions, or ...) */ 4492 arrays, or exceptions, or ...) */
4489 return cons3 (intern (name), make_int (value), tail); 4493 return cons3 (intern (name), make_int (value), tail);
4490 } 4494 }
4491 4495
4496 /* Pluralize a lowercase English word stored in BUF, assuming BUF has
4497 enough space to hold the extra letters (at most 2). */
4498 static void
4499 pluralize_word (Ascbyte *buf)
4500 {
4501 Bytecount len = strlen (buf);
4502 int upper = 0;
4503 Ascbyte d, e;
4504
4505 if (len == 0 || len == 1)
4506 goto pluralize_apostrophe_s;
4507 e = buf[len - 1];
4508 d = buf[len - 2];
4509 upper = isupper (e);
4510 e = tolower (e);
4511 d = tolower (d);
4512 if (e == 'y')
4513 {
4514 switch (d)
4515 {
4516 case 'a':
4517 case 'e':
4518 case 'i':
4519 case 'o':
4520 case 'u':
4521 goto pluralize_s;
4522 default:
4523 buf[len - 1] = (upper ? 'I' : 'i');
4524 goto pluralize_es;
4525 }
4526 }
4527 else if (e == 's' || e == 'x' || (e == 'h' && (d == 's' || d == 'c')))
4528 {
4529 pluralize_es:
4530 buf[len++] = (upper ? 'E' : 'e');
4531 }
4532 pluralize_s:
4533 buf[len++] = (upper ? 'S' : 's');
4534 buf[len] = '\0';
4535 return;
4536
4537 pluralize_apostrophe_s:
4538 buf[len++] = '\'';
4539 goto pluralize_s;
4540 }
4541
4542 static void
4543 pluralize_and_append (Ascbyte *buf, const Ascbyte *name, const Ascbyte *suffix)
4544 {
4545 strcpy (buf, name);
4546 pluralize_word (buf);
4547 strcat (buf, suffix);
4548 }
4549
4492 static Lisp_Object 4550 static Lisp_Object
4493 object_memory_usage_stats (int set_total_gc_usage) 4551 object_memory_usage_stats (int set_total_gc_usage)
4494 { 4552 {
4495 Lisp_Object pl = Qnil; 4553 Lisp_Object pl = Qnil;
4496 int i; 4554 int i;
4502 { 4560 {
4503 if (lrecord_stats[i].instances_in_use != 0) 4561 if (lrecord_stats[i].instances_in_use != 0)
4504 { 4562 {
4505 Ascbyte buf[255]; 4563 Ascbyte buf[255];
4506 const Ascbyte *name = lrecord_implementations_table[i]->name; 4564 const Ascbyte *name = lrecord_implementations_table[i]->name;
4507 int len = strlen (name);
4508 4565
4509 if (lrecord_stats[i].bytes_in_use_including_overhead != 4566 if (lrecord_stats[i].bytes_in_use_including_overhead !=
4510 lrecord_stats[i].bytes_in_use) 4567 lrecord_stats[i].bytes_in_use)
4511 { 4568 {
4512 sprintf (buf, "%s-storage-including-overhead", name); 4569 sprintf (buf, "%s-storage-including-overhead", name);
4519 sprintf (buf, "%s-storage", name); 4576 sprintf (buf, "%s-storage", name);
4520 pl = gc_plist_hack (buf, 4577 pl = gc_plist_hack (buf,
4521 lrecord_stats[i].bytes_in_use, 4578 lrecord_stats[i].bytes_in_use,
4522 pl); 4579 pl);
4523 tgu_val += lrecord_stats[i].bytes_in_use_including_overhead; 4580 tgu_val += lrecord_stats[i].bytes_in_use_including_overhead;
4524 4581
4525 if (name[len-1] == 's') 4582 pluralize_and_append (buf, name, "-used");
4526 sprintf (buf, "%ses-used", name);
4527 else
4528 sprintf (buf, "%ss-used", name);
4529 pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl); 4583 pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
4530 } 4584 }
4531 } 4585 }
4532 4586
4533 #else /* not NEW_GC */ 4587 #else /* not NEW_GC */
4534 4588
4535 #define HACK_O_MATIC(type, name, pl) do { \ 4589 #define HACK_O_MATIC(type, name, pl) \
4536 EMACS_INT s = 0; \ 4590 do { \
4537 struct type##_block *x = current_##type##_block; \ 4591 COUNT_FROB_BLOCK_USAGE (type); \
4538 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \ 4592 tgu_val += s; \
4539 tgu_val += s; \ 4593 (pl) = gc_plist_hack ((name), s, (pl)); \
4540 (pl) = gc_plist_hack ((name), s, (pl)); \
4541 } while (0) 4594 } while (0)
4595
4596 #define FROB(type) \
4597 do { \
4598 COUNT_FROB_BLOCK_USAGE (type); \
4599 tgu_val += s; \
4600 } while (0)
4601
4602 FROB (extent);
4603 FROB (event);
4604 FROB (marker);
4605 FROB (float);
4606 #ifdef HAVE_BIGNUM
4607 FROB (bignum);
4608 #endif /* HAVE_BIGNUM */
4609 #ifdef HAVE_RATIO
4610 FROB (ratio);
4611 #endif /* HAVE_RATIO */
4612 #ifdef HAVE_BIGFLOAT
4613 FROB (bigfloat);
4614 #endif /* HAVE_BIGFLOAT */
4615 FROB (compiled_function);
4616 FROB (symbol);
4617 FROB (cons);
4618
4619 #undef FROB
4542 4620
4543 for (i = 0; i < lrecord_type_count; i++) 4621 for (i = 0; i < lrecord_type_count; i++)
4544 { 4622 {
4545 if (lcrecord_stats[i].bytes_in_use != 0 4623 if (lrecord_stats[i].bytes_in_use != 0
4546 || lcrecord_stats[i].bytes_freed != 0 4624 || lrecord_stats[i].bytes_freed != 0
4547 || lcrecord_stats[i].instances_on_free_list != 0) 4625 || lrecord_stats[i].instances_on_free_list != 0)
4548 { 4626 {
4549 Ascbyte buf[255]; 4627 Ascbyte buf[255];
4550 const Ascbyte *name = lrecord_implementations_table[i]->name; 4628 const Ascbyte *name = lrecord_implementations_table[i]->name;
4551 int len = strlen (name);
4552 4629
4553 sprintf (buf, "%s-storage", name); 4630 sprintf (buf, "%s-storage", name);
4554 pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl); 4631 pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use, pl);
4555 tgu_val += lcrecord_stats[i].bytes_in_use; 4632 tgu_val += lrecord_stats[i].bytes_in_use;
4556 /* Okay, simple pluralization check for `symbol-value-varalias' */ 4633 pluralize_and_append (buf, name, "-freed");
4557 if (name[len-1] == 's') 4634 if (lrecord_stats[i].instances_freed != 0)
4558 sprintf (buf, "%ses-freed", name); 4635 pl = gc_plist_hack (buf, lrecord_stats[i].instances_freed, pl);
4559 else 4636 pluralize_and_append (buf, name, "-on-free-list");
4560 sprintf (buf, "%ss-freed", name); 4637 if (lrecord_stats[i].instances_on_free_list != 0)
4561 if (lcrecord_stats[i].instances_freed != 0) 4638 pl = gc_plist_hack (buf, lrecord_stats[i].instances_on_free_list,
4562 pl = gc_plist_hack (buf, lcrecord_stats[i].instances_freed, pl);
4563 if (name[len-1] == 's')
4564 sprintf (buf, "%ses-on-free-list", name);
4565 else
4566 sprintf (buf, "%ss-on-free-list", name);
4567 if (lcrecord_stats[i].instances_on_free_list != 0)
4568 pl = gc_plist_hack (buf, lcrecord_stats[i].instances_on_free_list,
4569 pl); 4639 pl);
4570 if (name[len-1] == 's') 4640 pluralize_and_append (buf, name, "-used");
4571 sprintf (buf, "%ses-used", name); 4641 pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
4572 else
4573 sprintf (buf, "%ss-used", name);
4574 pl = gc_plist_hack (buf, lcrecord_stats[i].instances_in_use, pl);
4575 } 4642 }
4576 } 4643 }
4577 4644
4578 HACK_O_MATIC (extent, "extent-storage", pl);
4579 pl = gc_plist_hack ("extents-free", gc_count_num_extent_freelist, pl);
4580 pl = gc_plist_hack ("extents-used", gc_count_num_extent_in_use, pl);
4581 HACK_O_MATIC (event, "event-storage", pl);
4582 pl = gc_plist_hack ("events-free", gc_count_num_event_freelist, pl);
4583 pl = gc_plist_hack ("events-used", gc_count_num_event_in_use, pl);
4584 HACK_O_MATIC (marker, "marker-storage", pl);
4585 pl = gc_plist_hack ("markers-free", gc_count_num_marker_freelist, pl);
4586 pl = gc_plist_hack ("markers-used", gc_count_num_marker_in_use, pl);
4587 HACK_O_MATIC (float, "float-storage", pl);
4588 pl = gc_plist_hack ("floats-free", gc_count_num_float_freelist, pl);
4589 pl = gc_plist_hack ("floats-used", gc_count_num_float_in_use, pl);
4590 #ifdef HAVE_BIGNUM
4591 HACK_O_MATIC (bignum, "bignum-storage", pl);
4592 pl = gc_plist_hack ("bignums-free", gc_count_num_bignum_freelist, pl);
4593 pl = gc_plist_hack ("bignums-used", gc_count_num_bignum_in_use, pl);
4594 #endif /* HAVE_BIGNUM */
4595 #ifdef HAVE_RATIO
4596 HACK_O_MATIC (ratio, "ratio-storage", pl);
4597 pl = gc_plist_hack ("ratios-free", gc_count_num_ratio_freelist, pl);
4598 pl = gc_plist_hack ("ratios-used", gc_count_num_ratio_in_use, pl);
4599 #endif /* HAVE_RATIO */
4600 #ifdef HAVE_BIGFLOAT
4601 HACK_O_MATIC (bigfloat, "bigfloat-storage", pl);
4602 pl = gc_plist_hack ("bigfloats-free", gc_count_num_bigfloat_freelist, pl);
4603 pl = gc_plist_hack ("bigfloats-used", gc_count_num_bigfloat_in_use, pl);
4604 #endif /* HAVE_BIGFLOAT */
4605 HACK_O_MATIC (string, "string-header-storage", pl); 4645 HACK_O_MATIC (string, "string-header-storage", pl);
4606 pl = gc_plist_hack ("long-strings-total-length", 4646 pl = gc_plist_hack ("long-strings-total-length",
4607 gc_count_string_total_size 4647 gc_count_string_total_size
4608 - gc_count_short_string_total_size, pl); 4648 - gc_count_short_string_total_size, pl);
4609 HACK_O_MATIC (string_chars, "short-string-storage", pl); 4649 HACK_O_MATIC (string_chars, "short-string-storage", pl);
4613 pl = gc_plist_hack ("long-strings-used", 4653 pl = gc_plist_hack ("long-strings-used",
4614 gc_count_num_string_in_use 4654 gc_count_num_string_in_use
4615 - gc_count_num_short_string_in_use, pl); 4655 - gc_count_num_short_string_in_use, pl);
4616 pl = gc_plist_hack ("short-strings-used", 4656 pl = gc_plist_hack ("short-strings-used",
4617 gc_count_num_short_string_in_use, pl); 4657 gc_count_num_short_string_in_use, pl);
4618
4619 HACK_O_MATIC (compiled_function, "compiled-function-storage", pl);
4620 pl = gc_plist_hack ("compiled-functions-free",
4621 gc_count_num_compiled_function_freelist, pl);
4622 pl = gc_plist_hack ("compiled-functions-used",
4623 gc_count_num_compiled_function_in_use, pl);
4624
4625 HACK_O_MATIC (symbol, "symbol-storage", pl);
4626 pl = gc_plist_hack ("symbols-free", gc_count_num_symbol_freelist, pl);
4627 pl = gc_plist_hack ("symbols-used", gc_count_num_symbol_in_use, pl);
4628
4629 HACK_O_MATIC (cons, "cons-storage", pl);
4630 pl = gc_plist_hack ("conses-free", gc_count_num_cons_freelist, pl);
4631 pl = gc_plist_hack ("conses-used", gc_count_num_cons_in_use, pl);
4632 4658
4633 #undef HACK_O_MATIC 4659 #undef HACK_O_MATIC
4634 4660
4635 #endif /* NEW_GC */ 4661 #endif /* NEW_GC */
4636 4662
4704 Fcons (make_int (gc_count_num_symbol_in_use), 4730 Fcons (make_int (gc_count_num_symbol_in_use),
4705 make_int (gc_count_num_symbol_freelist)), 4731 make_int (gc_count_num_symbol_freelist)),
4706 Fcons (make_int (gc_count_num_marker_in_use), 4732 Fcons (make_int (gc_count_num_marker_in_use),
4707 make_int (gc_count_num_marker_freelist)), 4733 make_int (gc_count_num_marker_freelist)),
4708 make_int (gc_count_string_total_size), 4734 make_int (gc_count_string_total_size),
4709 make_int (lcrecord_stats[lrecord_type_vector].bytes_in_use + 4735 make_int (lrecord_stats[lrecord_type_vector].bytes_in_use +
4710 lcrecord_stats[lrecord_type_vector].bytes_freed), 4736 lrecord_stats[lrecord_type_vector].bytes_freed +
4737 lrecord_stats[lrecord_type_vector].bytes_on_free_list),
4711 object_memory_usage_stats (1)); 4738 object_memory_usage_stats (1));
4712 #endif /* not NEW_GC */ 4739 #endif /* not NEW_GC */
4713 #else /* not ALLOC_TYPE_STATS */ 4740 #else /* not ALLOC_TYPE_STATS */
4714 return Qnil; 4741 return Qnil;
4715 #endif /* ALLOC_TYPE_STATS */ 4742 #endif /* ALLOC_TYPE_STATS */