libguile/gc-freelist.c

   1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc.
   2  *
   3  * This library is free software; you can redistribute it and/or
   4  * modify it under the terms of the GNU Lesser General Public
   5  * License as published by the Free Software Foundation; either
   6  * version 2.1 of the License, or (at your option) any later version.
   7  *
   8  * This library is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11  * Lesser General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU Lesser General Public
  14  * License along with this library; if not, write to the Free Software
  15  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  16  */
  17
  18 #ifdef HAVE_CONFIG_H
  19 # include <config.h>
  20 #endif
  21
  22 #include <assert.h>
  23 #include <stdio.h>
  24
  25 #include "libguile/private-gc.h"
  26 #include "libguile/gc.h"
  27 #include "libguile/deprecation.h"
  28 #include "libguile/private-gc.h"
  29
  30 scm_t_cell_type_statistics scm_i_master_freelist;
  31 scm_t_cell_type_statistics scm_i_master_freelist2;
  32
  33 /*
  34
  35 In older versions of GUILE GC there was extensive support for
  36 debugging freelists. This was useful, since the freelist was kept
  37 inside the heap, and writing to an object that was GC'd would mangle
  38 the list. Mark bits are now separate, and checking for sane cell
  39 access can be done much more easily by simply checking if the mark bit
  40 is unset before allocation.  --hwn
  41
  42 */
  43
  44 #if (SCM_ENABLE_DEPRECATED == 1)
  45 #if defined(GUILE_DEBUG_FREELIST)
  46
  47 SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0,
  48             (),
  49             "DEPRECATED\n")
  50 #define FUNC_NAME "s_scm_map_free_list"
  51 {
  52   scm_c_issue_deprecation_warning ("map-free-list has been removed from GUILE. Doing nothing\n");
  53   return SCM_UNSPECIFIED;
  54 }
  55 #undef FUNC_NAME
  56
  57 SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1, 0, 0,
  58             (SCM flag),
  59             "DEPRECATED.\n")
  60 #define FUNC_NAME "s_scm_gc_set_debug_check_freelist_x"
  61 {
  62   scm_c_issue_deprecation_warning ("gc-set-debug-check-freelist! has been removed from GUILE. Doing nothing\n");
  63   return SCM_UNSPECIFIED;
  64 }
  65 #undef FUNC_NAME
  66
  67
  68 #endif /* defined (GUILE_DEBUG) */
  69 #endif /* deprecated */
  70
  71 static void
  72 scm_init_freelist (scm_t_cell_type_statistics *freelist,
  73                    int span,
  74                    int min_yield_percentage)
  75 {
  76   if (min_yield_percentage < 1)
  77     min_yield_percentage = 1;
  78   if (min_yield_percentage > 99)
  79     min_yield_percentage = 99;
  80
  81   freelist->heap_segment_idx = -1;
  82   freelist->min_yield_fraction = min_yield_percentage / 100.0;
  83   freelist->span = span;
  84   freelist->swept = 0;
  85   freelist->collected = 0;
  86   freelist->heap_total_cells = 0;
  87 }
  88
  89 #if (SCM_ENABLE_DEPRECATED == 1)
  90 size_t scm_default_init_heap_size_1;
  91 int scm_default_min_yield_1;
  92 size_t scm_default_init_heap_size_2;
  93 int scm_default_min_yield_2;
  94 size_t scm_default_max_segment_size;
  95
  96 static void
  97 check_deprecated_heap_vars (void)  {
  98   if (scm_default_init_heap_size_1 ||
  99       scm_default_min_yield_1||
 100       scm_default_init_heap_size_2||
 101       scm_default_min_yield_2||
 102       scm_default_max_segment_size)
 103     {
 104       scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead.");
 105     }
 106 }
 107 #else
 108 static void check_deprecated_heap_vars (void) { }
 109 #endif
 110
 111 void
 112 scm_gc_init_freelist (void)
 113 {
 114   const char *error_message =
 115     "Could not allocate initial heap of %uld.\n"
 116     "Try adjusting GUILE_INIT_SEGMENT_SIZE_%d\n";
 117
 118   int init_heap_size_1
 119     = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", SCM_DEFAULT_INIT_HEAP_SIZE_1);
 120   int init_heap_size_2
 121     = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_2", SCM_DEFAULT_INIT_HEAP_SIZE_2);
 122
 123   scm_init_freelist (&scm_i_master_freelist2, 2,
 124                      scm_getenv_int ("GUILE_MIN_YIELD_2", SCM_DEFAULT_MIN_YIELD_2));
 125   scm_init_freelist (&scm_i_master_freelist, 1,
 126                      scm_getenv_int ("GUILE_MIN_YIELD_1", SCM_DEFAULT_MIN_YIELD_1));
 127
 128   scm_max_segment_size = scm_getenv_int ("GUILE_MAX_SEGMENT_SIZE", SCM_DEFAULT_MAX_SEGMENT_SIZE);
 129
 130   if (scm_max_segment_size <= 0)
 131     scm_max_segment_size = SCM_DEFAULT_MAX_SEGMENT_SIZE;
 132
 133   if (scm_i_get_new_heap_segment (&scm_i_master_freelist,
 134                                   init_heap_size_1, return_on_error) == -1)  {
 135     fprintf (stderr, error_message, init_heap_size_1, 1);
 136     abort ();
 137   }
 138   if (scm_i_get_new_heap_segment (&scm_i_master_freelist2,
 139                                   init_heap_size_2, return_on_error) == -1) {
 140     fprintf (stderr, error_message, init_heap_size_2, 2);
 141     abort ();
 142   }
 143
 144   check_deprecated_heap_vars ();
 145 }
 146
 147
 148
 149 void
 150 scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist)
 151 {
 152   freelist->collected = 0;
 153   freelist->swept = 0;
 154   /*
 155     at the end we simply start with the lowest segment again.
 156    */
 157   freelist->heap_segment_idx = -1;
 158 }
 159
 160
 161 /*
 162   Returns how many more cells we should allocate according to our
 163   policy.  May return negative if we don't need to allocate more.
 164
 165
 166   The new yield should at least equal gc fraction of new heap size, i.e.
 167
 168   c + dh > f * (h + dh)
 169
 170   c : collected
 171   f : min yield fraction
 172   h : heap size
 173   dh : size of new heap segment
 174
 175   this gives dh > (f * h - c) / (1 - f).
 176 */
 177 float
 178 scm_i_gc_heap_size_delta (scm_t_cell_type_statistics * freelist)
 179 {
 180   float f = freelist->min_yield_fraction;
 181   float collected = freelist->collected;
 182   float swept = freelist->swept;
 183   float delta = ((f * swept - collected) / (1.0 - f));
 184
 185   assert (freelist->heap_total_cells >= freelist->collected);
 186   assert (freelist->swept == freelist->heap_total_cells);
 187   assert (swept >= collected);
 188
 189   return delta;
 190 }