Commit | Line | Data |
---|---|---|
a8db4a59 | 1 | /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006, 2008 Free Software Foundation, Inc. |
c7743d02 | 2 | * |
73be1d9e MV |
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. | |
c7743d02 | 7 | * |
73be1d9e | 8 | * This library is distributed in the hope that it will be useful, |
c7743d02 | 9 | * but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
10 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
11 | * Lesser General Public License for more details. | |
c7743d02 | 12 | * |
73be1d9e MV |
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 | |
92205699 | 15 | * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
73be1d9e | 16 | */ |
c7743d02 | 17 | |
dbb605f5 | 18 | #ifdef HAVE_CONFIG_H |
a8db4a59 LC |
19 | # include <config.h> |
20 | #endif | |
21 | ||
c7743d02 HWN |
22 | #include <assert.h> |
23 | #include <stdio.h> | |
24 | #include <string.h> | |
25 | ||
a8db4a59 LC |
26 | #include <count-one-bits.h> |
27 | ||
c7743d02 HWN |
28 | #include "libguile/_scm.h" |
29 | #include "libguile/pairs.h" | |
30 | #include "libguile/gc.h" | |
31 | #include "libguile/private-gc.h" | |
32 | ||
c7743d02 HWN |
33 | size_t scm_max_segment_size; |
34 | ||
82ae1b8e HWN |
35 | /* Important entry point: try to grab some memory, and make it into a |
36 | segment; return the index of the segment. SWEEP_STATS should contain | |
37 | global GC sweep statistics collected since the last full GC. | |
38 | ||
39 | Returns the index of the segment. If error_policy != | |
40 | abort_on_error, we return -1 on failure. | |
41 | */ | |
42 | int | |
43 | scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist, | |
44 | size_t len, | |
45 | policy_on_error error_policy) | |
46 | { | |
47 | if (len > scm_max_segment_size) | |
48 | len = scm_max_segment_size; | |
49 | ||
50 | if (len < SCM_MIN_HEAP_SEG_SIZE) | |
51 | len = SCM_MIN_HEAP_SEG_SIZE; | |
52 | ||
40945e5e | 53 | /* todo: consider having a more flexible lower bound. */ |
82ae1b8e HWN |
54 | { |
55 | scm_t_heap_segment *seg = scm_i_make_empty_heap_segment (freelist); | |
56 | ||
57 | /* Allocate with decaying ambition. */ | |
58 | while (len >= SCM_MIN_HEAP_SEG_SIZE) | |
59 | { | |
60 | if (scm_i_initialize_heap_segment_data (seg, len)) | |
61 | return scm_i_insert_segment (seg); | |
62 | ||
63 | len /= 2; | |
64 | } | |
65 | } | |
66 | ||
67 | if (error_policy == abort_on_error) | |
68 | { | |
69 | fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap.\n"); | |
70 | abort (); | |
71 | } | |
72 | return -1; | |
73 | } | |
74 | ||
75 | ||
c7743d02 HWN |
76 | scm_t_heap_segment * |
77 | scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl) | |
78 | { | |
82ae1b8e | 79 | scm_t_heap_segment *shs = calloc (1, sizeof (scm_t_heap_segment)); |
c7743d02 HWN |
80 | |
81 | if (!shs) | |
82 | { | |
83 | fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n"); | |
84 | abort (); | |
85 | } | |
86 | ||
c7743d02 HWN |
87 | shs->span = fl->span; |
88 | shs->freelist = fl; | |
c7743d02 HWN |
89 | |
90 | return shs; | |
91 | } | |
92 | ||
1367aa5e HWN |
93 | void |
94 | scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab) | |
95 | { | |
96 | scm_t_cell *p = seg->bounds[0]; | |
97 | while (p < seg->bounds[1]) | |
98 | { | |
99 | scm_i_card_statistics (p, tab, seg); | |
100 | p += SCM_GC_CARD_N_CELLS; | |
101 | } | |
102 | } | |
103 | ||
82ae1b8e HWN |
104 | /* |
105 | count number of marked bits, so we know how much cells are live. | |
106 | */ | |
107 | int | |
108 | scm_i_heap_segment_marked_count (scm_t_heap_segment *seg) | |
109 | { | |
110 | scm_t_c_bvec_long *bvec = (scm_t_c_bvec_long *) seg->bounds[1]; | |
111 | scm_t_c_bvec_long *bvec_end = | |
112 | (bvec + | |
113 | scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS); | |
114 | ||
115 | int count = 0; | |
4b751346 HWN |
116 | while (bvec < bvec_end) |
117 | { | |
a8db4a59 | 118 | count += count_one_bits_l (*bvec); |
4b751346 HWN |
119 | bvec ++; |
120 | } | |
82ae1b8e HWN |
121 | return count * seg->span; |
122 | } | |
123 | ||
124 | int | |
125 | scm_i_segment_card_number (scm_t_heap_segment *seg, | |
126 | scm_t_cell *card) | |
127 | { | |
128 | return (card - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; | |
129 | } | |
130 | ||
c7743d02 HWN |
131 | /* |
132 | Fill SEGMENT with memory both for data and mark bits. | |
133 | ||
82ae1b8e | 134 | RETURN: 1 on success, 0 failure |
c7743d02 HWN |
135 | */ |
136 | int | |
82ae1b8e | 137 | scm_i_initialize_heap_segment_data (scm_t_heap_segment *segment, size_t requested) |
c7743d02 HWN |
138 | { |
139 | /* | |
140 | round upwards | |
141 | */ | |
142 | int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS); | |
82ae1b8e | 143 | int card_count = 1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count; |
c7743d02 HWN |
144 | |
145 | /* | |
146 | one card extra due to alignment | |
147 | */ | |
82ae1b8e HWN |
148 | size_t mem_needed = (1 + card_count) * SCM_GC_SIZEOF_CARD |
149 | + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG; | |
150 | scm_t_cell *memory = 0; | |
c7743d02 HWN |
151 | |
152 | /* | |
82ae1b8e | 153 | We use calloc to alloc the heap, so it is nicely initialized. |
c7743d02 | 154 | */ |
82ae1b8e | 155 | SCM_SYSCALL (memory = (scm_t_cell *) calloc (1, mem_needed)); |
c7743d02 HWN |
156 | |
157 | if (memory == NULL) | |
158 | return 0; | |
159 | ||
160 | segment->malloced = memory; | |
161 | segment->bounds[0] = SCM_GC_CARD_UP (memory); | |
162 | segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS; | |
82ae1b8e | 163 | segment->freelist->heap_total_cells += scm_i_segment_cell_count (segment); |
c7743d02 | 164 | |
1383773b HWN |
165 | /* |
166 | Don't init the mem or the bitvector. This is handled by lazy | |
167 | sweeping. | |
168 | */ | |
c7743d02 HWN |
169 | segment->next_free_card = segment->bounds[0]; |
170 | segment->first_time = 1; | |
171 | return 1; | |
172 | } | |
173 | ||
174 | int | |
82ae1b8e | 175 | scm_i_segment_card_count (scm_t_heap_segment *seg) |
c7743d02 HWN |
176 | { |
177 | return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS; | |
178 | } | |
179 | ||
180 | /* | |
181 | Return the number of available single-cell data cells. | |
182 | */ | |
183 | int | |
82ae1b8e HWN |
184 | scm_i_segment_cell_count (scm_t_heap_segment *seg) |
185 | { | |
186 | return scm_i_segment_card_count (seg) | |
187 | * scm_i_segment_cells_per_card (seg); | |
188 | } | |
189 | ||
190 | int | |
191 | scm_i_segment_cells_per_card (scm_t_heap_segment *seg) | |
c7743d02 | 192 | { |
82ae1b8e HWN |
193 | return (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS |
194 | + ((seg->span == 2) ? -1 : 0)); | |
c7743d02 HWN |
195 | } |
196 | ||
197 | void | |
198 | scm_i_clear_segment_mark_space (scm_t_heap_segment *seg) | |
199 | { | |
82ae1b8e | 200 | scm_t_cell *markspace = seg->bounds[1]; |
c7743d02 HWN |
201 | |
202 | memset (markspace, 0x00, | |
82ae1b8e | 203 | scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG); |
c7743d02 HWN |
204 | } |
205 | ||
82ae1b8e HWN |
206 | |
207 | /* | |
208 | Force a sweep of this entire segment. | |
209 | */ | |
210 | void | |
211 | scm_i_sweep_segment (scm_t_heap_segment *seg, | |
212 | scm_t_sweep_statistics *sweep_stats) | |
213 | { | |
214 | int infinity = 1 << 30; | |
215 | scm_t_cell *remember = seg->next_free_card; | |
216 | while (scm_i_sweep_some_cards (seg, sweep_stats, infinity) != SCM_EOL) | |
217 | ; | |
218 | seg->next_free_card = remember; | |
219 | } | |
220 | ||
221 | ||
222 | /* Sweep cards from SEG until we've gathered THRESHOLD cells. On | |
223 | return, SWEEP_STATS, if non-NULL, contains the number of cells that | |
224 | have been visited and collected. A freelist is returned, | |
225 | potentially empty. */ | |
c7743d02 | 226 | SCM |
4c7016dc | 227 | scm_i_sweep_some_cards (scm_t_heap_segment *seg, |
82ae1b8e HWN |
228 | scm_t_sweep_statistics *sweep_stats, |
229 | int threshold) | |
c7743d02 HWN |
230 | { |
231 | SCM cells = SCM_EOL; | |
c7743d02 | 232 | int collected = 0; |
82ae1b8e | 233 | int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment *) |
1383773b | 234 | = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card; |
c7743d02 | 235 | |
82ae1b8e | 236 | scm_t_cell *next_free = seg->next_free_card; |
c7743d02 | 237 | int cards_swept = 0; |
c7743d02 HWN |
238 | while (collected < threshold && next_free < seg->bounds[1]) |
239 | { | |
1383773b | 240 | collected += (*sweeper) (next_free, &cells, seg); |
c7743d02 HWN |
241 | next_free += SCM_GC_CARD_N_CELLS; |
242 | cards_swept ++; | |
243 | } | |
244 | ||
82ae1b8e | 245 | if (sweep_stats != NULL) |
4c7016dc | 246 | { |
82ae1b8e HWN |
247 | int swept = cards_swept |
248 | * ((SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS) | |
249 | - seg->span + 1); | |
250 | int collected_cells = collected * seg->span; | |
251 | sweep_stats->swept += swept; | |
252 | sweep_stats->collected += collected_cells; | |
4c7016dc | 253 | } |
82ae1b8e HWN |
254 | |
255 | if (next_free == seg->bounds[1]) | |
c7743d02 HWN |
256 | { |
257 | seg->first_time = 0; | |
258 | } | |
259 | ||
260 | seg->next_free_card = next_free; | |
261 | return cells; | |
262 | } | |
263 | ||
264 | ||
1367aa5e HWN |
265 | |
266 | SCM | |
82ae1b8e | 267 | scm_i_sweep_for_freelist (scm_t_cell_type_statistics *freelist) |
c7743d02 | 268 | { |
82ae1b8e HWN |
269 | scm_t_sweep_statistics stats = { 0 }; |
270 | SCM result = scm_i_sweep_some_segments (freelist, &stats); | |
c7743d02 | 271 | |
82ae1b8e HWN |
272 | scm_i_gc_sweep_stats.collected += stats.collected; |
273 | scm_i_gc_sweep_stats.swept += stats.swept; | |
c7743d02 | 274 | |
82ae1b8e HWN |
275 | freelist->collected += stats.collected; |
276 | freelist->swept += stats.swept; | |
277 | return result; | |
c7743d02 HWN |
278 | } |
279 |