| 1 | /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
| 16 | */ |
| 17 | |
| 18 | #include <assert.h> |
| 19 | #include <stdio.h> |
| 20 | |
| 21 | #include "libguile/private-gc.h" |
| 22 | #include "libguile/gc.h" |
| 23 | #include "libguile/deprecation.h" |
| 24 | #include "libguile/private-gc.h" |
| 25 | |
| 26 | scm_t_cell_type_statistics scm_i_master_freelist; |
| 27 | scm_t_cell_type_statistics scm_i_master_freelist2; |
| 28 | |
| 29 | |
| 30 | |
| 31 | |
| 32 | /* |
| 33 | |
| 34 | In older versions of GUILE GC there was extensive support for |
| 35 | debugging freelists. This was useful, since the freelist was kept |
| 36 | inside the heap, and writing to an object that was GC'd would mangle |
| 37 | the list. Mark bits are now separate, and checking for sane cell |
| 38 | access can be done much more easily by simply checking if the mark bit |
| 39 | is unset before allocation. --hwn |
| 40 | |
| 41 | |
| 42 | |
| 43 | */ |
| 44 | |
| 45 | #if (SCM_ENABLE_DEPRECATED == 1) |
| 46 | #if defined(GUILE_DEBUG_FREELIST) |
| 47 | |
| 48 | SCM_DEFINE (scm_map_free_list, "map-free-list", 0, 0, 0, |
| 49 | (), |
| 50 | "DEPRECATED\n") |
| 51 | #define FUNC_NAME "s_scm_map_free_list" |
| 52 | { |
| 53 | scm_c_issue_deprecation_warning ("map-free-list has been removed from GUILE. Doing nothing\n"); |
| 54 | return SCM_UNSPECIFIED; |
| 55 | } |
| 56 | #undef FUNC_NAME |
| 57 | |
| 58 | SCM_DEFINE (scm_gc_set_debug_check_freelist_x, "gc-set-debug-check-freelist!", 1, 0, 0, |
| 59 | (SCM flag), |
| 60 | "DEPRECATED.\n") |
| 61 | #define FUNC_NAME "s_scm_gc_set_debug_check_freelist_x" |
| 62 | { |
| 63 | scm_c_issue_deprecation_warning ("gc-set-debug-check-freelist! has been removed from GUILE. Doing nothing\n"); |
| 64 | return SCM_UNSPECIFIED; |
| 65 | } |
| 66 | #undef FUNC_NAME |
| 67 | |
| 68 | |
| 69 | #endif /* defined (GUILE_DEBUG) */ |
| 70 | #endif /* deprecated */ |
| 71 | |
| 72 | |
| 73 | |
| 74 | |
| 75 | /* |
| 76 | This adjust FREELIST variables to decide wether or not to allocate |
| 77 | more heap in the next GC run. It uses scm_gc_cells_collected and scm_gc_cells_collected1 |
| 78 | */ |
| 79 | |
| 80 | void |
| 81 | scm_i_adjust_min_yield (scm_t_cell_type_statistics *freelist) |
| 82 | { |
| 83 | /* min yield is adjusted upwards so that next predicted total yield |
| 84 | * (allocated cells actually freed by GC) becomes |
| 85 | * `min_yield_fraction' of total heap size. Note, however, that |
| 86 | * the absolute value of min_yield will correspond to `collected' |
| 87 | * on one master (the one which currently is triggering GC). |
| 88 | * |
| 89 | * The reason why we look at total yield instead of cells collected |
| 90 | * on one list is that we want to take other freelists into account. |
| 91 | * On this freelist, we know that (local) yield = collected cells, |
| 92 | * but that's probably not the case on the other lists. |
| 93 | * |
| 94 | * (We might consider computing a better prediction, for example |
| 95 | * by computing an average over multiple GC:s.) |
| 96 | */ |
| 97 | if (freelist->min_yield_fraction) |
| 98 | { |
| 99 | /* Pick largest of last two yields. */ |
| 100 | long delta = ((SCM_HEAP_SIZE * freelist->min_yield_fraction / 100) |
| 101 | - (long) SCM_MAX (scm_gc_cells_collected_1, scm_gc_cells_collected)); |
| 102 | #ifdef DEBUGINFO |
| 103 | fprintf (stderr, " after GC = %lu, delta = %ld\n", |
| 104 | (unsigned long) scm_cells_allocated, |
| 105 | (long) delta); |
| 106 | #endif |
| 107 | if (delta > 0) |
| 108 | freelist->min_yield += delta; |
| 109 | } |
| 110 | } |
| 111 | |
| 112 | |
| 113 | static void |
| 114 | scm_init_freelist (scm_t_cell_type_statistics *freelist, |
| 115 | int span, |
| 116 | int min_yield) |
| 117 | { |
| 118 | if (min_yield < 1) |
| 119 | min_yield = 1; |
| 120 | if (min_yield > 99) |
| 121 | min_yield = 99; |
| 122 | |
| 123 | freelist->heap_segment_idx = -1; |
| 124 | freelist->min_yield = 0; |
| 125 | freelist->min_yield_fraction = min_yield; |
| 126 | freelist->span = span; |
| 127 | freelist->collected = 0; |
| 128 | freelist->collected_1 = 0; |
| 129 | freelist->heap_size = 0; |
| 130 | } |
| 131 | |
| 132 | #if (SCM_ENABLE_DEPRECATED == 1) |
| 133 | size_t scm_default_init_heap_size_1; |
| 134 | int scm_default_min_yield_1; |
| 135 | size_t scm_default_init_heap_size_2; |
| 136 | int scm_default_min_yield_2; |
| 137 | size_t scm_default_max_segment_size; |
| 138 | #endif |
| 139 | |
| 140 | void |
| 141 | scm_gc_init_freelist (void) |
| 142 | { |
| 143 | int init_heap_size_1 |
| 144 | = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_1", SCM_DEFAULT_INIT_HEAP_SIZE_1); |
| 145 | int init_heap_size_2 |
| 146 | = scm_getenv_int ("GUILE_INIT_SEGMENT_SIZE_2", SCM_DEFAULT_INIT_HEAP_SIZE_2); |
| 147 | |
| 148 | /* These are the thread-local freelists. */ |
| 149 | scm_key_create (&scm_i_freelist, free); |
| 150 | scm_key_create (&scm_i_freelist2, free); |
| 151 | SCM_FREELIST_CREATE (scm_i_freelist); |
| 152 | SCM_FREELIST_CREATE (scm_i_freelist2); |
| 153 | |
| 154 | scm_init_freelist (&scm_i_master_freelist2, 2, |
| 155 | scm_getenv_int ("GUILE_MIN_YIELD_2", SCM_DEFAULT_MIN_YIELD_2)); |
| 156 | scm_init_freelist (&scm_i_master_freelist, 1, |
| 157 | scm_getenv_int ("GUILE_MIN_YIELD_1", SCM_DEFAULT_MIN_YIELD_1)); |
| 158 | |
| 159 | scm_max_segment_size = scm_getenv_int ("GUILE_MAX_SEGMENT_SIZE", SCM_DEFAULT_MAX_SEGMENT_SIZE); |
| 160 | |
| 161 | if (scm_max_segment_size <= 0) |
| 162 | scm_max_segment_size = SCM_DEFAULT_MAX_SEGMENT_SIZE; |
| 163 | |
| 164 | |
| 165 | scm_i_make_initial_segment (init_heap_size_1, &scm_i_master_freelist); |
| 166 | scm_i_make_initial_segment (init_heap_size_2, &scm_i_master_freelist2); |
| 167 | |
| 168 | #if (SCM_ENABLE_DEPRECATED == 1) |
| 169 | if ( scm_default_init_heap_size_1 || |
| 170 | scm_default_min_yield_1|| |
| 171 | scm_default_init_heap_size_2|| |
| 172 | scm_default_min_yield_2|| |
| 173 | scm_default_max_segment_size) |
| 174 | { |
| 175 | scm_c_issue_deprecation_warning ("Tuning heap parameters with C variables is deprecated. Use environment variables instead."); |
| 176 | } |
| 177 | #endif |
| 178 | } |
| 179 | |
| 180 | |
| 181 | void |
| 182 | scm_i_gc_sweep_freelist_reset (scm_t_cell_type_statistics *freelist) |
| 183 | { |
| 184 | freelist->collected_1 = freelist->collected; |
| 185 | freelist->collected = 0; |
| 186 | |
| 187 | /* |
| 188 | at the end we simply start with the lowest segment again. |
| 189 | */ |
| 190 | freelist->heap_segment_idx = -1; |
| 191 | } |
| 192 | |
| 193 | int |
| 194 | scm_i_gc_grow_heap_p (scm_t_cell_type_statistics * freelist) |
| 195 | { |
| 196 | return SCM_MAX (freelist->collected,freelist->collected_1) < freelist->min_yield; |
| 197 | } |