xemacs-beta: src/alloc.c comparison

comparison src/alloc.c @ 2970:adda8fccb13d

[xemacs-hg @ 2005-10-04 16:43:29 by stephent] Improve style and documentation of `register-input-method

author	stephent
date	Tue, 04 Oct 2005 16:43:38 +0000
parents	05d62157e048
children	fb22a4eb2694

comparison

equal deleted inserted replaced

-:67a25e57557e
+:adda8fccb13d
 /* Storage allocation and gc for XEmacs Lisp interpreter.
 Copyright (C) 1985-1998 Free Software Foundation, Inc.
 Copyright (C) 1995 Sun Microsystems, Inc.
-Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004 Ben Wing.
+Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004, 2005 Ben Wing.
 This file is part of XEmacs.
 XEmacs is free software; you can redistribute it and/or modify it
 under the terms of the GNU General Public License as published by the
 #endif
 /* Number of bytes of consing done since the last gc */
 static EMACS_INT consing_since_gc;
 EMACS_UINT total_consing;
+EMACS_INT total_gc_usage;
+int total_gc_usage_set;
 int need_to_garbage_collect;
 int need_to_check_c_alloca;
 int need_to_signal_post_gc;
 int funcall_allocation_flag;
 	mark_object (bind->old_value);
 }
 }
 {
-struct catchtag *catch;
+struct catchtag *c;
-for (catch = catchlist; catch; catch = catch->next)
+for (c = catchlist; c; c = c->next)
 {
-	mark_object (catch->tag);
+	mark_object (c->tag);
-	mark_object (catch->val);
+	mark_object (c->val);
-	mark_object (catch->actual_tag);
+	mark_object (c->actual_tag);
-	mark_object (catch->backtrace);
+	mark_object (c->backtrace);
 }
 }
 {
 struct backtrace *backlist;
 }
 #else /* not MC_ALLOC */
 /* Debugging aids.  */
 static Lisp_Object
-gc_plist_hack (const Ascbyte *name, int value, Lisp_Object tail)
+gc_plist_hack (const Ascbyte *name, EMACS_INT value, Lisp_Object tail)
 {
 /* C doesn't have local functions (or closures, or GC, or readable syntax,
 or portable numeric datatypes, or bit-vectors, or characters, or
 arrays, or exceptions, or ...) */
 return cons3 (intern (name), make_int (value), tail);
 }
 #define HACK_O_MATIC(type, name, pl) do {				\
-int s = 0;								\
+EMACS_INT s = 0;							\
 struct type##_block *x = current_##type##_block;			\
 while (x) { s += sizeof (*x) + MALLOC_OVERHEAD; x = x->prev; }	\
+object_usage += s;							\
 (pl) = gc_plist_hack ((name), s, (pl));				\
 } while (0)
 DEFUN ("garbage-collect", Fgarbage_collect, 0, 0, "", /*
 Reclaim storage for Lisp objects no longer needed.
 ())
 {
 Lisp_Object pl = Qnil;
 int i;
 int gc_count_vector_total_size = 0;
+EMACS_INT object_usage = 0;
 garbage_collect_1 ();
 for (i = 0; i < lrecord_type_count; i++)
 {
 if (lcrecord_stats[i].bytes_in_use != 0
 || lcrecord_stats[i].bytes_freed != 0
 	    gc_count_vector_total_size =
 	      lcrecord_stats[i].bytes_in_use + lcrecord_stats[i].bytes_freed;
 sprintf (buf, "%s-storage", name);
 pl = gc_plist_hack (buf, lcrecord_stats[i].bytes_in_use, pl);
+	  object_usage += lcrecord_stats[i].bytes_in_use;
 	  /* Okay, simple pluralization check for `symbol-value-varalias' */
 	  if (name[len-1] == 's')
 	    sprintf (buf, "%ses-freed", name);
 	  else
 	    sprintf (buf, "%ss-freed", name);
 HACK_O_MATIC (cons, "cons-storage", pl);
 pl = gc_plist_hack ("conses-free", gc_count_num_cons_freelist, pl);
 pl = gc_plist_hack ("conses-used", gc_count_num_cons_in_use, pl);
+/* Record total usage for purposes of determining next GC */
+total_gc_usage = object_usage;
+total_gc_usage_set = 1;
 /* The things we do for backwards-compatibility */
 return
 list6 (Fcons (make_int (gc_count_num_cons_in_use),
 		  make_int (gc_count_num_cons_freelist)),
 	   Fcons (make_int (gc_count_num_symbol_in_use),
 {
 return make_int ((EMACS_INT) sbrk (0) / 1024);
 }
 #endif
-DEFUN ("memory-usage", Fmemory_usage, 0, 0, 0, /*
+DEFUN ("total-memory-usage", Ftotal_memory_usage, 0, 0, 0, /*
 Return the total number of bytes used by the data segment in XEmacs.
 This may be helpful in debugging XEmacs's memory usage.
+NOTE: This may or may not be accurate!  It is hard to determine this
+value in a system-independent fashion.
 */
 ())
 {
 return make_int (total_data_usage ());
+}
+DEFUN ("lisp-object-memory-usage", Flisp_object_memory_usage, 0, 0, 0, /*
+Return the total number of bytes used for object storage in XEmacs.
+This may be helpful in debugging XEmacs's memory usage.
+This value is only recomputed when garbage collection happens; thus, a
+better value of the real number of bytes used is
+(+ (lisp-object-memory-usage) (consing-since-gc))
+*/
+())
+{
+return make_int (total_gc_usage);
 }
 void
 recompute_funcall_allocation_flag (void)
 {
 if (always_gc)
 need_to_garbage_collect = 1;
 else
 need_to_garbage_collect =
 (consing_since_gc > gc_cons_threshold
+&&
 #if 0 /* #### implement this better */
-&&
 (100 * consing_since_gc) / total_data_usage () >=
 gc_cons_percentage
-#endif /* 0 */
+#else
+(!total_gc_usage_set ||
+	(100 * consing_since_gc) / total_gc_usage >=
+	gc_cons_percentage)
+#endif
 );
 recompute_funcall_allocation_flag ();
 }
 #if 1
 gc_cons_threshold = 500000; /* XEmacs change */
 #else
 gc_cons_threshold = 15000; /* debugging */
 #endif
-gc_cons_percentage = 0; /* #### 20; Don't have an accurate measure of
+gc_cons_percentage = 40; /* #### what is optimal? */
-			     memory usage on Windows; not verified on other
+total_gc_usage_set = 0;
-			     systems */
 lrecord_uid_counter = 259;
 #ifndef MC_ALLOC
 debug_string_purity = 0;
 #endif /* not MC_ALLOC */
 #endif /* MC_ALLOC_TYPE_STATS */
 DEFSUBR (Fgarbage_collect);
 #if 0
 DEFSUBR (Fmemory_limit);
 #endif
-DEFSUBR (Fmemory_usage);
+DEFSUBR (Ftotal_memory_usage);
+DEFSUBR (Flisp_object_memory_usage);
 DEFSUBR (Fconsing_since_gc);
 }
 void
 vars_of_alloc (void)
 happen at *EVERY* call to `eval' or `funcall'.  This is an extremely
 effective way to check GCPRO problems, but be warned that your XEmacs
 will be unusable!  You almost certainly won't have the patience to wait
 long enough to be able to set it back.
-See also `consing-since-gc'.
+See also `consing-since-gc' and `gc-cons-percentage'.
 */ );
 DEFVAR_INT ("gc-cons-percentage", &gc_cons_percentage /*
 *Percentage of memory allocated between garbage collections.
 Garbage collection will happen if this percentage of the total amount of
-memory used for data has been allocated since the last garbage collection.
+memory used for data (see `lisp-object-memory-usage') has been allocated
-However, it will not happen if less than `gc-cons-threshold' bytes have
+since the last garbage collection.  However, it will not happen if less
-been allocated -- this sets an absolute minimum in case very little data
+than `gc-cons-threshold' bytes have been allocated -- this sets an absolute
-has been allocated or the percentage is set very low.  Set this to 0 to
+minimum in case very little data has been allocated or the percentage is
-have garbage collection always happen after `gc-cons-threshold' bytes have
+set very low.  Set this to 0 to have garbage collection always happen after
-been allocated, regardless of current memory usage.
+`gc-cons-threshold' bytes have been allocated, regardless of current memory
+usage.
-Garbage collection happens automatically when `eval' or `funcall' are
-called.  (Note that `funcall' is called implicitly as part of evaluation.)
+See also `consing-since-gc' and `gc-cons-threshold'.
-By binding this temporarily to a large number, you can effectively
-prevent garbage collection during a part of the program.
-See also `consing-since-gc'.
 */ );
 #ifdef DEBUG_XEMACS
 DEFVAR_INT ("debug-allocation", &debug_allocation /*
 If non-zero, print out information to stderr about all objects allocated.

Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 2970:adda8fccb13d