Mercurial > hg > xemacs-beta
comparison src/alloc.c @ 2971:fb22a4eb2694
[xemacs-hg @ 2005-10-04 16:47:10 by stephent]
undo accidental commit
author | stephent |
---|---|
date | Tue, 04 Oct 2005 16:47:10 +0000 |
parents | adda8fccb13d |
children | ec5f23ea6d2e |
comparison
equal
deleted
inserted
replaced
2970:adda8fccb13d | 2971:fb22a4eb2694 |
---|---|
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, 2005 Ben Wing. | 4 Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004 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; | |
99 | 97 |
100 int need_to_garbage_collect; | 98 int need_to_garbage_collect; |
101 int need_to_check_c_alloca; | 99 int need_to_check_c_alloca; |
102 int need_to_signal_post_gc; | 100 int need_to_signal_post_gc; |
103 int funcall_allocation_flag; | 101 int funcall_allocation_flag; |
5525 mark_object (bind->old_value); | 5523 mark_object (bind->old_value); |
5526 } | 5524 } |
5527 } | 5525 } |
5528 | 5526 |
5529 { | 5527 { |
5530 struct catchtag *c; | 5528 struct catchtag *catch; |
5531 for (c = catchlist; c; c = c->next) | 5529 for (catch = catchlist; catch; catch = catch->next) |
5532 { | 5530 { |
5533 mark_object (c->tag); | 5531 mark_object (catch->tag); |
5534 mark_object (c->val); | 5532 mark_object (catch->val); |
5535 mark_object (c->actual_tag); | 5533 mark_object (catch->actual_tag); |
5536 mark_object (c->backtrace); | 5534 mark_object (catch->backtrace); |
5537 } | 5535 } |
5538 } | 5536 } |
5539 | 5537 |
5540 { | 5538 { |
5541 struct backtrace *backlist; | 5539 struct backtrace *backlist; |
5769 } | 5767 } |
5770 #else /* not MC_ALLOC */ | 5768 #else /* not MC_ALLOC */ |
5771 /* Debugging aids. */ | 5769 /* Debugging aids. */ |
5772 | 5770 |
5773 static Lisp_Object | 5771 static Lisp_Object |
5774 gc_plist_hack (const Ascbyte *name, EMACS_INT value, Lisp_Object tail) | 5772 gc_plist_hack (const Ascbyte *name, int value, Lisp_Object tail) |
5775 { | 5773 { |
5776 /* C doesn't have local functions (or closures, or GC, or readable syntax, | 5774 /* C doesn't have local functions (or closures, or GC, or readable syntax, |
5777 or portable numeric datatypes, or bit-vectors, or characters, or | 5775 or portable numeric datatypes, or bit-vectors, or characters, or |
5778 arrays, or exceptions, or ...) */ | 5776 arrays, or exceptions, or ...) */ |
5779 return cons3 (intern (name), make_int (value), tail); | 5777 return cons3 (intern (name), make_int (value), tail); |
5780 } | 5778 } |
5781 | 5779 |
5782 #define HACK_O_MATIC(type, name, pl) do { \ | 5780 #define HACK_O_MATIC(type, name, pl) do { \ |
5783 EMACS_INT s = 0; \ | 5781 int s = 0; \ |
5784 struct type##_block *x = current_##type##_block; \ | 5782 struct type##_block *x = current_##type##_block; \ |
5785 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \ | 5783 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; } \ |
5786 object_usage += s; \ | |
5787 (pl) = gc_plist_hack ((name), s, (pl)); \ | 5784 (pl) = gc_plist_hack ((name), s, (pl)); \ |
5788 } while (0) | 5785 } while (0) |
5789 | 5786 |
5790 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /* | 5787 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /* |
5791 Reclaim storage for Lisp objects no longer needed. | 5788 Reclaim storage for Lisp objects no longer needed. |
5801 ()) | 5798 ()) |
5802 { | 5799 { |
5803 Lisp_Object pl = Qnil; | 5800 Lisp_Object pl = Qnil; |
5804 int i; | 5801 int i; |
5805 int gc_count_vector_total_size = 0; | 5802 int gc_count_vector_total_size = 0; |
5806 EMACS_INT object_usage = 0; | |
5807 | |
5808 garbage_collect_1 (); | 5803 garbage_collect_1 (); |
5809 | |
5810 | 5804 |
5811 for (i = 0; i < lrecord_type_count; i++) | 5805 for (i = 0; i < lrecord_type_count; i++) |
5812 { | 5806 { |
5813 if (lcrecord_stats[i].bytes_in_use != 0 | 5807 if (lcrecord_stats[i].bytes_in_use != 0 |
5814 || lcrecord_stats[i].bytes_freed != 0 | 5808 || lcrecord_stats[i].bytes_freed != 0 |
5822 gc_count_vector_total_size = | 5816 gc_count_vector_total_size = |
5823 lcrecord_stats[i].bytes_in_use + lcrecord_stats[i].bytes_freed; | 5817 lcrecord_stats[i].bytes_in_use + lcrecord_stats[i].bytes_freed; |
5824 | 5818 |
5825 sprintf (buf, "%s-storage", name); | 5819 sprintf (buf, "%s-storage", name); |
5826 pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl); | 5820 pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl); |
5827 object_usage += lcrecord_stats[i].bytes_in_use; | |
5828 /* Okay, simple pluralization check for `symbol-value-varalias' */ | 5821 /* Okay, simple pluralization check for `symbol-value-varalias' */ |
5829 if (name[len-1] == 's') | 5822 if (name[len-1] == 's') |
5830 sprintf (buf, "%ses-freed", name); | 5823 sprintf (buf, "%ses-freed", name); |
5831 else | 5824 else |
5832 sprintf (buf, "%ss-freed", name); | 5825 sprintf (buf, "%ss-freed", name); |
5900 | 5893 |
5901 HACK_O_MATIC (cons, "cons-storage", pl); | 5894 HACK_O_MATIC (cons, "cons-storage", pl); |
5902 pl = gc_plist_hack ("conses-free", gc_count_num_cons_freelist, pl); | 5895 pl = gc_plist_hack ("conses-free", gc_count_num_cons_freelist, pl); |
5903 pl = gc_plist_hack ("conses-used", gc_count_num_cons_in_use, pl); | 5896 pl = gc_plist_hack ("conses-used", gc_count_num_cons_in_use, pl); |
5904 | 5897 |
5905 /* Record total usage for purposes of determining next GC */ | |
5906 total_gc_usage = object_usage; | |
5907 total_gc_usage_set = 1; | |
5908 | |
5909 /* The things we do for backwards-compatibility */ | 5898 /* The things we do for backwards-compatibility */ |
5910 return | 5899 return |
5911 list6 (Fcons (make_int (gc_count_num_cons_in_use), | 5900 list6 (Fcons (make_int (gc_count_num_cons_in_use), |
5912 make_int (gc_count_num_cons_freelist)), | 5901 make_int (gc_count_num_cons_freelist)), |
5913 Fcons (make_int (gc_count_num_symbol_in_use), | 5902 Fcons (make_int (gc_count_num_symbol_in_use), |
5943 { | 5932 { |
5944 return make_int ((EMACS_INT) sbrk (0) / 1024); | 5933 return make_int ((EMACS_INT) sbrk (0) / 1024); |
5945 } | 5934 } |
5946 #endif | 5935 #endif |
5947 | 5936 |
5948 DEFUN ("total-memory-usage", Ftotal_memory_usage, 0, 0, 0, /* | 5937 DEFUN ("memory-usage", Fmemory_usage, 0, 0, 0, /* |
5949 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. |
5950 This may be helpful in debugging XEmacs's memory usage. | 5939 This may be helpful in debugging XEmacs's memory usage. |
5951 NOTE: This may or may not be accurate! It is hard to determine this | |
5952 value in a system-independent fashion. | |
5953 */ | 5940 */ |
5954 ()) | 5941 ()) |
5955 { | 5942 { |
5956 return make_int (total_data_usage ()); | 5943 return make_int (total_data_usage ()); |
5957 } | |
5958 | |
5959 DEFUN ("lisp-object-memory-usage", Flisp_object_memory_usage, 0, 0, 0, /* | |
5960 Return the total number of bytes used for object storage in XEmacs. | |
5961 This may be helpful in debugging XEmacs's memory usage. | |
5962 This value is only recomputed when garbage collection happens; thus, a | |
5963 better value of the real number of bytes used is | |
5964 (+ (lisp-object-memory-usage) (consing-since-gc)) | |
5965 */ | |
5966 ()) | |
5967 { | |
5968 return make_int (total_gc_usage); | |
5969 } | 5944 } |
5970 | 5945 |
5971 void | 5946 void |
5972 recompute_funcall_allocation_flag (void) | 5947 recompute_funcall_allocation_flag (void) |
5973 { | 5948 { |
5984 if (always_gc) | 5959 if (always_gc) |
5985 need_to_garbage_collect = 1; | 5960 need_to_garbage_collect = 1; |
5986 else | 5961 else |
5987 need_to_garbage_collect = | 5962 need_to_garbage_collect = |
5988 (consing_since_gc > gc_cons_threshold | 5963 (consing_since_gc > gc_cons_threshold |
5964 #if 0 /* #### implement this better */ | |
5989 && | 5965 && |
5990 #if 0 /* #### implement this better */ | |
5991 (100 * consing_since_gc) / total_data_usage () >= | 5966 (100 * consing_since_gc) / total_data_usage () >= |
5992 gc_cons_percentage | 5967 gc_cons_percentage |
5993 #else | 5968 #endif /* 0 */ |
5994 (!total_gc_usage_set || | |
5995 (100 * consing_since_gc) / total_gc_usage >= | |
5996 gc_cons_percentage) | |
5997 #endif | |
5998 ); | 5969 ); |
5999 recompute_funcall_allocation_flag (); | 5970 recompute_funcall_allocation_flag (); |
6000 } | 5971 } |
6001 | 5972 |
6002 | 5973 |
6247 #if 1 | 6218 #if 1 |
6248 gc_cons_threshold = 500000; /* XEmacs change */ | 6219 gc_cons_threshold = 500000; /* XEmacs change */ |
6249 #else | 6220 #else |
6250 gc_cons_threshold = 15000; /* debugging */ | 6221 gc_cons_threshold = 15000; /* debugging */ |
6251 #endif | 6222 #endif |
6252 gc_cons_percentage = 40; /* #### what is optimal? */ | 6223 gc_cons_percentage = 0; /* #### 20; Don't have an accurate measure of |
6253 total_gc_usage_set = 0; | 6224 memory usage on Windows; not verified on other |
6225 systems */ | |
6254 lrecord_uid_counter = 259; | 6226 lrecord_uid_counter = 259; |
6255 #ifndef MC_ALLOC | 6227 #ifndef MC_ALLOC |
6256 debug_string_purity = 0; | 6228 debug_string_purity = 0; |
6257 #endif /* not MC_ALLOC */ | 6229 #endif /* not MC_ALLOC */ |
6258 | 6230 |
6380 #endif /* MC_ALLOC_TYPE_STATS */ | 6352 #endif /* MC_ALLOC_TYPE_STATS */ |
6381 DEFSUBR (Fgarbage_collect); | 6353 DEFSUBR (Fgarbage_collect); |
6382 #if 0 | 6354 #if 0 |
6383 DEFSUBR (Fmemory_limit); | 6355 DEFSUBR (Fmemory_limit); |
6384 #endif | 6356 #endif |
6385 DEFSUBR (Ftotal_memory_usage); | 6357 DEFSUBR (Fmemory_usage); |
6386 DEFSUBR (Flisp_object_memory_usage); | |
6387 DEFSUBR (Fconsing_since_gc); | 6358 DEFSUBR (Fconsing_since_gc); |
6388 } | 6359 } |
6389 | 6360 |
6390 void | 6361 void |
6391 vars_of_alloc (void) | 6362 vars_of_alloc (void) |
6413 happen at *EVERY* call to `eval' or `funcall'. This is an extremely | 6384 happen at *EVERY* call to `eval' or `funcall'. This is an extremely |
6414 effective way to check GCPRO problems, but be warned that your XEmacs | 6385 effective way to check GCPRO problems, but be warned that your XEmacs |
6415 will be unusable! You almost certainly won't have the patience to wait | 6386 will be unusable! You almost certainly won't have the patience to wait |
6416 long enough to be able to set it back. | 6387 long enough to be able to set it back. |
6417 | 6388 |
6418 See also `consing-since-gc' and `gc-cons-percentage'. | 6389 See also `consing-since-gc'. |
6419 */ ); | 6390 */ ); |
6420 | 6391 |
6421 DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /* | 6392 DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /* |
6422 *Percentage of memory allocated between garbage collections. | 6393 *Percentage of memory allocated between garbage collections. |
6423 | 6394 |
6424 Garbage collection will happen if this percentage of the total amount of | 6395 Garbage collection will happen if this percentage of the total amount of |
6425 memory used for data (see `lisp-object-memory-usage') has been allocated | 6396 memory used for data has been allocated since the last garbage collection. |
6426 since the last garbage collection. However, it will not happen if less | 6397 However, it will not happen if less than `gc-cons-threshold' bytes have |
6427 than `gc-cons-threshold' bytes have been allocated -- this sets an absolute | 6398 been allocated -- this sets an absolute minimum in case very little data |
6428 minimum in case very little data has been allocated or the percentage is | 6399 has been allocated or the percentage is set very low. Set this to 0 to |
6429 set very low. Set this to 0 to have garbage collection always happen after | 6400 have garbage collection always happen after `gc-cons-threshold' bytes have |
6430 `gc-cons-threshold' bytes have been allocated, regardless of current memory | 6401 been allocated, regardless of current memory usage. |
6431 usage. | 6402 |
6432 | 6403 Garbage collection happens automatically when `eval' or `funcall' are |
6433 See also `consing-since-gc' and `gc-cons-threshold'. | 6404 called. (Note that `funcall' is called implicitly as part of evaluation.) |
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'. | |
6434 */ ); | 6409 */ ); |
6435 | 6410 |
6436 #ifdef DEBUG_XEMACS | 6411 #ifdef DEBUG_XEMACS |
6437 DEFVAR_INT ("debug-allocation", &debug_allocation /* | 6412 DEFVAR_INT ("debug-allocation", &debug_allocation /* |
6438 If non-zero, print out information to stderr about all objects allocated. | 6413 If non-zero, print out information to stderr about all objects allocated. |