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