diff src/alloc.c @ 801:2b676dc88c66

[xemacs-hg @ 2002-04-01 03:58:02 by ben] bug fixes (e.g. ballooning on X windows) Makefile.in.in: Try to make the Makefile notice if its source Makefile.in.in is changed, and regenerate and run itself. Use a bigger default SHEAP_ADJUSTMENT on Cygwin; otherwise you can't compile under Mule if a Lisp file has changed. (can't run temacs) TODO.ben-mule-21-5: update. mule/mule-cmds.el: Hash the result of mswindows-get-language-environment-from-locale, since it's very expensive (and causes huge ballooning of memory under X Windows, since it's called from x-get-resource). cl-extra.el, code-files.el, files.el, simple.el, subr.el, x-faces.el: Create new string-equal-ignore-case, based on built-in compare-strings -- compare strings ignoring case without the need to generate garbage by calling downcase. Use it in equalp and elsewhere. alloc.c, bytecode.c, chartab.c, data.c, elhash.c, emacs.c, eval.c, event-Xt.c, event-unixoid.c, extents.c, file-coding.c, fileio.c, fns.c, glyphs.c, gutter.c, lisp-union.h, lisp.h, mule-charset.c, nt.c, process-unix.c, process.c, specifier.c, symbols.c, sysdep.c, sysdep.h, text.c, toolbar.c: Try to implement GC triggering based on percentage of total memory usage. Not currently activated (percentage set to 0) because not quite working. Add `memory-usage' primitive to return XEmacs' idea of its memory usage. Add primitive compare-strings, compatible with FSF 21.1 -- can compare any part of two strings, optionally ignoring case. Improve qxe() functions in text.c for text comparison. Use RETURN_NOT_REACHED to try to avoid warnings about unreachable code. Add volatile_make_int() to fix warning in unix_send_process().
author ben
date Mon, 01 Apr 2002 03:59:04 +0000
parents a5954632b187
children a634e3b7acc8
line wrap: on
line diff
--- a/src/alloc.c	Sun Mar 31 08:30:17 2002 +0000
+++ b/src/alloc.c	Mon Apr 01 03:59:04 2002 +0000
@@ -100,20 +100,22 @@
 } while (0)
 
 #ifdef DEBUG_XEMACS
-#define INCREMENT_CONS_COUNTER(foosize, type)			\
-  do {								\
-    if (debug_allocation)					\
-      {								\
-	stderr_out ("allocating %s (size %ld)\n", type, (long)foosize);	\
-	debug_allocation_backtrace ();				\
-      }								\
-    INCREMENT_CONS_COUNTER_1 (foosize);				\
+#define INCREMENT_CONS_COUNTER(foosize, type)		\
+  do {							\
+    if (debug_allocation)				\
+      {							\
+	stderr_out ("allocating %s (size %ld)\n", type,	\
+		    (long) foosize);			\
+	debug_allocation_backtrace ();			\
+      }							\
+    INCREMENT_CONS_COUNTER_1 (foosize);			\
   } while (0)
 #define NOSEEUM_INCREMENT_CONS_COUNTER(foosize, type)		\
   do {								\
     if (debug_allocation > 1)					\
       {								\
-	stderr_out ("allocating noseeum %s (size %ld)\n", type, (long)foosize); \
+	stderr_out ("allocating noseeum %s (size %ld)\n", type,	\
+		    (long) foosize);				\
 	debug_allocation_backtrace ();				\
       }								\
     INCREMENT_CONS_COUNTER_1 (foosize);				\
@@ -131,7 +133,16 @@
 } while (0)
 
 /* Number of bytes of consing since gc before another gc should be done. */
-EMACS_INT gc_cons_threshold;
+static EMACS_INT gc_cons_threshold;
+
+/* Percentage of consing of total data size before another GC. */
+static EMACS_INT gc_cons_percentage;
+
+#ifdef ERROR_CHECK_GC
+int always_gc;			/* Debugging hack */
+#else
+#define always_gc 0
+#endif
 
 /* Nonzero during gc */
 int gc_in_progress;
@@ -167,6 +178,11 @@
 
 #endif
 
+/* Very cheesy ways of figuring out how much memory is being used for
+   data. #### Need better (system-dependent) ways. */
+void *minimum_address_seen;
+void *maximum_address_seen;
+
 int
 c_readonly (Lisp_Object obj)
 {
@@ -239,15 +255,33 @@
   out_of_memory ("Memory exhausted", Qunbound);
 }
 
-/* like malloc and realloc but check for no memory left, and block input. */
+static void
+set_alloc_mins_and_maxes (void *val, Bytecount size)
+{
+  if (!val)
+    return;
+  if ((char *) val + size > (char *) maximum_address_seen)
+    maximum_address_seen = (char *) val + size;
+  if (!minimum_address_seen)
+    minimum_address_seen =
+#if SIZEOF_VOID_P == 8
+      (void *) 0xFFFFFFFFFFFFFFFF;
+#else
+      (void *) 0xFFFFFFFF;
+#endif
+  if ((char *) val < (char *) minimum_address_seen)
+    minimum_address_seen = (char *) val;
+}
+
+/* like malloc and realloc but check for no memory left. */
 
 #undef xmalloc
 void *
 xmalloc (Bytecount size)
 {
   void *val = malloc (size);
-
   if (!val && (size != 0)) memory_full ();
+  set_alloc_mins_and_maxes (val, size);
   return val;
 }
 
@@ -258,6 +292,7 @@
   void *val = calloc (nelem, elsize);
 
   if (!val && (nelem != 0)) memory_full ();
+  set_alloc_mins_and_maxes (val, nelem * elsize);
   return val;
 }
 
@@ -274,6 +309,7 @@
   block = realloc (block, size);
 
   if (!block && (size != 0)) memory_full ();
+  set_alloc_mins_and_maxes (block, size);
   return block;
 }
 
@@ -3900,8 +3936,8 @@
 
 #if 0
 DEFUN ("memory-limit", Fmemory_limit, 0, 0, 0, /*
-Return the address of the last byte Emacs has allocated, divided by 1024.
-This may be helpful in debugging Emacs's memory usage.
+Return the address of the last byte XEmacs has allocated, divided by 1024.
+This may be helpful in debugging XEmacs's memory usage.
 The value is divided by 1024 to make sure it will fit in a lisp integer.
 */
        ())
@@ -3910,6 +3946,27 @@
 }
 #endif
 
+DEFUN ("memory-usage", Fmemory_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.
+*/
+       ())
+{
+  return make_int (total_data_usage ());
+}
+
+/* True if it's time to garbage collect now. */
+int
+need_to_garbage_collect (void)
+{
+  if (always_gc)
+    return 1;
+  
+  return (consing_since_gc > gc_cons_threshold &&
+	  (100 * consing_since_gc) / total_data_usage () >=
+	  gc_cons_percentage);
+}
+
 
 int
 object_dead_p (Lisp_Object obj)
@@ -4117,6 +4174,9 @@
 #else
   gc_cons_threshold = 15000; /* debugging */
 #endif
+  gc_cons_percentage = 0; /* #### 20; Don't have an accurate measure of
+			     memory usage on Windows; not verified on other
+			     systems */
   lrecord_uid_counter = 259;
   debug_string_purity = 0;
   gcprolist = 0;
@@ -4215,6 +4275,7 @@
 #if 0
   DEFSUBR (Fmemory_limit);
 #endif
+  DEFSUBR (Fmemory_usage);
   DEFSUBR (Fconsing_since_gc);
 }
 
@@ -4236,6 +4297,25 @@
 See also `consing-since-gc'.
 */ );
 
+  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.
+However, it will not happen if less than `gc-cons-threshold' bytes have
+been allocated -- this sets an absolute minimum in case very little data
+has been allocated or the percentage is set very low.  Set this to 0 to
+have garbage collection always happen after `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.)
+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.