[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.3-41-g6360beb

[Andy Wingo]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=6360beb28a918448ed42b0ddb905b2d9d513d8b9

The branch, stable-2.0 has been updated
       via  6360beb28a918448ed42b0ddb905b2d9d513d8b9 (commit)
       via  14294ce0dfa315193a455a16dd5ab631bf037b78 (commit)
      from  59a0273338ca52dd920eef90439f95d313214a6b (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 6360beb28a918448ed42b0ddb905b2d9d513d8b9
Author: Andy Wingo <address@hidden>
Date:   Tue Nov 29 00:48:56 2011 +0100

    increase garbage collection rate if the process is growing
    
    * configure.ac: Check for GC_get_free_space_divisor.
    * libguile/gc.c (GC_get_free_space_divisor): Define an implementation,
      if needed.
      (accumulate_gc_timer): Fix indentation.
      (get_image_size): New terrible hack.  Needs implementations on other
      platforms.
      (adjust_gc_frequency): Attempt to adjust the GC frequency based on
      process image growth.  Needs more comments.
      (scm_init_gc): Add the adjust_gc_frequency to the after_gc_c_hook.

commit 14294ce0dfa315193a455a16dd5ab631bf037b78
Author: Andy Wingo <address@hidden>
Date:   Mon Nov 28 19:58:53 2011 +0100

    get heap stats with GC_get_heap_usage_safe, if available.
    
    * configure.ac: Check for GC_get_heap_usage_safe.
    * libguile/gc.c (SCM_DEFINE): Use GC_get_heap_usage_safe.

-----------------------------------------------------------------------

Summary of changes:
 configure.ac  |    2 +-
 libguile/gc.c |  176 ++++++++++++++++++++++++++++++++++++++++++++++++++++++---
 2 files changed, 169 insertions(+), 9 deletions(-)

diff --git a/configure.ac b/configure.ac
index 710cc2f..d63dd63 100644
--- a/configure.ac
+++ b/configure.ac
@@ -1259,7 +1259,7 @@ save_LIBS="$LIBS"
 LIBS="$BDW_GC_LIBS $LIBS"
 CFLAGS="$BDW_GC_CFLAGS $CFLAGS"
 
-AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit 
GC_pthread_cancel GC_allow_register_threads GC_pthread_sigmask 
GC_set_start_callback])
+AC_CHECK_FUNCS([GC_do_blocking GC_call_with_gc_active GC_pthread_exit 
GC_pthread_cancel GC_allow_register_threads GC_pthread_sigmask 
GC_set_start_callback GC_get_heap_usage_safe GC_get_free_space_divisor])
 
 # Though the `GC_do_blocking ()' symbol is present in GC 7.1, it is not
 # declared, and has a different type (returning void instead of
diff --git a/libguile/gc.c b/libguile/gc.c
index 23cc8a3..1687860 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -27,6 +27,7 @@
 #include <stdio.h>
 #include <errno.h>
 #include <string.h>
+#include <math.h>
 
 #ifdef __ia64__
 #include <ucontext.h>
@@ -193,6 +194,32 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, 
"set-debug-cell-accesses!", 1, 0, 0,
 #endif  /* SCM_DEBUG_CELL_ACCESSES == 1 */
 
 
+
+/* Compatibility.  */
+
+#ifndef HAVE_GC_GET_HEAP_USAGE_SAFE
+static void
+GC_get_heap_usage_safe (GC_word *pheap_size, GC_word *pfree_bytes,
+                        GC_word *punmapped_bytes, GC_word *pbytes_since_gc,
+                        GC_word *ptotal_bytes)
+{
+  *pheap_size = GC_get_heap_size ();
+  *pfree_bytes = GC_get_free_bytes ();
+  *punmapped_bytes = GC_get_unmapped_bytes ();
+  *pbytes_since_gc = GC_get_bytes_since_gc ();
+  *ptotal_bytes = GC_get_total_bytes ();
+}
+#endif
+
+#ifndef HAVE_GC_GET_FREE_SPACE_DIVISOR
+static GC_word
+GC_get_free_space_divisor (void)
+{
+  return GC_free_space_divisor;
+}
+#endif
+
+
 /* Hooks.  */
 scm_t_c_hook scm_before_gc_c_hook;
 scm_t_c_hook scm_before_mark_c_hook;
@@ -214,6 +241,9 @@ unsigned long scm_gc_ports_collected = 0;
 static long gc_time_taken = 0;
 static long gc_start_time = 0;
 
+static unsigned long free_space_divisor;
+static unsigned long minimum_free_space_divisor;
+static double target_free_space_divisor;
 
 static unsigned long protected_obj_count = 0;
 
@@ -275,14 +305,12 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
 #define FUNC_NAME s_scm_gc_stats
 {
   SCM answer;
-  size_t heap_size, free_bytes, bytes_since_gc, total_bytes;
+  GC_word heap_size, free_bytes, unmapped_bytes, bytes_since_gc, total_bytes;
   size_t gc_times;
 
-  heap_size      = GC_get_heap_size ();
-  free_bytes     = GC_get_free_bytes ();
-  bytes_since_gc = GC_get_bytes_since_gc ();
-  total_bytes    = GC_get_total_bytes ();
-  gc_times       = GC_gc_no;
+  GC_get_heap_usage_safe (&heap_size, &free_bytes, &unmapped_bytes,
+                          &bytes_since_gc, &total_bytes);
+  gc_times = GC_gc_no;
 
   answer =
     scm_list_n (scm_cons (sym_gc_time_taken, scm_from_long (gc_time_taken)),
@@ -584,7 +612,10 @@ void
 scm_storage_prehistory ()
 {
   GC_all_interior_pointers = 0;
-  GC_set_free_space_divisor (scm_getenv_int ("GC_FREE_SPACE_DIVISOR", 3));
+  free_space_divisor = scm_getenv_int ("GC_FREE_SPACE_DIVISOR", 3);
+  minimum_free_space_divisor = free_space_divisor;
+  target_free_space_divisor = free_space_divisor;
+  GC_set_free_space_divisor (free_space_divisor);
 
   GC_INIT ();
 
@@ -728,7 +759,8 @@ accumulate_gc_timer (void * hook_data SCM_UNUSED,
                 void *data SCM_UNUSED)
 {
   if (gc_start_time)
-    { long now = scm_c_get_internal_run_time ();
+    {
+      long now = scm_c_get_internal_run_time ();
       gc_time_taken += now - gc_start_time;
       gc_start_time = 0;
     }
@@ -736,6 +768,133 @@ accumulate_gc_timer (void * hook_data SCM_UNUSED,
   return NULL;
 }
 
+/* Return some idea of the memory footprint of a process, in bytes.
+   Currently only works on Linux systems.  */
+static size_t
+get_image_size (void)
+{
+  unsigned long size, resident, share;
+  size_t ret;
+
+  FILE *fp = fopen ("/proc/self/statm", "r");
+
+  if (fp && fscanf (fp, "%lu %lu %lu", &size, &resident, &share) == 3)
+    ret = resident * 4096;
+
+  if (fp)
+    fclose (fp);
+
+  return ret;
+}
+
+/* Make GC run more frequently when the process image size is growing,
+   measured against the number of bytes allocated through the GC.
+
+   If Guile is allocating at a GC-managed heap size H, libgc will tend
+   to limit the process image size to H*N.  But if at the same time the
+   user program is mallocating at a rate M bytes per GC-allocated byte,
+   then the process stabilizes at H*N*M -- assuming that collecting data
+   will result in malloc'd data being freed.  It doesn't take a very
+   large M for this to be a bad situation.  To limit the image size,
+   Guile should GC more often -- the bigger the M, the more often.
+
+   Numeric functions that produce bigger and bigger integers are
+   pessimal, because M is an increasing function of time.  Here is an
+   example of such a function:
+
+      (define (factorial n)
+        (define (fac n acc)
+          (if (<= n 1)
+            acc
+            (fac (1- n) (* n acc))))
+        (fac n 1))
+
+   It is possible for a process to grow for reasons that will not be
+   solved by faster GC.  In that case M will be estimated as
+   artificially high for a while, and so GC will happen more often on
+   the Guile side.  But when it stabilizes, Guile can ease back the GC
+   frequency.
+
+   The key is to measure process image growth, not mallocation rate.
+   For maximum effectiveness, Guile reacts quickly to process growth,
+   and exponentially backs down when the process stops growing.
+
+   See http://thread.gmane.org/gmane.lisp.guile.devel/12552/focus=12936
+   for further discussion.
+ */
+static void *
+adjust_gc_frequency (void * hook_data SCM_UNUSED,
+                     void *fn_data SCM_UNUSED,
+                     void *data SCM_UNUSED)
+{
+  static size_t prev_image_size = 0;
+  static size_t prev_bytes_alloced = 0;
+  size_t image_size;
+  size_t bytes_alloced;
+  
+  image_size = get_image_size ();
+  bytes_alloced = GC_get_total_bytes ();
+
+#define HEURISTICS_DEBUG 1
+
+#if HEURISTICS_DEBUG
+  fprintf (stderr, "prev image / alloced: %lu / %lu\n", prev_image_size, 
prev_bytes_alloced);
+  fprintf (stderr, "     image / alloced: %lu / %lu\n", image_size, 
bytes_alloced);
+  fprintf (stderr, "divisor %lu / %f\n", free_space_divisor, 
target_free_space_divisor);
+#endif
+
+  if (prev_image_size && bytes_alloced != prev_bytes_alloced)
+    {
+      double growth_rate, new_target_free_space_divisor;
+      double decay_factor = 0.5;
+      double hysteresis = 0.1;
+
+      growth_rate = ((double) image_size - prev_image_size)
+        / ((double)bytes_alloced - prev_bytes_alloced);
+      
+#if HEURISTICS_DEBUG
+      fprintf (stderr, "growth rate %f\n", growth_rate);
+#endif
+
+      new_target_free_space_divisor = minimum_free_space_divisor;
+
+      if (growth_rate > 0)
+        new_target_free_space_divisor *= 1.0 + growth_rate;
+
+#if HEURISTICS_DEBUG
+      fprintf (stderr, "new divisor %f\n", new_target_free_space_divisor);
+#endif
+
+      if (new_target_free_space_divisor < target_free_space_divisor)
+        /* Decay down.  */
+        target_free_space_divisor =
+          (decay_factor * target_free_space_divisor
+           + (1.0 - decay_factor) * new_target_free_space_divisor);
+      else
+        /* Jump up.  */
+        target_free_space_divisor = new_target_free_space_divisor;
+
+#if HEURISTICS_DEBUG
+      fprintf (stderr, "new target divisor %f\n", target_free_space_divisor);
+#endif
+
+      if (free_space_divisor + 0.5 + hysteresis < target_free_space_divisor
+          || free_space_divisor - 0.5 - hysteresis > target_free_space_divisor)
+        {
+          free_space_divisor = lround (target_free_space_divisor);
+#if HEURISTICS_DEBUG
+          fprintf (stderr, "new divisor %lu\n", free_space_divisor);
+#endif
+          GC_set_free_space_divisor (free_space_divisor);
+        }
+    }
+
+  prev_image_size = image_size;
+  prev_bytes_alloced = bytes_alloced;
+
+  return NULL;
+}
+
 
 
 
@@ -833,6 +992,7 @@ scm_init_gc ()
   scm_c_hook_add (&scm_before_gc_c_hook, queue_after_gc_hook, NULL, 0);
   scm_c_hook_add (&scm_before_gc_c_hook, start_gc_timer, NULL, 0);
   scm_c_hook_add (&scm_after_gc_c_hook, accumulate_gc_timer, NULL, 0);
+  scm_c_hook_add (&scm_after_gc_c_hook, adjust_gc_frequency, NULL, 0);
 
 #ifdef HAVE_GC_SET_START_CALLBACK
   GC_set_start_callback (run_before_gc_c_hook);


hooks/post-receive
-- 
GNU Guile