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