Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 5160:ab9ee10a53e4

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix various problems with allocation statistics, track overhead properly -------------------- ChangeLog entries follow: -------------------- lisp/ChangeLog addition: 2010-03-20 Ben Wing <ben@xemacs.org> * diagnose.el (show-memory-usage): * diagnose.el (show-object-memory-usage-stats): Further changes to correspond with changes in the C code; add an additional column showing the overhead used with each type, and add it into the grand total memory usage. src/ChangeLog addition: 2010-03-20 Ben Wing <ben@xemacs.org> * alloc.c: * alloc.c (init_lrecord_stats): * alloc.c (free_normal_lisp_object): * alloc.c (struct): * alloc.c (clear_lrecord_stats): * alloc.c (tick_lrecord_stats): * alloc.c (COUNT_FROB_BLOCK_USAGE): * alloc.c (COPY_INTO_LRECORD_STATS): * alloc.c (sweep_strings): * alloc.c (UNMARK_string): * alloc.c (gc_sweep_1): * alloc.c (finish_object_memory_usage_stats): * alloc.c (object_memory_usage_stats): * alloc.c (object_dead_p): * alloc.c (fixed_type_block_overhead): * alloc.c (lisp_object_storage_size): * emacs.c (main_1): * lisp.h: * lrecord.h: Export lisp_object_storage_size() and malloced_storage_size() even when not MEMORY_USAGE_STATS, to get the non-MEMORY_USAGE_STATS build to compile. Don't export fixed_type_block_overhead() any more. Some code cleanup, rearrangement, add some section headers. Clean up various bugs especially involving computation of overhead and double-counting certain usage in total_gc_usage. Add statistics computing the overhead used by all types. Don't add a special entry for string headers in the object-memory-usage-stats because it's already present as just "string". But do count the overhead used by long strings. Don't try to call the memory_usage() methods when NEW_GC because there's nowhere obvious in the sweep stage to make the calls. * marker.c (compute_buffer_marker_usage): Just use lisp_object_storage_size() rather than trying to reimplement it.
author Ben Wing <ben@xemacs.org>
date Sat, 20 Mar 2010 20:20:30 -0500
parents cb303ff63e76
children 57f4dcb14ad5 e374ea766cc1
comparison
equal deleted inserted replaced
5159:cb303ff63e76 5160:ab9ee10a53e4
110 110
111 /* This is just for use by the printer, to allow things to print uniquely. 111 /* This is just for use by the printer, to allow things to print uniquely.
112 We have a separate UID space for each object. (Important because the 112 We have a separate UID space for each object. (Important because the
113 UID is only 20 bits in old-GC, and 22 in NEW_GC.) */ 113 UID is only 20 bits in old-GC, and 22 in NEW_GC.) */
114 int lrecord_uid_counter[countof (lrecord_implementations_table)]; 114 int lrecord_uid_counter[countof (lrecord_implementations_table)];
115
116 #ifndef USE_KKCC
117 /* Object marker functions are in the lrecord_implementation structure.
118 But copying them to a parallel array is much more cache-friendly.
119 This hack speeds up (garbage-collect) by about 5%. */
120 Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object);
121 #endif /* not USE_KKCC */
122
123 struct gcpro *gcprolist;
115 124
116 /* Non-zero means we're in the process of doing the dump */ 125 /* Non-zero means we're in the process of doing the dump */
117 int purify_flag; 126 int purify_flag;
118 127
119 /* Non-zero means we're pdumping out or in */ 128 /* Non-zero means we're pdumping out or in */
515 int bytes_in_use; 524 int bytes_in_use;
516 int bytes_in_use_including_overhead; 525 int bytes_in_use_including_overhead;
517 } lrecord_stats [countof (lrecord_implementations_table)]; 526 } lrecord_stats [countof (lrecord_implementations_table)];
518 527
519 void 528 void
520 init_lrecord_stats () 529 init_lrecord_stats (void)
521 { 530 {
522 xzero (lrecord_stats); 531 xzero (lrecord_stats);
523 } 532 }
524 533
525 void 534 void
842 XRECORD_LHEADER_IMPLEMENTATION (obj); 851 XRECORD_LHEADER_IMPLEMENTATION (obj);
843 assert (!imp->size_in_bytes_method); 852 assert (!imp->size_in_bytes_method);
844 853
845 zero_sized_lisp_object (obj, lisp_object_size (obj)); 854 zero_sized_lisp_object (obj, lisp_object_size (obj));
846 } 855 }
847
848 #ifdef MEMORY_USAGE_STATS
849
850 Bytecount
851 lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats)
852 {
853 #ifndef NEW_GC
854 const struct lrecord_implementation *imp =
855 XRECORD_LHEADER_IMPLEMENTATION (obj);
856 #endif /* not NEW_GC */
857 Bytecount size = lisp_object_size (obj);
858
859 #ifdef NEW_GC
860 return mc_alloced_storage_size (size, ustats);
861 #else
862 if (imp->frob_block_p)
863 {
864 Bytecount overhead = fixed_type_block_overhead (size);
865 if (ustats)
866 {
867 ustats->was_requested += size;
868 ustats->malloc_overhead += overhead;
869 }
870 return size + overhead;
871 }
872 else
873 return malloced_storage_size (XPNTR (obj), size, ustats);
874 #endif
875 }
876
877 #endif /* MEMORY_USAGE_STATS */
878 856
879 void 857 void
880 free_normal_lisp_object (Lisp_Object obj) 858 free_normal_lisp_object (Lisp_Object obj)
881 { 859 {
882 #ifndef NEW_GC 860 #ifndef NEW_GC
3388 return object; 3366 return object;
3389 } 3367 }
3390 3368
3391 3369
3392 /************************************************************************/ 3370 /************************************************************************/
3393 /* Garbage Collection */ 3371 /* Staticpro, MCpro */
3394 /************************************************************************/ 3372 /************************************************************************/
3395
3396 #ifndef USE_KKCC
3397 /* Object marker functions are in the lrecord_implementation structure.
3398 But copying them to a parallel array is much more cache-friendly.
3399 This hack speeds up (garbage-collect) by about 5%. */
3400 Lisp_Object (*lrecord_markers[countof (lrecord_implementations_table)]) (Lisp_Object);
3401 #endif /* not USE_KKCC */
3402
3403 struct gcpro *gcprolist;
3404 3373
3405 /* We want the staticpro list relocated, but not the pointers found 3374 /* We want the staticpro list relocated, but not the pointers found
3406 therein, because they refer to locations in the global data segment, not 3375 therein, because they refer to locations in the global data segment, not
3407 in the heap; we only dump heap objects. Hence we use a trivial 3376 in the heap; we only dump heap objects. Hence we use a trivial
3408 description, as for pointerless objects. (Note that the data segment 3377 description, as for pointerless objects. (Note that the data segment
3537 } 3506 }
3538 #endif 3507 #endif
3539 3508
3540 #endif /* not DEBUG_XEMACS */ 3509 #endif /* not DEBUG_XEMACS */
3541 3510
3542
3543
3544
3545
3546 #ifdef NEW_GC 3511 #ifdef NEW_GC
3547 static const struct memory_description mcpro_description_1[] = { 3512 static const struct memory_description mcpro_description_1[] = {
3548 { XD_END } 3513 { XD_END }
3549 }; 3514 };
3550 3515
3602 } 3567 }
3603 3568
3604 #endif /* not DEBUG_XEMACS */ 3569 #endif /* not DEBUG_XEMACS */
3605 #endif /* NEW_GC */ 3570 #endif /* NEW_GC */
3606 3571
3572
3573 /************************************************************************/
3574 /* Allocation Statistics */
3575 /************************************************************************/
3607 3576
3608 #ifndef NEW_GC 3577 #ifndef NEW_GC
3609 static int gc_count_num_short_string_in_use; 3578 static int gc_count_num_short_string_in_use;
3610 static Bytecount gc_count_string_total_size; 3579 static Bytecount gc_count_string_total_size;
3611 static Bytecount gc_count_short_string_total_size; 3580 static Bytecount gc_count_short_string_total_size;
3581 static Bytecount gc_count_long_string_storage_including_overhead;
3612 3582
3613 /* static int gc_count_total_records_used, gc_count_records_total_size; */ 3583 /* static int gc_count_total_records_used, gc_count_records_total_size; */
3614 3584
3615 3585
3616 /* stats on lcrecords in use - kinda kludgy */ 3586 /* stats on objects in use */
3617 3587
3618 static struct 3588 static struct
3619 { 3589 {
3620 int instances_in_use; 3590 Elemcount instances_in_use;
3621 int bytes_in_use; 3591 Bytecount bytes_in_use;
3622 int instances_freed; 3592 Bytecount bytes_in_use_overhead;
3623 int bytes_freed; 3593 Elemcount instances_freed;
3624 int instances_on_free_list; 3594 Bytecount bytes_freed;
3625 int bytes_on_free_list; 3595 Bytecount bytes_freed_overhead;
3596 Elemcount instances_on_free_list;
3597 Bytecount bytes_on_free_list;
3598 Bytecount bytes_on_free_list_overhead;
3626 #ifdef MEMORY_USAGE_STATS 3599 #ifdef MEMORY_USAGE_STATS
3627 Bytecount nonlisp_bytes_in_use; 3600 Bytecount nonlisp_bytes_in_use;
3628 struct generic_usage_stats stats; 3601 struct generic_usage_stats stats;
3629 #endif 3602 #endif
3630 } lrecord_stats [countof (lrecord_implementations_table)]; 3603 } lrecord_stats [countof (lrecord_implementations_table)];
3631 3604
3605 static void
3606 clear_lrecord_stats (void)
3607 {
3608 xzero (lrecord_stats);
3609 gc_count_num_short_string_in_use = 0;
3610 gc_count_string_total_size = 0;
3611 gc_count_short_string_total_size = 0;
3612 gc_count_long_string_storage_including_overhead = 0;
3613 }
3614
3615 /* Keep track of extra statistics for strings -- length of the string
3616 characters for short and long strings, number of short and long strings. */
3617 static void
3618 tick_string_stats (Lisp_String *p, int from_sweep)
3619 {
3620 Bytecount size = p->size_;
3621 gc_count_string_total_size += size;
3622 if (!BIG_STRING_SIZE_P (size))
3623 {
3624 gc_count_short_string_total_size += size;
3625 gc_count_num_short_string_in_use++;
3626 }
3627 else
3628 gc_count_long_string_storage_including_overhead +=
3629 malloced_storage_size (p->data_, p->size_, NULL);
3630 /* During the sweep stage, we count the total number of strings in use.
3631 This gets those not stored in pdump storage. For pdump storage, we
3632 need to bump the number of strings in use so as to get an accurate
3633 count of all strings in use (pdump or not). But don't do this when
3634 called from the sweep stage, or we will double-count. */
3635 if (!from_sweep)
3636 gc_count_num_string_in_use++;
3637 }
3638
3639 /* As objects are sweeped, we record statistics about their memory usage.
3640 Currently, all lcrecords are processed this way as well as any frob-block
3641 objects that were saved and restored as a result of the pdump process.
3642 (See pdump_objects_unmark().) Other frob-block objects do NOT get their
3643 statistics noted this way -- instead, as the frob blocks are swept,
3644 COPY_INTO_LRECORD_STATS() is called, and notes statistics about the
3645 frob blocks. */
3646
3632 void 3647 void
3633 tick_lrecord_stats (const struct lrecord_header *h, 3648 tick_lrecord_stats (const struct lrecord_header *h,
3634 enum lrecord_alloc_status status) 3649 enum lrecord_alloc_status status)
3635 { 3650 {
3636 int type_index = h->type; 3651 int type_index = h->type;
3637 Bytecount sz = detagged_lisp_object_size (h); 3652 Bytecount obj = wrap_pointer_1 (h);
3653 Bytecount sz = lisp_object_size (obj);
3654 Bytecount sz_with_overhead = lisp_object_storage_size (obj, NULL);
3655 Bytecount overhead = sz_with_overhead - sz;
3638 3656
3639 switch (status) 3657 switch (status)
3640 { 3658 {
3641 case ALLOC_IN_USE: 3659 case ALLOC_IN_USE:
3642 lrecord_stats[type_index].instances_in_use++; 3660 lrecord_stats[type_index].instances_in_use++;
3643 lrecord_stats[type_index].bytes_in_use += sz; 3661 lrecord_stats[type_index].bytes_in_use += sz;
3662 lrecord_stats[type_index].bytes_in_use_overhead += overhead;
3663 if (STRINGP (obj))
3664 tick_string_stats (XSTRING (obj), 0);
3644 #ifdef MEMORY_USAGE_STATS 3665 #ifdef MEMORY_USAGE_STATS
3645 { 3666 {
3646 struct generic_usage_stats stats; 3667 struct generic_usage_stats stats;
3647 Lisp_Object obj = wrap_pointer_1 (h);
3648 if (HAS_OBJECT_METH_P (obj, memory_usage)) 3668 if (HAS_OBJECT_METH_P (obj, memory_usage))
3649 { 3669 {
3650 int i; 3670 int i;
3651 int total_stats = OBJECT_PROPERTY (obj, num_extra_memusage_stats); 3671 int total_stats = OBJECT_PROPERTY (obj, num_extra_memusage_stats);
3652 xzero (stats); 3672 xzero (stats);
3659 #endif 3679 #endif
3660 break; 3680 break;
3661 case ALLOC_FREE: 3681 case ALLOC_FREE:
3662 lrecord_stats[type_index].instances_freed++; 3682 lrecord_stats[type_index].instances_freed++;
3663 lrecord_stats[type_index].bytes_freed += sz; 3683 lrecord_stats[type_index].bytes_freed += sz;
3684 lrecord_stats[type_index].bytes_freed_overhead += overhead;
3664 break; 3685 break;
3665 case ALLOC_ON_FREE_LIST: 3686 case ALLOC_ON_FREE_LIST:
3666 lrecord_stats[type_index].instances_on_free_list++; 3687 lrecord_stats[type_index].instances_on_free_list++;
3667 lrecord_stats[type_index].bytes_on_free_list += sz; 3688 lrecord_stats[type_index].bytes_on_free_list += sz;
3689 lrecord_stats[type_index].bytes_on_free_list_overhead += overhead;
3668 break; 3690 break;
3669 default: 3691 default:
3670 ABORT (); 3692 ABORT ();
3671 } 3693 }
3672 } 3694 }
3680 tick_lrecord_stats (h, ALLOC_ON_FREE_LIST); 3702 tick_lrecord_stats (h, ALLOC_ON_FREE_LIST);
3681 } 3703 }
3682 else 3704 else
3683 tick_lrecord_stats (h, free_p ? ALLOC_FREE : ALLOC_IN_USE); 3705 tick_lrecord_stats (h, free_p ? ALLOC_FREE : ALLOC_IN_USE);
3684 } 3706 }
3707
3685 #endif /* not NEW_GC */ 3708 #endif /* not NEW_GC */
3686 3709
3687 3710
3711 /************************************************************************/
3712 /* Garbage Collection -- Sweep/Compact */
3713 /************************************************************************/
3714
3688 #ifndef NEW_GC 3715 #ifndef NEW_GC
3689 /* Free all unmarked records */ 3716 /* Free all unmarked records */
3690 static void 3717 static void
3691 sweep_lcrecords_1 (struct old_lcrecord_header **prev, int *used) 3718 sweep_lcrecords_1 (struct old_lcrecord_header **prev, int *used)
3692 { 3719 {
3743 } 3770 }
3744 *used = num_used; 3771 *used = num_used;
3745 /* *total = total_size; */ 3772 /* *total = total_size; */
3746 } 3773 }
3747 3774
3775 static Bytecount fixed_type_block_overhead (Bytecount size,
3776 Bytecount per_block);
3777
3748 /* And the Lord said: Thou shalt use the `c-backslash-region' command 3778 /* And the Lord said: Thou shalt use the `c-backslash-region' command
3749 to make macros prettier. */ 3779 to make macros prettier. */
3750 3780
3751 #define COUNT_FROB_BLOCK_USAGE(type) \ 3781 #define COUNT_FROB_BLOCK_USAGE(type) \
3752 EMACS_INT s = 0; \ 3782 EMACS_INT s = 0; \
3783 EMACS_INT s_overhead = 0; \
3753 struct type##_block *x = current_##type##_block; \ 3784 struct type##_block *x = current_##type##_block; \
3754 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \ 3785 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \
3786 s_overhead = fixed_type_block_overhead (s, sizeof (struct type##_block)); \
3755 DO_NOTHING 3787 DO_NOTHING
3756 3788
3757 #define COPY_INTO_LRECORD_STATS(type) \ 3789 #define COPY_INTO_LRECORD_STATS(type) \
3758 do { \ 3790 do { \
3759 COUNT_FROB_BLOCK_USAGE (type); \ 3791 COUNT_FROB_BLOCK_USAGE (type); \
3760 lrecord_stats[lrecord_type_##type].bytes_in_use += s; \ 3792 lrecord_stats[lrecord_type_##type].bytes_in_use += s; \
3793 lrecord_stats[lrecord_type_##type].bytes_in_use_overhead += \
3794 s_overhead; \
3761 lrecord_stats[lrecord_type_##type].instances_on_free_list += \ 3795 lrecord_stats[lrecord_type_##type].instances_on_free_list += \
3762 gc_count_num_##type##_freelist; \ 3796 gc_count_num_##type##_freelist; \
3763 lrecord_stats[lrecord_type_##type].instances_in_use += \ 3797 lrecord_stats[lrecord_type_##type].instances_in_use += \
3764 gc_count_num_##type##_in_use; \ 3798 gc_count_num_##type##_in_use; \
3765 } while (0) 3799 } while (0)
4421 4455
4422 #ifndef NEW_GC 4456 #ifndef NEW_GC
4423 static void 4457 static void
4424 sweep_strings (void) 4458 sweep_strings (void)
4425 { 4459 {
4426 int num_small_used = 0;
4427 Bytecount num_small_bytes = 0, num_bytes = 0;
4428 int debug = debug_string_purity; 4460 int debug = debug_string_purity;
4429 4461
4430 #define UNMARK_string(ptr) do { \ 4462 #define UNMARK_string(ptr) do { \
4431 Lisp_String *p = (ptr); \ 4463 Lisp_String *p = (ptr); \
4432 Bytecount size = p->size_; \
4433 UNMARK_RECORD_HEADER (&(p->u.lheader)); \ 4464 UNMARK_RECORD_HEADER (&(p->u.lheader)); \
4434 num_bytes += size; \ 4465 tick_string_stats (p, 1); \
4435 if (!BIG_STRING_SIZE_P (size)) \
4436 { \
4437 num_small_bytes += size; \
4438 num_small_used++; \
4439 } \
4440 if (debug) \ 4466 if (debug) \
4441 debug_string_purity_print (wrap_string (p)); \ 4467 debug_string_purity_print (wrap_string (p)); \
4442 } while (0) 4468 } while (0)
4443 #define ADDITIONAL_FREE_string(ptr) do { \ 4469 #define ADDITIONAL_FREE_string(ptr) do { \
4444 Bytecount size = ptr->size_; \ 4470 Bytecount size = ptr->size_; \
4445 if (BIG_STRING_SIZE_P (size)) \ 4471 if (BIG_STRING_SIZE_P (size)) \
4446 xfree (ptr->data_); \ 4472 xfree (ptr->data_); \
4447 } while (0) 4473 } while (0)
4448 4474
4449 SWEEP_FIXED_TYPE_BLOCK_1 (string, Lisp_String, u.lheader); 4475 SWEEP_FIXED_TYPE_BLOCK_1 (string, Lisp_String, u.lheader);
4450
4451 gc_count_num_short_string_in_use = num_small_used;
4452 gc_count_string_total_size = num_bytes;
4453 gc_count_short_string_total_size = num_small_bytes;
4454 } 4476 }
4455 #endif /* not NEW_GC */ 4477 #endif /* not NEW_GC */
4456 4478
4457 #ifndef NEW_GC 4479 #ifndef NEW_GC
4458 void 4480 void
4459 gc_sweep_1 (void) 4481 gc_sweep_1 (void)
4460 { 4482 {
4461 /* Reset all statistics to 0. They will be incremented when 4483 /* Reset all statistics to 0. They will be incremented when
4462 sweeping lcrecords, frob-block lrecords and dumped objects. */ 4484 sweeping lcrecords, frob-block lrecords and dumped objects. */
4463 xzero (lrecord_stats); 4485 clear_lrecord_stats ();
4464 4486
4465 /* Free all unmarked records. Do this at the very beginning, 4487 /* Free all unmarked records. Do this at the very beginning,
4466 before anything else, so that the finalize methods can safely 4488 before anything else, so that the finalize methods can safely
4467 examine items in the objects. sweep_lcrecords_1() makes 4489 examine items in the objects. sweep_lcrecords_1() makes
4468 sure to call all the finalize methods *before* freeing anything, 4490 sure to call all the finalize methods *before* freeing anything,
4540 #ifdef PDUMP 4562 #ifdef PDUMP
4541 pdump_objects_unmark (); 4563 pdump_objects_unmark ();
4542 #endif 4564 #endif
4543 } 4565 }
4544 #endif /* not NEW_GC */ 4566 #endif /* not NEW_GC */
4567
4545 4568
4546 /* Clearing for disksave. */ 4569 /************************************************************************/
4570 /* "Disksave Finalization" -- Preparing for Dumping */
4571 /************************************************************************/
4547 4572
4548 void 4573 void
4549 disksave_object_finalization (void) 4574 disksave_object_finalization (void)
4550 { 4575 {
4551 /* It's important that certain information from the environment not get 4576 /* It's important that certain information from the environment not get
4677 } 4702 }
4678 4703
4679 void 4704 void
4680 finish_object_memory_usage_stats (void) 4705 finish_object_memory_usage_stats (void)
4681 { 4706 {
4682 #ifdef MEMORY_USAGE_STATS 4707 /* Here we add up the aggregate values for each statistic, previously
4708 computed during tick_lrecord_stats(), to get a single combined value
4709 of non-Lisp memory usage for all objects of each type. We can't
4710 do this if NEW_GC because nothing like tick_lrecord_stats() gets
4711 called -- instead, statistics are computed when objects are allocated,
4712 which is too early to be calling the memory_usage() method. */
4713 #if defined (MEMORY_USAGE_STATS) && !defined (NEW_GC)
4683 int i; 4714 int i;
4684 for (i = 0; i < countof (lrecord_implementations_table); i++) 4715 for (i = 0; i < countof (lrecord_implementations_table); i++)
4685 { 4716 {
4686 struct lrecord_implementation *imp = lrecord_implementations_table[i]; 4717 struct lrecord_implementation *imp = lrecord_implementations_table[i];
4687 if (imp && imp->num_extra_nonlisp_memusage_stats) 4718 if (imp && imp->num_extra_nonlisp_memusage_stats)
4690 for (j = 0; j < imp->num_extra_nonlisp_memusage_stats; j++) 4721 for (j = 0; j < imp->num_extra_nonlisp_memusage_stats; j++)
4691 lrecord_stats[i].nonlisp_bytes_in_use += 4722 lrecord_stats[i].nonlisp_bytes_in_use +=
4692 lrecord_stats[i].stats.othervals[j]; 4723 lrecord_stats[i].stats.othervals[j];
4693 } 4724 }
4694 } 4725 }
4695 #endif /* MEMORY_USAGE_STATS */ 4726 #endif /* defined (MEMORY_USAGE_STATS) && !defined (NEW_GC) */
4696 } 4727 }
4697 4728
4698 static Lisp_Object 4729 static Lisp_Object
4699 object_memory_usage_stats (int set_total_gc_usage) 4730 object_memory_usage_stats (int set_total_gc_usage)
4700 { 4731 {
4731 } 4762 }
4732 } 4763 }
4733 4764
4734 #else /* not NEW_GC */ 4765 #else /* not NEW_GC */
4735 4766
4736 #define HACK_O_MATIC(type, name, pl) \
4737 do { \
4738 COUNT_FROB_BLOCK_USAGE (type); \
4739 tgu_val += s; \
4740 (pl) = gc_plist_hack ((name), s, (pl)); \
4741 } while (0)
4742
4743 #define FROB(type) \
4744 do { \
4745 COUNT_FROB_BLOCK_USAGE (type); \
4746 tgu_val += s; \
4747 } while (0)
4748
4749 FROB (extent);
4750 FROB (event);
4751 FROB (marker);
4752 FROB (float);
4753 #ifdef HAVE_BIGNUM
4754 FROB (bignum);
4755 #endif /* HAVE_BIGNUM */
4756 #ifdef HAVE_RATIO
4757 FROB (ratio);
4758 #endif /* HAVE_RATIO */
4759 #ifdef HAVE_BIGFLOAT
4760 FROB (bigfloat);
4761 #endif /* HAVE_BIGFLOAT */
4762 FROB (compiled_function);
4763 FROB (symbol);
4764 FROB (cons);
4765
4766 #undef FROB
4767
4768 for (i = 0; i < lrecord_type_count; i++) 4767 for (i = 0; i < lrecord_type_count; i++)
4769 { 4768 {
4770 if (lrecord_stats[i].bytes_in_use != 0 4769 if (lrecord_stats[i].bytes_in_use != 0
4771 || lrecord_stats[i].bytes_freed != 0 4770 || lrecord_stats[i].bytes_freed != 0
4772 || lrecord_stats[i].instances_on_free_list != 0) 4771 || lrecord_stats[i].instances_on_free_list != 0)
4773 { 4772 {
4774 Ascbyte buf[255]; 4773 Ascbyte buf[255];
4775 const Ascbyte *name = lrecord_implementations_table[i]->name; 4774 const Ascbyte *name = lrecord_implementations_table[i]->name;
4776 4775
4776 sprintf (buf, "%s-storage-overhead", name);
4777 pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use_overhead, pl);
4778 tgu_val += lrecord_stats[i].bytes_in_use_overhead;
4777 sprintf (buf, "%s-storage", name); 4779 sprintf (buf, "%s-storage", name);
4778 pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use, pl); 4780 pl = gc_plist_hack (buf, lrecord_stats[i].bytes_in_use, pl);
4779 tgu_val += lrecord_stats[i].bytes_in_use; 4781 tgu_val += lrecord_stats[i].bytes_in_use;
4782 #ifdef MEMORY_USAGE_STATS
4780 if (lrecord_stats[i].nonlisp_bytes_in_use) 4783 if (lrecord_stats[i].nonlisp_bytes_in_use)
4781 { 4784 {
4782 sprintf (buf, "%s-non-lisp-storage", name); 4785 sprintf (buf, "%s-non-lisp-storage", name);
4783 pl = gc_plist_hack (buf, lrecord_stats[i].nonlisp_bytes_in_use, 4786 pl = gc_plist_hack (buf, lrecord_stats[i].nonlisp_bytes_in_use,
4784 pl); 4787 pl);
4785 tgu_val += lrecord_stats[i].nonlisp_bytes_in_use; 4788 tgu_val += lrecord_stats[i].nonlisp_bytes_in_use;
4786 } 4789 }
4790 #endif /* MEMORY_USAGE_STATS */
4787 pluralize_and_append (buf, name, "-freed"); 4791 pluralize_and_append (buf, name, "-freed");
4788 if (lrecord_stats[i].instances_freed != 0) 4792 if (lrecord_stats[i].instances_freed != 0)
4789 pl = gc_plist_hack (buf, lrecord_stats[i].instances_freed, pl); 4793 pl = gc_plist_hack (buf, lrecord_stats[i].instances_freed, pl);
4790 pluralize_and_append (buf, name, "-on-free-list"); 4794 pluralize_and_append (buf, name, "-on-free-list");
4791 if (lrecord_stats[i].instances_on_free_list != 0) 4795 if (lrecord_stats[i].instances_on_free_list != 0)
4794 pluralize_and_append (buf, name, "-used"); 4798 pluralize_and_append (buf, name, "-used");
4795 pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl); 4799 pl = gc_plist_hack (buf, lrecord_stats[i].instances_in_use, pl);
4796 } 4800 }
4797 } 4801 }
4798 4802
4799 HACK_O_MATIC (string, "string-header-storage", pl); 4803 pl = gc_plist_hack ("long-string-chars-storage-overhead",
4804 gc_count_long_string_storage_including_overhead -
4805 (gc_count_string_total_size
4806 - gc_count_short_string_total_size), pl);
4807 pl = gc_plist_hack ("long-string-chars-storage",
4808 gc_count_string_total_size
4809 - gc_count_short_string_total_size, pl);
4810 do
4811 {
4812 COUNT_FROB_BLOCK_USAGE (string_chars);
4813 tgu_val += s + s_overhead;
4814 pl = gc_plist_hack ("short-string-chars-storage-overhead", s_overhead, pl);
4815 pl = gc_plist_hack ("short-string-chars-storage", s, pl);
4816 }
4817 while (0);
4818
4800 pl = gc_plist_hack ("long-strings-total-length", 4819 pl = gc_plist_hack ("long-strings-total-length",
4801 gc_count_string_total_size 4820 gc_count_string_total_size
4802 - gc_count_short_string_total_size, pl); 4821 - gc_count_short_string_total_size, pl);
4803 HACK_O_MATIC (string_chars, "short-string-storage", pl);
4804 pl = gc_plist_hack ("short-strings-total-length", 4822 pl = gc_plist_hack ("short-strings-total-length",
4805 gc_count_short_string_total_size, pl); 4823 gc_count_short_string_total_size, pl);
4806 pl = gc_plist_hack ("strings-free", gc_count_num_string_freelist, pl);
4807 pl = gc_plist_hack ("long-strings-used", 4824 pl = gc_plist_hack ("long-strings-used",
4808 gc_count_num_string_in_use 4825 gc_count_num_string_in_use
4809 - gc_count_num_short_string_in_use, pl); 4826 - gc_count_num_short_string_in_use, pl);
4810 pl = gc_plist_hack ("short-strings-used", 4827 pl = gc_plist_hack ("short-strings-used",
4811 gc_count_num_short_string_in_use, pl); 4828 gc_count_num_short_string_in_use, pl);
4812
4813 #undef HACK_O_MATIC
4814 4829
4815 #endif /* NEW_GC */ 4830 #endif /* NEW_GC */
4816 4831
4817 if (set_total_gc_usage) 4832 if (set_total_gc_usage)
4818 { 4833 {
5105 need_to_garbage_collect || 5120 need_to_garbage_collect ||
5106 need_to_check_c_alloca || 5121 need_to_check_c_alloca ||
5107 need_to_signal_post_gc; 5122 need_to_signal_post_gc;
5108 } 5123 }
5109 5124
5110
5111 int 5125 int
5112 object_dead_p (Lisp_Object obj) 5126 object_dead_p (Lisp_Object obj)
5113 { 5127 {
5114 return ((BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) || 5128 return ((BUFFERP (obj) && !BUFFER_LIVE_P (XBUFFER (obj))) ||
5115 (FRAMEP (obj) && !FRAME_LIVE_P (XFRAME (obj))) || 5129 (FRAMEP (obj) && !FRAME_LIVE_P (XFRAME (obj))) ||
5118 (CONSOLEP (obj) && !CONSOLE_LIVE_P (XCONSOLE (obj))) || 5132 (CONSOLEP (obj) && !CONSOLE_LIVE_P (XCONSOLE (obj))) ||
5119 (EVENTP (obj) && !EVENT_LIVE_P (XEVENT (obj))) || 5133 (EVENTP (obj) && !EVENT_LIVE_P (XEVENT (obj))) ||
5120 (EXTENTP (obj) && !EXTENT_LIVE_P (XEXTENT (obj)))); 5134 (EXTENTP (obj) && !EXTENT_LIVE_P (XEXTENT (obj))));
5121 } 5135 }
5122 5136
5123 #ifdef MEMORY_USAGE_STATS 5137 #ifdef ALLOC_TYPE_STATS
5124 5138
5125 /* Attempt to determine the actual amount of space that is used for 5139 /* Attempt to determine the actual amount of space that is used for
5126 the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE". 5140 the block allocated starting at PTR, supposedly of size "CLAIMED_SIZE".
5127 5141
5128 It seems that the following holds: 5142 It seems that the following holds:
5212 } 5226 }
5213 return claimed_size; 5227 return claimed_size;
5214 } 5228 }
5215 5229
5216 #ifndef NEW_GC 5230 #ifndef NEW_GC
5217 Bytecount 5231 static Bytecount
5218 fixed_type_block_overhead (Bytecount size) 5232 fixed_type_block_overhead (Bytecount size, Bytecount per_block)
5219 { 5233 {
5220 Bytecount per_block = TYPE_ALLOC_SIZE (cons, unsigned char);
5221 Bytecount overhead = 0; 5234 Bytecount overhead = 0;
5222 Bytecount storage_size = malloced_storage_size (0, per_block, 0); 5235 Bytecount storage_size = malloced_storage_size (0, per_block, 0);
5223 while (size >= per_block) 5236 while (size >= per_block)
5224 { 5237 {
5225 size -= per_block; 5238 size -= per_block;
5226 overhead += sizeof (void *) + per_block - storage_size; 5239 overhead += storage_size - per_block;
5227 } 5240 }
5228 if (rand () % per_block < size) 5241 if (rand () % per_block < size)
5229 overhead += sizeof (void *) + per_block - storage_size; 5242 overhead += storage_size - per_block;
5230 return overhead; 5243 return overhead;
5231 } 5244 }
5232 #endif /* not NEW_GC */ 5245 #endif /* not NEW_GC */
5233 #endif /* MEMORY_USAGE_STATS */ 5246
5247 Bytecount
5248 lisp_object_storage_size (Lisp_Object obj, struct usage_stats *ustats)
5249 {
5250 #ifndef NEW_GC
5251 const struct lrecord_implementation *imp =
5252 XRECORD_LHEADER_IMPLEMENTATION (obj);
5253 #endif /* not NEW_GC */
5254 Bytecount size = lisp_object_size (obj);
5255
5256 #ifdef NEW_GC
5257 return mc_alloced_storage_size (size, ustats);
5258 #else
5259 if (imp->frob_block_p)
5260 {
5261 Bytecount overhead =
5262 /* #### Always using cons_block is incorrect but close; only
5263 string_chars_block is significantly different in size, and
5264 it won't ever be seen in this function */
5265 fixed_type_block_overhead (size, sizeof (struct cons_block));
5266 if (ustats)
5267 {
5268 ustats->was_requested += size;
5269 ustats->malloc_overhead += overhead;
5270 }
5271 return size + overhead;
5272 }
5273 else
5274 return malloced_storage_size (XPNTR (obj), size, ustats);
5275 #endif
5276 }
5277
5278 #endif /* ALLOC_TYPE_STATS */
5234 5279
5235 5280
5281 /************************************************************************/
5282 /* Initialization */
5283 /************************************************************************/
5284
5236 /* Initialization */ 5285 /* Initialization */
5237 static void 5286 static void
5238 common_init_alloc_early (void) 5287 common_init_alloc_early (void)
5239 { 5288 {
5240 #ifndef Qzero 5289 #ifndef Qzero