summaryrefslogtreecommitdiff
path: root/libguile/gc.c
diff options
context:
space:
mode:
Diffstat (limited to 'libguile/gc.c')
-rw-r--r--libguile/gc.c335
1 files changed, 12 insertions, 323 deletions
diff --git a/libguile/gc.c b/libguile/gc.c
index 01e1ace80..2bcdaffc8 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,5 +1,5 @@
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006,
- * 2008, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
+ * 2008, 2009, 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License
@@ -23,8 +23,6 @@
# include <config.h>
#endif
-#define SCM_BUILDING_DEPRECATED_CODE
-
#include "libguile/gen-scmconfig.h"
#include <stdio.h>
@@ -48,13 +46,12 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
#include "libguile/async.h"
#include "libguile/ports.h"
#include "libguile/root.h"
+#include "libguile/simpos.h"
#include "libguile/strings.h"
#include "libguile/vectors.h"
-#include "libguile/weaks.h"
#include "libguile/hashtab.h"
#include "libguile/tags.h"
-#include "libguile/private-gc.h"
#include "libguile/validate.h"
#include "libguile/deprecation.h"
#include "libguile/gc.h"
@@ -73,6 +70,12 @@ extern unsigned long * __libc_ia64_register_backing_store_base;
#include <unistd.h>
#endif
+/* Size in bytes of the initial heap. This should be about the size of
+ result of 'guile -c "(display (assq-ref (gc-stats)
+ 'heap-total-allocated))"'. */
+
+#define DEFAULT_INITIAL_HEAP_SIZE (128 * 1024 * SIZEOF_SCM_T_BITS)
+
/* Set this to != 0 if every cell that is accessed shall be checked:
*/
int scm_debug_cell_accesses_p = 0;
@@ -83,14 +86,10 @@ int scm_expensive_debug_cell_accesses_p = 0;
*/
int scm_debug_cells_gc_interval = 0;
-#if SCM_ENABLE_DEPRECATED == 1
/* Hash table that keeps a reference to objects the user wants to protect from
- garbage collection. It could arguably be private but applications have come
- to rely on it (e.g., Lilypond 2.13.9). */
-SCM scm_protects;
-#else
+ garbage collection. */
static SCM scm_protects;
-#endif
+
#if (SCM_DEBUG_CELL_ACCESSES == 1)
@@ -195,35 +194,6 @@ 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,
- 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 ();
-#ifdef HAVE_GC_GET_UNMAPPED_BYTES
- *punmapped_bytes = GC_get_unmapped_bytes ();
-#else
- *punmapped_bytes = 0;
-#endif
- *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;
@@ -280,13 +250,7 @@ SCM_DEFINE (scm_gc_stats, "gc-stats", 0, 0, 0,
GC_get_heap_usage_safe (&heap_size, &free_bytes, &unmapped_bytes,
&bytes_since_gc, &total_bytes);
-#ifdef HAVE_GC_GET_GC_NO
- /* This function was added in 7.2alpha2 (June 2009). */
gc_times = GC_get_gc_no ();
-#else
- /* This symbol is deprecated as of 7.3. */
- gc_times = GC_gc_no;
-#endif
answer =
scm_list_n (scm_cons (sym_gc_time_taken, scm_from_long (gc_time_taken)),
@@ -370,9 +334,6 @@ SCM_DEFINE (scm_gc, "gc", 0, 0, 0,
void
scm_i_gc (const char *what)
{
-#ifndef HAVE_GC_SET_START_CALLBACK
- run_before_gc_c_hook ();
-#endif
GC_gcollect ();
}
@@ -568,43 +529,10 @@ scm_gc_unregister_roots (SCM *b, unsigned long n)
-/*
- MOVE THIS FUNCTION. IT DOES NOT HAVE ANYTHING TODO WITH GC.
- */
-
-/* Get an integer from an environment variable. */
-int
-scm_getenv_int (const char *var, int def)
-{
- char *end = 0;
- char *val = getenv (var);
- long res = def;
- if (!val)
- return def;
- res = strtol (val, &end, 10);
- if (end == val)
- return def;
- return res;
-}
-
-#ifndef HAVE_GC_SET_FINALIZE_ON_DEMAND
-static void
-GC_set_finalize_on_demand (int foo)
-{
- GC_finalize_on_demand = foo;
-}
-#endif
-
void
scm_storage_prehistory ()
{
-#ifdef HAVE_GC_SET_ALL_INTERIOR_POINTERS
- /* This function was added in 7.2alpha2 (June 2009). */
GC_set_all_interior_pointers (0);
-#else
- /* This symbol is deprecated in 7.3. */
- GC_all_interior_pointers = 0;
-#endif
free_space_divisor = scm_getenv_int ("GC_FREE_SPACE_DIVISOR", 3);
minimum_free_space_divisor = free_space_divisor;
@@ -614,14 +542,7 @@ scm_storage_prehistory ()
GC_INIT ();
-#if (! ((defined GC_VERSION_MAJOR) && (GC_VERSION_MAJOR >= 7))) \
- && (defined SCM_I_GSC_USE_PTHREAD_THREADS)
- /* When using GC 6.8, this call is required to initialize thread-local
- freelists (shouldn't be necessary with GC 7.0). */
- GC_init ();
-#endif
-
- GC_expand_hp (SCM_DEFAULT_INIT_HEAP_SIZE_2);
+ GC_expand_hp (DEFAULT_INITIAL_HEAP_SIZE);
/* We only need to register a displacement for those types for which the
higher bits of the type tag are used to store a pointer (that is, a
@@ -763,151 +684,9 @@ 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 = 0;
-
- 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;
-}
-
-/* These are discussed later. */
-static size_t bytes_until_gc;
+static size_t bytes_until_gc = DEFAULT_INITIAL_HEAP_SIZE;
static scm_i_pthread_mutex_t bytes_until_gc_lock = SCM_I_PTHREAD_MUTEX_INITIALIZER;
-/* 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;
-
- scm_i_pthread_mutex_lock (&bytes_until_gc_lock);
- bytes_until_gc = GC_get_heap_size ();
- scm_i_pthread_mutex_unlock (&bytes_until_gc_lock);
-
- image_size = get_image_size ();
- bytes_alloced = GC_get_total_bytes ();
-
-#define HEURISTICS_DEBUG 0
-
-#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;
-}
-
-/* The adjust_gc_frequency routine handles transients in the process
- image size. It can't handle instense non-GC-managed steady-state
- allocation though, as it decays the FSD at steady-state down to its
- minimum value.
-
- The only real way to handle continuous, high non-GC allocation is to
- let the GC know about it. This routine can handle non-GC allocation
- rates that are similar in size to the GC-managed heap size.
- */
-
void
scm_gc_register_allocation (size_t size)
{
@@ -927,84 +706,6 @@ scm_gc_register_allocation (size_t size)
-
-char const *
-scm_i_tag_name (scm_t_bits tag)
-{
- switch (tag & 0x7f) /* 7 bits */
- {
- case scm_tcs_struct:
- return "struct";
- case scm_tcs_cons_imcar:
- return "cons (immediate car)";
- case scm_tcs_cons_nimcar:
- return "cons (non-immediate car)";
- case scm_tc7_pointer:
- return "foreign";
- case scm_tc7_hashtable:
- return "hashtable";
- case scm_tc7_fluid:
- return "fluid";
- case scm_tc7_dynamic_state:
- return "dynamic state";
- case scm_tc7_frame:
- return "frame";
- case scm_tc7_objcode:
- return "objcode";
- case scm_tc7_vm:
- return "vm";
- case scm_tc7_vm_cont:
- return "vm continuation";
- case scm_tc7_wvect:
- return "weak vector";
- case scm_tc7_vector:
- return "vector";
- case scm_tc7_number:
- switch (tag)
- {
- case scm_tc16_real:
- return "real";
- break;
- case scm_tc16_big:
- return "bignum";
- break;
- case scm_tc16_complex:
- return "complex number";
- break;
- case scm_tc16_fraction:
- return "fraction";
- break;
- }
- break;
- case scm_tc7_string:
- return "string";
- break;
- case scm_tc7_stringbuf:
- return "string buffer";
- break;
- case scm_tc7_symbol:
- return "symbol";
- break;
- case scm_tc7_variable:
- return "variable";
- break;
- case scm_tc7_port:
- return "port";
- break;
- case scm_tc7_smob:
- {
- int k = 0xff & (tag >> 8);
- return (scm_smobs[k].name);
- }
- break;
- }
-
- return NULL;
-}
-
-
-
-
void
scm_init_gc ()
{
@@ -1023,19 +724,7 @@ scm_init_gc ()
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);
-#if HAVE_GC_GET_HEAP_USAGE_SAFE
- /* GC_get_heap_usage does not take a lock, and so can run in the GC
- start hook. */
- scm_c_hook_add (&scm_before_gc_c_hook, adjust_gc_frequency, NULL, 0);
-#else
- /* GC_get_heap_usage might take a lock (and did from 7.2alpha1 to
- 7.2alpha7), so call it in the after_gc_hook. */
- scm_c_hook_add (&scm_after_gc_c_hook, adjust_gc_frequency, NULL, 0);
-#endif
-
-#ifdef HAVE_GC_SET_START_CALLBACK
GC_set_start_callback (run_before_gc_c_hook);
-#endif
#include "libguile/gc.x"
}