Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 2994:ec5f23ea6d2e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-10-14 01:21:57 by ben] add gc percentage threshold to mc-alloc config.h.in, alloc.c, dumper.c, emacs.c, lrecord.h, mc-alloc.c, mc-alloc.h, symbols.c: Rename MC_ALLOC_TYPE_STATS to ALLOC_TYPE_STATS, since (with refactoring) this is not really specific to mc-alloc. Generalize code to implement the GC % threshold for garbage collecting. Rename `lrecord-stats' to `object-memory-usage-stats' (defined when not mc-alloc, too). Rename `memory-usage' to `total-memory-usage' and add `object-memory-usage'. Bump gc_cons_threshold to 2,000,000 (suggestion by Stephen Turnbull). Avoid use of C++ reserved word `catch'. Change address for crash reporting to xemacs-beta@xemacs.org from crashes@xemacs.org. new -> new_ in emacs.c. Turn on _CRT_SECURE_NO_DEPRECATE under Visual C++ to avoid tons of warnings in VC8.
author ben
date Fri, 14 Oct 2005 01:22:01 +0000
parents fb22a4eb2694
children 1e7cc382eb16
comparison
equal deleted inserted replaced
2993:49316578f12d 2994:ec5f23ea6d2e
1 /* Storage allocation and gc for XEmacs Lisp interpreter. 1 /* Storage allocation and gc for XEmacs Lisp interpreter.
2 Copyright (C) 1985-1998 Free Software Foundation, Inc. 2 Copyright (C) 1985-1998 Free Software Foundation, Inc.
3 Copyright (C) 1995 Sun Microsystems, Inc. 3 Copyright (C) 1995 Sun Microsystems, Inc.
4 Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004 Ben Wing. 4 Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005 Ben Wing.
5 5
6 This file is part of XEmacs. 6 This file is part of XEmacs.
7 7
8 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the 9 under the terms of the GNU General Public License as published by the
92 #endif 92 #endif
93 93
94 /* Number of bytes of consing done since the last gc */ 94 /* Number of bytes of consing done since the last gc */
95 static EMACS_INT consing_since_gc; 95 static EMACS_INT consing_since_gc;
96 EMACS_UINT total_consing; 96 EMACS_UINT total_consing;
97 EMACS_INT total_gc_usage;
98 int total_gc_usage_set;
97 99
98 int need_to_garbage_collect; 100 int need_to_garbage_collect;
99 int need_to_check_c_alloca; 101 int need_to_check_c_alloca;
100 int need_to_signal_post_gc; 102 int need_to_signal_post_gc;
101 int funcall_allocation_flag; 103 int funcall_allocation_flag;
508 510
509 return val; 511 return val;
510 } 512 }
511 #endif /* not MC_ALLOC */ 513 #endif /* not MC_ALLOC */
512 514
513 #ifdef MC_ALLOC_TYPE_STATS 515 #if defined (MC_ALLOC) && defined (ALLOC_TYPE_STATS)
514 static struct 516 static struct
515 { 517 {
516 int instances_in_use; 518 int instances_in_use;
517 int bytes_in_use; 519 int bytes_in_use;
518 int bytes_in_use_including_overhead; 520 int bytes_in_use_including_overhead;
577 lrecord_stats[type_index].bytes_in_use_including_overhead 579 lrecord_stats[type_index].bytes_in_use_including_overhead
578 -= size_including_overhead; 580 -= size_including_overhead;
579 581
580 DECREMENT_CONS_COUNTER (size); 582 DECREMENT_CONS_COUNTER (size);
581 } 583 }
582 #endif /* not MC_ALLOC_TYPE_STATS */ 584 #endif /* not (MC_ALLOC && ALLOC_TYPE_STATS) */
583 585
584 #ifndef MC_ALLOC 586 #ifndef MC_ALLOC
585 /* lcrecords are chained together through their "next" field. 587 /* lcrecords are chained together through their "next" field.
586 After doing the mark phase, GC will walk this linked list 588 After doing the mark phase, GC will walk this linked list
587 and free any lcrecord which hasn't been marked. */ 589 and free any lcrecord which hasn't been marked. */
603 605
604 lheader = (struct lrecord_header *) mc_alloc (size); 606 lheader = (struct lrecord_header *) mc_alloc (size);
605 gc_checking_assert (LRECORD_FREE_P (lheader)); 607 gc_checking_assert (LRECORD_FREE_P (lheader));
606 set_lheader_implementation (lheader, implementation); 608 set_lheader_implementation (lheader, implementation);
607 lheader->uid = lrecord_uid_counter++; 609 lheader->uid = lrecord_uid_counter++;
608 #ifdef MC_ALLOC_TYPE_STATS 610 #ifdef ALLOC_TYPE_STATS
609 inc_lrecord_stats (size, lheader); 611 inc_lrecord_stats (size, lheader);
610 #endif /* not MC_ALLOC_TYPE_STATS */ 612 #endif /* ALLOC_TYPE_STATS */
611 INCREMENT_CONS_COUNTER (size, implementation->name); 613 INCREMENT_CONS_COUNTER (size, implementation->name);
612 return lheader; 614 return lheader;
613 } 615 }
614 616
615 void * 617 void *
625 627
626 lheader = (struct lrecord_header *) mc_alloc (size); 628 lheader = (struct lrecord_header *) mc_alloc (size);
627 gc_checking_assert (LRECORD_FREE_P (lheader)); 629 gc_checking_assert (LRECORD_FREE_P (lheader));
628 set_lheader_implementation (lheader, implementation); 630 set_lheader_implementation (lheader, implementation);
629 lheader->uid = lrecord_uid_counter++; 631 lheader->uid = lrecord_uid_counter++;
630 #ifdef MC_ALLOC_TYPE_STATS 632 #ifdef ALLOC_TYPE_STATS
631 inc_lrecord_stats (size, lheader); 633 inc_lrecord_stats (size, lheader);
632 #endif /* not MC_ALLOC_TYPE_STATS */ 634 #endif /* ALLOC_TYPE_STATS */
633 NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name); 635 NOSEEUM_INCREMENT_CONS_COUNTER (size, implementation->name);
634 return lheader; 636 return lheader;
635 } 637 }
636 638
637 void 639 void
2490 { 2492 {
2491 if (!for_disksave) 2493 if (!for_disksave)
2492 { 2494 {
2493 Lisp_String *s = (Lisp_String *) header; 2495 Lisp_String *s = (Lisp_String *) header;
2494 Bytecount size = s->size_; 2496 Bytecount size = s->size_;
2495 #ifdef MC_ALLOC_TYPE_STATS 2497 #ifdef ALLOC_TYPE_STATS
2496 dec_lrecord_string_data_stats (size); 2498 dec_lrecord_string_data_stats (size);
2497 #endif /* MC_ALLOC_TYPE_STATS */ 2499 #endif /* ALLOC_TYPE_STATS */
2498 if (BIG_STRING_SIZE_P (size)) 2500 if (BIG_STRING_SIZE_P (size))
2499 xfree (s->data_, Ibyte *); 2501 xfree (s->data_, Ibyte *);
2500 } 2502 }
2501 } 2503 }
2502 2504
2612 2614
2613 assert (length >= 0 && fullsize > 0); 2615 assert (length >= 0 && fullsize > 0);
2614 2616
2615 #ifdef MC_ALLOC 2617 #ifdef MC_ALLOC
2616 s = alloc_lrecord_type (Lisp_String, &lrecord_string); 2618 s = alloc_lrecord_type (Lisp_String, &lrecord_string);
2617 #ifdef MC_ALLOC_TYPE_STATS 2619 #ifdef ALLOC_TYPE_STATS
2618 inc_lrecord_string_data_stats (length); 2620 inc_lrecord_string_data_stats (length);
2619 #endif /* MC_ALLOC_TYPE_STATS */ 2621 #endif /* ALLOC_TYPE_STATS */
2620 #else /* not MC_ALLOC */ 2622 #else /* not MC_ALLOC */
2621 /* Allocate the string header */ 2623 /* Allocate the string header */
2622 ALLOCATE_FIXED_TYPE (string, Lisp_String, s); 2624 ALLOCATE_FIXED_TYPE (string, Lisp_String, s);
2623 xzero (*s); 2625 xzero (*s);
2624 set_lheader_implementation (&s->u.lheader, &lrecord_string); 2626 set_lheader_implementation (&s->u.lheader, &lrecord_string);
2998 bytecount_to_charcount (contents, length); /* Just for the assertions */ 3000 bytecount_to_charcount (contents, length); /* Just for the assertions */
2999 #endif 3001 #endif
3000 3002
3001 #ifdef MC_ALLOC 3003 #ifdef MC_ALLOC
3002 s = alloc_lrecord_type (Lisp_String, &lrecord_string); 3004 s = alloc_lrecord_type (Lisp_String, &lrecord_string);
3003 #ifdef MC_ALLOC_TYPE_STATS 3005 #ifdef ALLOC_TYPE_STATS
3004 inc_lrecord_string_data_stats (length); 3006 inc_lrecord_string_data_stats (length);
3005 #endif /* MC_ALLOC_TYPE_STATS */ 3007 #endif /* ALLOC_TYPE_STATS */
3006 mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get 3008 mcpro (wrap_pointer_1 (s)); /* otherwise nocopy_strings get
3007 collected and static data is tried to 3009 collected and static data is tried to
3008 be freed. */ 3010 be freed. */
3009 #else /* not MC_ALLOC */ 3011 #else /* not MC_ALLOC */
3010 /* Allocate the string header */ 3012 /* Allocate the string header */
5523 mark_object (bind->old_value); 5525 mark_object (bind->old_value);
5524 } 5526 }
5525 } 5527 }
5526 5528
5527 { 5529 {
5528 struct catchtag *catch; 5530 struct catchtag *c;
5529 for (catch = catchlist; catch; catch = catch->next) 5531 for (c = catchlist; c; c = c->next)
5530 { 5532 {
5531 mark_object (catch->tag); 5533 mark_object (c->tag);
5532 mark_object (catch->val); 5534 mark_object (c->val);
5533 mark_object (catch->actual_tag); 5535 mark_object (c->actual_tag);
5534 mark_object (catch->backtrace); 5536 mark_object (c->backtrace);
5535 } 5537 }
5536 } 5538 }
5537 5539
5538 { 5540 {
5539 struct backtrace *backlist; 5541 struct backtrace *backlist;
5665 PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection); 5667 PROFILE_RECORD_EXITING_SECTION (QSin_garbage_collection);
5666 5668
5667 return; 5669 return;
5668 } 5670 }
5669 5671
5670 #ifdef MC_ALLOC 5672 #ifdef ALLOC_TYPE_STATS
5671 #ifdef MC_ALLOC_TYPE_STATS 5673
5672 static Lisp_Object 5674 static Lisp_Object
5673 gc_plist_hack (const Ascbyte *name, int value, Lisp_Object tail) 5675 gc_plist_hack (const Ascbyte *name, EMACS_INT value, Lisp_Object tail)
5674 { 5676 {
5675 /* C doesn't have local functions (or closures, or GC, or readable syntax, 5677 /* C doesn't have local functions (or closures, or GC, or readable syntax,
5676 or portable numeric datatypes, or bit-vectors, or characters, or 5678 or portable numeric datatypes, or bit-vectors, or characters, or
5677 arrays, or exceptions, or ...) */ 5679 arrays, or exceptions, or ...) */
5678 return cons3 (intern (name), make_int (value), tail); 5680 return cons3 (intern (name), make_int (value), tail);
5679 } 5681 }
5680 5682
5681 DEFUN("lrecord-stats", Flrecord_stats, 0, 0 ,"", /* 5683 static Lisp_Object
5682 Return statistics about lrecords in a property list. 5684 object_memory_usage_stats (int set_total_gc_usage)
5683 */
5684 ())
5685 { 5685 {
5686 Lisp_Object pl = Qnil; 5686 Lisp_Object pl = Qnil;
5687 int i; 5687 int i;
5688 EMACS_INT tgu_val = 0;
5689
5690 #ifdef MC_ALLOC
5688 5691
5689 for (i = 0; i < (countof (lrecord_implementations_table) 5692 for (i = 0; i < (countof (lrecord_implementations_table)
5690 + MODULE_DEFINABLE_TYPE_COUNT); i++) 5693 + MODULE_DEFINABLE_TYPE_COUNT); i++)
5691 { 5694 {
5692 if (lrecord_stats[i].instances_in_use != 0) 5695 if (lrecord_stats[i].instances_in_use != 0)
5707 5710
5708 sprintf (buf, "%s-storage", name); 5711 sprintf (buf, "%s-storage", name);
5709 pl = gc_plist_hack (buf, 5712 pl = gc_plist_hack (buf,
5710 lrecord_stats[i].bytes_in_use, 5713 lrecord_stats[i].bytes_in_use,
5711 pl); 5714 pl);
5715 tgu_val += lrecord_stats[i].bytes_in_use_including_overhead;
5712 5716
5713 if (name[len-1] == 's') 5717 if (name[len-1] == 's')
5714 sprintf (buf, "%ses-used", name); 5718 sprintf (buf, "%ses-used", name);
5715 else 5719 else
5716 sprintf (buf, "%ss-used", name); 5720 sprintf (buf, "%ss-used", name);
5721 lrecord_string_data_bytes_in_use_including_overhead, pl); 5725 lrecord_string_data_bytes_in_use_including_overhead, pl);
5722 pl = gc_plist_hack ("string-data-storage-additional", 5726 pl = gc_plist_hack ("string-data-storage-additional",
5723 lrecord_string_data_bytes_in_use, pl); 5727 lrecord_string_data_bytes_in_use, pl);
5724 pl = gc_plist_hack ("string-data-used", 5728 pl = gc_plist_hack ("string-data-used",
5725 lrecord_string_data_instances_in_use, pl); 5729 lrecord_string_data_instances_in_use, pl);
5726 5730 tgu_val += lrecord_string_data_bytes_in_use_including_overhead;
5727 return pl; 5731
5728 }
5729 #endif /* not MC_ALLOC_TYPE_STATS */
5730
5731 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /*
5732 Reclaim storage for Lisp objects no longer needed.
5733 Return info on amount of space in use:
5734 ((USED-CONSES . STORAGE-CONSES) (USED-SYMS . STORAGE-SYMS)
5735 (USED-MARKERS . STORAGE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
5736 PLIST)
5737 where `PLIST' is a list of alternating keyword/value pairs providing
5738 more detailed information.
5739 Garbage collection happens automatically if you cons more than
5740 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.
5741 */
5742 ())
5743 {
5744 garbage_collect_1 ();
5745
5746 #ifdef MC_ALLOC_TYPE_STATS
5747 /* The things we do for backwards-compatibility */
5748 return
5749 list6
5750 (Fcons (make_int (lrecord_stats[lrecord_type_cons].instances_in_use),
5751 make_int (lrecord_stats[lrecord_type_cons]
5752 .bytes_in_use_including_overhead)),
5753 Fcons (make_int (lrecord_stats[lrecord_type_symbol].instances_in_use),
5754 make_int (lrecord_stats[lrecord_type_symbol]
5755 .bytes_in_use_including_overhead)),
5756 Fcons (make_int (lrecord_stats[lrecord_type_marker].instances_in_use),
5757 make_int (lrecord_stats[lrecord_type_marker]
5758 .bytes_in_use_including_overhead)),
5759 make_int (lrecord_stats[lrecord_type_string]
5760 .bytes_in_use_including_overhead),
5761 make_int (lrecord_stats[lrecord_type_vector]
5762 .bytes_in_use_including_overhead),
5763 Flrecord_stats ());
5764 #else /* not MC_ALLOC_TYPE_STATS */
5765 return Qnil;
5766 #endif /* not MC_ALLOC_TYPE_STATS */
5767 }
5768 #else /* not MC_ALLOC */ 5732 #else /* not MC_ALLOC */
5769 /* Debugging aids. */
5770
5771 static Lisp_Object
5772 gc_plist_hack (const Ascbyte *name, int value, Lisp_Object tail)
5773 {
5774 /* C doesn't have local functions (or closures, or GC, or readable syntax,
5775 or portable numeric datatypes, or bit-vectors, or characters, or
5776 arrays, or exceptions, or ...) */
5777 return cons3 (intern (name), make_int (value), tail);
5778 }
5779 5733
5780 #define HACK_O_MATIC(type, name, pl) do { \ 5734 #define HACK_O_MATIC(type, name, pl) do { \
5781 int s = 0; \ 5735 EMACS_INT s = 0; \
5782 struct type##_block *x = current_##type##_block; \ 5736 struct type##_block *x = current_##type##_block; \
5783 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \ 5737 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \
5738 tgu_val += s; \
5784 (pl) = gc_plist_hack ((name), s, (pl)); \ 5739 (pl) = gc_plist_hack ((name), s, (pl)); \
5785 } while (0) 5740 } while (0)
5786
5787 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /*
5788 Reclaim storage for Lisp objects no longer needed.
5789 Return info on amount of space in use:
5790 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
5791 (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
5792 PLIST)
5793 where `PLIST' is a list of alternating keyword/value pairs providing
5794 more detailed information.
5795 Garbage collection happens automatically if you cons more than
5796 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.
5797 */
5798 ())
5799 {
5800 Lisp_Object pl = Qnil;
5801 int i;
5802 int gc_count_vector_total_size = 0;
5803 garbage_collect_1 ();
5804 5741
5805 for (i = 0; i < lrecord_type_count; i++) 5742 for (i = 0; i < lrecord_type_count; i++)
5806 { 5743 {
5807 if (lcrecord_stats[i].bytes_in_use != 0 5744 if (lcrecord_stats[i].bytes_in_use != 0
5808 || lcrecord_stats[i].bytes_freed != 0 5745 || lcrecord_stats[i].bytes_freed != 0
5809 || lcrecord_stats[i].instances_on_free_list != 0) 5746 || lcrecord_stats[i].instances_on_free_list != 0)
5810 { 5747 {
5811 char buf [255]; 5748 char buf [255];
5812 const char *name = lrecord_implementations_table[i]->name; 5749 const char *name = lrecord_implementations_table[i]->name;
5813 int len = strlen (name); 5750 int len = strlen (name);
5814 /* save this for the FSFmacs-compatible part of the summary */
5815 if (i == lrecord_type_vector)
5816 gc_count_vector_total_size =
5817 lcrecord_stats[i].bytes_in_use + lcrecord_stats[i].bytes_freed;
5818 5751
5819 sprintf (buf, "%s-storage", name); 5752 sprintf (buf, "%s-storage", name);
5820 pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl); 5753 pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl);
5754 tgu_val += lcrecord_stats[i].bytes_in_use;
5821 /* Okay, simple pluralization check for `symbol-value-varalias' */ 5755 /* Okay, simple pluralization check for `symbol-value-varalias' */
5822 if (name[len-1] == 's') 5756 if (name[len-1] == 's')
5823 sprintf (buf, "%ses-freed", name); 5757 sprintf (buf, "%ses-freed", name);
5824 else 5758 else
5825 sprintf (buf, "%ss-freed", name); 5759 sprintf (buf, "%ss-freed", name);
5893 5827
5894 HACK_O_MATIC (cons, "cons-storage", pl); 5828 HACK_O_MATIC (cons, "cons-storage", pl);
5895 pl = gc_plist_hack ("conses-free", gc_count_num_cons_freelist, pl); 5829 pl = gc_plist_hack ("conses-free", gc_count_num_cons_freelist, pl);
5896 pl = gc_plist_hack ("conses-used", gc_count_num_cons_in_use, pl); 5830 pl = gc_plist_hack ("conses-used", gc_count_num_cons_in_use, pl);
5897 5831
5832 #undef HACK_O_MATIC
5833
5834 #endif /* MC_ALLOC */
5835
5836 if (set_total_gc_usage)
5837 {
5838 total_gc_usage = tgu_val;
5839 total_gc_usage_set = 1;
5840 }
5841
5842 return pl;
5843 }
5844
5845 DEFUN("object-memory-usage-stats", Fobject_memory_usage_stats, 0, 0 ,"", /*
5846 Return statistics about memory usage of Lisp objects.
5847 */
5848 ())
5849 {
5850 return object_memory_usage_stats (0);
5851 }
5852
5853 #endif /* ALLOC_TYPE_STATS */
5854
5855 /* Debugging aids. */
5856
5857 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /*
5858 Reclaim storage for Lisp objects no longer needed.
5859 Return info on amount of space in use:
5860 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
5861 (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
5862 PLIST)
5863 where `PLIST' is a list of alternating keyword/value pairs providing
5864 more detailed information.
5865 Garbage collection happens automatically if you cons more than
5866 `gc-cons-threshold' bytes of Lisp data since previous garbage collection.
5867 */
5868 ())
5869 {
5870 /* Record total usage for purposes of determining next GC */
5871 garbage_collect_1 ();
5872
5873 /* This will get set to 1, and total_gc_usage computed, as part of the
5874 call to object_memory_usage_stats() -- if ALLOC_TYPE_STATS is enabled. */
5875 total_gc_usage_set = 0;
5876 #ifdef ALLOC_TYPE_STATS
5898 /* The things we do for backwards-compatibility */ 5877 /* The things we do for backwards-compatibility */
5878 #ifdef MC_ALLOC
5879 return
5880 list6
5881 (Fcons (make_int (lrecord_stats[lrecord_type_cons].instances_in_use),
5882 make_int (lrecord_stats[lrecord_type_cons]
5883 .bytes_in_use_including_overhead)),
5884 Fcons (make_int (lrecord_stats[lrecord_type_symbol].instances_in_use),
5885 make_int (lrecord_stats[lrecord_type_symbol]
5886 .bytes_in_use_including_overhead)),
5887 Fcons (make_int (lrecord_stats[lrecord_type_marker].instances_in_use),
5888 make_int (lrecord_stats[lrecord_type_marker]
5889 .bytes_in_use_including_overhead)),
5890 make_int (lrecord_stats[lrecord_type_string]
5891 .bytes_in_use_including_overhead),
5892 make_int (lrecord_stats[lrecord_type_vector]
5893 .bytes_in_use_including_overhead),
5894 object_memory_usage_stats (1));
5895 #else /* not MC_ALLOC */
5899 return 5896 return
5900 list6 (Fcons (make_int (gc_count_num_cons_in_use), 5897 list6 (Fcons (make_int (gc_count_num_cons_in_use),
5901 make_int (gc_count_num_cons_freelist)), 5898 make_int (gc_count_num_cons_freelist)),
5902 Fcons (make_int (gc_count_num_symbol_in_use), 5899 Fcons (make_int (gc_count_num_symbol_in_use),
5903 make_int (gc_count_num_symbol_freelist)), 5900 make_int (gc_count_num_symbol_freelist)),
5904 Fcons (make_int (gc_count_num_marker_in_use), 5901 Fcons (make_int (gc_count_num_marker_in_use),
5905 make_int (gc_count_num_marker_freelist)), 5902 make_int (gc_count_num_marker_freelist)),
5906 make_int (gc_count_string_total_size), 5903 make_int (gc_count_string_total_size),
5907 make_int (gc_count_vector_total_size), 5904 make_int (lcrecord_stats[lrecord_type_vector].bytes_in_use +
5908 pl); 5905 lcrecord_stats[lrecord_type_vector].bytes_freed),
5909 } 5906 object_memory_usage_stats (1));
5910 #undef HACK_O_MATIC 5907 #endif /* not MC_ALLOC */
5911 #endif /* not MC_ALLOC */ 5908 #else /* not ALLOC_TYPE_STATS */
5909 return Qnil;
5910 #endif /* ALLOC_TYPE_STATS */
5911 }
5912 5912
5913 DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /* 5913 DEFUN ("consing-since-gc", Fconsing_since_gc, 0, 0, "", /*
5914 Return the number of bytes consed since the last garbage collection. 5914 Return the number of bytes consed since the last garbage collection.
5915 \"Consed\" is a misnomer in that this actually counts allocation 5915 \"Consed\" is a misnomer in that this actually counts allocation
5916 of all different kinds of objects, not just conses. 5916 of all different kinds of objects, not just conses.
5932 { 5932 {
5933 return make_int ((EMACS_INT) sbrk (0) / 1024); 5933 return make_int ((EMACS_INT) sbrk (0) / 1024);
5934 } 5934 }
5935 #endif 5935 #endif
5936 5936
5937 DEFUN ("memory-usage", Fmemory_usage, 0, 0, 0, /* 5937 DEFUN ("total-memory-usage", Ftotal_memory_usage, 0, 0, 0, /*
5938 Return the total number of bytes used by the data segment in XEmacs. 5938 Return the total number of bytes used by the data segment in XEmacs.
5939 This may be helpful in debugging XEmacs's memory usage. 5939 This may be helpful in debugging XEmacs's memory usage.
5940 NOTE: This may or may not be accurate! It is hard to determine this
5941 value in a system-independent fashion. On Windows, for example, the
5942 returned number tends to be much greater than reality.
5940 */ 5943 */
5941 ()) 5944 ())
5942 { 5945 {
5943 return make_int (total_data_usage ()); 5946 return make_int (total_data_usage ());
5944 } 5947 }
5948
5949 #ifdef ALLOC_TYPE_STATS
5950 DEFUN ("object-memory-usage", Fobject_memory_usage, 0, 0, 0, /*
5951 Return total number of bytes used for object storage in XEmacs.
5952 This may be helpful in debugging XEmacs's memory usage.
5953 See also `consing-since-gc' and `object-memory-usage-stats'.
5954 */
5955 ())
5956 {
5957 return make_int (total_gc_usage + consing_since_gc);
5958 }
5959 #endif /* ALLOC_TYPE_STATS */
5945 5960
5946 void 5961 void
5947 recompute_funcall_allocation_flag (void) 5962 recompute_funcall_allocation_flag (void)
5948 { 5963 {
5949 funcall_allocation_flag = 5964 funcall_allocation_flag =
5959 if (always_gc) 5974 if (always_gc)
5960 need_to_garbage_collect = 1; 5975 need_to_garbage_collect = 1;
5961 else 5976 else
5962 need_to_garbage_collect = 5977 need_to_garbage_collect =
5963 (consing_since_gc > gc_cons_threshold 5978 (consing_since_gc > gc_cons_threshold
5979 &&
5964 #if 0 /* #### implement this better */ 5980 #if 0 /* #### implement this better */
5965 &&
5966 (100 * consing_since_gc) / total_data_usage () >= 5981 (100 * consing_since_gc) / total_data_usage () >=
5967 gc_cons_percentage 5982 gc_cons_percentage
5968 #endif /* 0 */ 5983 #else
5984 (!total_gc_usage_set ||
5985 (100 * consing_since_gc) / total_gc_usage >=
5986 gc_cons_percentage)
5987 #endif
5969 ); 5988 );
5970 recompute_funcall_allocation_flag (); 5989 recompute_funcall_allocation_flag ();
5971 } 5990 }
5972 5991
5973 5992
6214 need_to_check_c_alloca = 0; 6233 need_to_check_c_alloca = 0;
6215 funcall_allocation_flag = 0; 6234 funcall_allocation_flag = 0;
6216 funcall_alloca_count = 0; 6235 funcall_alloca_count = 0;
6217 6236
6218 #if 1 6237 #if 1
6219 gc_cons_threshold = 500000; /* XEmacs change */ 6238 gc_cons_threshold = 2000000; /* XEmacs change */
6220 #else 6239 #else
6221 gc_cons_threshold = 15000; /* debugging */ 6240 gc_cons_threshold = 15000; /* debugging */
6222 #endif 6241 #endif
6223 gc_cons_percentage = 0; /* #### 20; Don't have an accurate measure of 6242 gc_cons_percentage = 40; /* #### what is optimal? */
6224 memory usage on Windows; not verified on other 6243 total_gc_usage_set = 0;
6225 systems */
6226 lrecord_uid_counter = 259; 6244 lrecord_uid_counter = 259;
6227 #ifndef MC_ALLOC 6245 #ifndef MC_ALLOC
6228 debug_string_purity = 0; 6246 debug_string_purity = 0;
6229 #endif /* not MC_ALLOC */ 6247 #endif /* not MC_ALLOC */
6230 6248
6345 DEFSUBR (Fmake_string); 6363 DEFSUBR (Fmake_string);
6346 DEFSUBR (Fstring); 6364 DEFSUBR (Fstring);
6347 DEFSUBR (Fmake_symbol); 6365 DEFSUBR (Fmake_symbol);
6348 DEFSUBR (Fmake_marker); 6366 DEFSUBR (Fmake_marker);
6349 DEFSUBR (Fpurecopy); 6367 DEFSUBR (Fpurecopy);
6350 #ifdef MC_ALLOC_TYPE_STATS 6368 #ifdef ALLOC_TYPE_STATS
6351 DEFSUBR (Flrecord_stats); 6369 DEFSUBR (Fobject_memory_usage_stats);
6352 #endif /* MC_ALLOC_TYPE_STATS */ 6370 DEFSUBR (Fobject_memory_usage);
6371 #endif /* ALLOC_TYPE_STATS */
6353 DEFSUBR (Fgarbage_collect); 6372 DEFSUBR (Fgarbage_collect);
6354 #if 0 6373 #if 0
6355 DEFSUBR (Fmemory_limit); 6374 DEFSUBR (Fmemory_limit);
6356 #endif 6375 #endif
6357 DEFSUBR (Fmemory_usage); 6376 DEFSUBR (Ftotal_memory_usage);
6358 DEFSUBR (Fconsing_since_gc); 6377 DEFSUBR (Fconsing_since_gc);
6359 } 6378 }
6360 6379
6361 void 6380 void
6362 vars_of_alloc (void) 6381 vars_of_alloc (void)
6384 happen at *EVERY* call to `eval' or `funcall'. This is an extremely 6403 happen at *EVERY* call to `eval' or `funcall'. This is an extremely
6385 effective way to check GCPRO problems, but be warned that your XEmacs 6404 effective way to check GCPRO problems, but be warned that your XEmacs
6386 will be unusable! You almost certainly won't have the patience to wait 6405 will be unusable! You almost certainly won't have the patience to wait
6387 long enough to be able to set it back. 6406 long enough to be able to set it back.
6388 6407
6389 See also `consing-since-gc'. 6408 See also `consing-since-gc' and `gc-cons-percentage'.
6390 */ ); 6409 */ );
6391 6410
6392 DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /* 6411 DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /*
6393 *Percentage of memory allocated between garbage collections. 6412 *Percentage of memory allocated between garbage collections.
6394 6413
6395 Garbage collection will happen if this percentage of the total amount of 6414 Garbage collection will happen if this percentage of the total amount of
6396 memory used for data has been allocated since the last garbage collection. 6415 memory used for data (see `lisp-object-memory-usage') has been allocated
6397 However, it will not happen if less than `gc-cons-threshold' bytes have 6416 since the last garbage collection. However, it will not happen if less
6398 been allocated -- this sets an absolute minimum in case very little data 6417 than `gc-cons-threshold' bytes have been allocated -- this sets an absolute
6399 has been allocated or the percentage is set very low. Set this to 0 to 6418 minimum in case very little data has been allocated or the percentage is
6400 have garbage collection always happen after `gc-cons-threshold' bytes have 6419 set very low. Set this to 0 to have garbage collection always happen after
6401 been allocated, regardless of current memory usage. 6420 `gc-cons-threshold' bytes have been allocated, regardless of current memory
6402 6421 usage.
6403 Garbage collection happens automatically when `eval' or `funcall' are 6422
6404 called. (Note that `funcall' is called implicitly as part of evaluation.) 6423 See also `consing-since-gc' and `gc-cons-threshold'.
6405 By binding this temporarily to a large number, you can effectively
6406 prevent garbage collection during a part of the program.
6407
6408 See also `consing-since-gc'.
6409 */ ); 6424 */ );
6410 6425
6411 #ifdef DEBUG_XEMACS 6426 #ifdef DEBUG_XEMACS
6412 DEFVAR_INT ("debug-allocation", &debug_allocation /* 6427 DEFVAR_INT ("debug-allocation", &debug_allocation /*
6413 If non-zero, print out information to stderr about all objects allocated. 6428 If non-zero, print out information to stderr about all objects allocated.