diff options
author | Andy Wingo <wingo@pobox.com> | 2011-11-29 00:48:56 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2011-11-29 10:12:22 +0100 |
commit | 6360beb28a918448ed42b0ddb905b2d9d513d8b9 (patch) | |
tree | 1128509ab28c453f5ade2bd6869d34e20fe379d0 | |
parent | 14294ce0dfa315193a455a16dd5ab631bf037b78 (diff) | |
download | guile-6360beb28a918448ed42b0ddb905b2d9d513d8b9.tar.gz |
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.
-rw-r--r-- | configure.ac | 2 | ||||
-rw-r--r-- | libguile/gc.c | 150 |
2 files changed, 149 insertions, 3 deletions
diff --git a/configure.ac b/configure.ac index 3a56cda1c..d63dd6326 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 GC_get_heap_usage_safe]) +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 4895b7dfe..16878607f 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> @@ -194,6 +195,8 @@ SCM_DEFINE (scm_set_debug_cell_accesses_x, "set-debug-cell-accesses!", 1, 0, 0, +/* Compatibility. */ + #ifndef HAVE_GC_GET_HEAP_USAGE_SAFE static void GC_get_heap_usage_safe (GC_word *pheap_size, GC_word *pfree_bytes, @@ -208,6 +211,14 @@ GC_get_heap_usage_safe (GC_word *pheap_size, GC_word *pfree_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; @@ -230,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; @@ -598,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 (); @@ -742,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; } @@ -750,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; +} + @@ -847,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); |