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 #include <string.h>
25
26 #include "libguile/_scm.h"
27 #include "libguile/pairs.h"
28 #include "libguile/gc.h"
29 #include "libguile/private-gc.h"
30
31
32
33
34
35 size_t scm_max_segment_size;
36
37 scm_t_heap_segment *
scm_i_make_empty_heap_segment(scm_t_cell_type_statistics * fl)38 scm_i_make_empty_heap_segment (scm_t_cell_type_statistics *fl)
39 {
40 scm_t_heap_segment * shs = malloc (sizeof (scm_t_heap_segment));
41
42 if (!shs)
43 {
44 fprintf (stderr, "scm_i_get_new_heap_segment: out of memory.\n");
45 abort ();
46 }
47
48 shs->bounds[0] = NULL;
49 shs->bounds[1] = NULL;
50 shs->malloced = NULL;
51 shs->span = fl->span;
52 shs->freelist = fl;
53 shs->next_free_card = NULL;
54
55 return shs;
56 }
57
58
59 void
scm_i_heap_segment_statistics(scm_t_heap_segment * seg,SCM tab)60 scm_i_heap_segment_statistics (scm_t_heap_segment *seg, SCM tab)
61 {
62 scm_t_cell *p = seg->bounds[0];
63 while (p < seg->bounds[1])
64 {
65 scm_i_card_statistics (p, tab, seg);
66 p += SCM_GC_CARD_N_CELLS;
67 }
68 }
69
70
71
72 /*
73 Fill SEGMENT with memory both for data and mark bits.
74
75 RETURN: 1 on success, 0 failure
76 */
77 int
scm_i_initialize_heap_segment_data(scm_t_heap_segment * segment,size_t requested)78 scm_i_initialize_heap_segment_data (scm_t_heap_segment * segment, size_t requested)
79 {
80 /*
81 round upwards
82 */
83 int card_data_cell_count = (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
84 int card_count =1 + (requested / sizeof (scm_t_cell)) / card_data_cell_count;
85
86 /*
87 one card extra due to alignment
88 */
89 size_t mem_needed = (1+card_count) * SCM_GC_SIZEOF_CARD
90 + SCM_GC_CARD_BVEC_SIZE_IN_LONGS * card_count * SCM_SIZEOF_LONG
91 ;
92 scm_t_c_bvec_long * bvec_ptr = 0;
93 scm_t_cell * memory = 0;
94
95 /*
96 We use calloc to alloc the heap. On GNU libc this is
97 equivalent to mmapping /dev/zero
98 */
99 SCM_SYSCALL (memory = (scm_t_cell * ) calloc (1, mem_needed));
100
101 if (memory == NULL)
102 return 0;
103
104 segment->malloced = memory;
105 segment->bounds[0] = SCM_GC_CARD_UP (memory);
106 segment->bounds[1] = segment->bounds[0] + card_count * SCM_GC_CARD_N_CELLS;
107
108 segment->freelist->heap_size += scm_i_segment_cell_count (segment);
109
110 bvec_ptr = (scm_t_c_bvec_long*) segment->bounds[1];
111
112 /*
113 Don't init the mem or the bitvector. This is handled by lazy
114 sweeping.
115 */
116
117 segment->next_free_card = segment->bounds[0];
118 segment->first_time = 1;
119 return 1;
120 }
121
122 int
scm_i_segment_card_count(scm_t_heap_segment * seg)123 scm_i_segment_card_count (scm_t_heap_segment * seg)
124 {
125 return (seg->bounds[1] - seg->bounds[0]) / SCM_GC_CARD_N_CELLS;
126 }
127
128 /*
129 Return the number of available single-cell data cells.
130 */
131 int
scm_i_segment_cell_count(scm_t_heap_segment * seg)132 scm_i_segment_cell_count (scm_t_heap_segment * seg)
133 {
134 return scm_i_segment_card_count (seg) * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS)
135 + ((seg->span == 2) ? -1 : 0);
136 }
137
138 void
scm_i_clear_segment_mark_space(scm_t_heap_segment * seg)139 scm_i_clear_segment_mark_space (scm_t_heap_segment *seg)
140 {
141 scm_t_cell * markspace = seg->bounds[1];
142
143 memset (markspace, 0x00,
144 scm_i_segment_card_count (seg) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS * SCM_SIZEOF_LONG);
145 }
146
147 /*
148 Sweep cards from SEG until we've gathered THRESHOLD cells
149
150 RETURN:
151
152 Freelist.
153 */
154 SCM
scm_i_sweep_some_cards(scm_t_heap_segment * seg)155 scm_i_sweep_some_cards (scm_t_heap_segment *seg)
156 {
157 SCM cells = SCM_EOL;
158 int threshold = 512;
159 int collected = 0;
160 int (*sweeper) (scm_t_cell *, SCM *, scm_t_heap_segment* )
161 = (seg->first_time) ? &scm_i_init_card_freelist : &scm_i_sweep_card;
162
163 scm_t_cell * next_free = seg->next_free_card;
164 int cards_swept = 0;
165
166 while (collected < threshold && next_free < seg->bounds[1])
167 {
168 collected += (*sweeper) (next_free, &cells, seg);
169 next_free += SCM_GC_CARD_N_CELLS;
170 cards_swept ++;
171 }
172
173 scm_gc_cells_swept += cards_swept * (SCM_GC_CARD_N_CELLS - SCM_GC_CARD_N_HEADER_CELLS);
174 scm_gc_cells_collected += collected * seg->span;
175
176 if (!seg->first_time)
177 {
178 scm_gc_cells_allocated_acc +=
179 (scm_cells_allocated - scm_last_cells_allocated);
180
181 scm_cells_allocated -= collected * seg->span;
182 scm_last_cells_allocated = scm_cells_allocated;
183 }
184 seg->freelist->collected += collected * seg->span;
185
186
187 if(next_free == seg->bounds[1])
188 {
189 seg->first_time = 0;
190 }
191
192 seg->next_free_card = next_free;
193 return cells;
194 }
195
196
197 /*
198 Force a sweep of this entire segment. This doesn't modify sweep
199 statistics, it just frees the memory pointed to by to-be-swept
200 cells.
201
202 Implementation is slightly ugh.
203
204 FIXME: if you do scm_i_sweep_segment(), and then allocate from this
205 segment again, the statistics are off.
206 */
207 void
scm_i_sweep_segment(scm_t_heap_segment * seg)208 scm_i_sweep_segment (scm_t_heap_segment * seg)
209 {
210 scm_t_cell * p = seg->next_free_card;
211 int yield = scm_gc_cells_collected;
212 int coll = seg->freelist->collected;
213 unsigned long alloc = scm_cells_allocated ;
214 unsigned long last_alloc = scm_last_cells_allocated;
215 double last_total
216 = scm_gc_cells_allocated_acc
217 + (alloc - last_alloc);
218
219 while (scm_i_sweep_some_cards (seg) != SCM_EOL)
220 ;
221
222 scm_gc_cells_collected = yield;
223
224 /*
225 * restore old stats.
226 */
227 scm_gc_cells_allocated_acc = last_total;
228 scm_cells_allocated = alloc;
229 scm_last_cells_allocated = alloc;
230
231 seg->freelist->collected = coll;
232 seg->next_free_card =p;
233 }
234
235 void
scm_i_sweep_all_segments(char const * reason)236 scm_i_sweep_all_segments (char const *reason)
237 {
238 int i= 0;
239
240 for (i = 0; i < scm_i_heap_segment_table_size; i++)
241 {
242 scm_i_sweep_segment (scm_i_heap_segment_table[i]);
243 }
244 }
245
246
247 /*
248 Heap segment table.
249
250 The table is sorted by the address of the data itself. This makes
251 for easy lookups. This is not portable: according to ANSI C,
252 pointers can only be compared within the same object (i.e. the same
253 block of malloced memory.). For machines with weird architectures,
254 this should be revised.
255
256 (Apparently, for this reason 1.6 and earlier had macros for pointer
257 comparison. )
258
259 perhaps it is worthwhile to remove the 2nd level of indirection in
260 the table, but this certainly makes for cleaner code.
261 */
262 scm_t_heap_segment ** scm_i_heap_segment_table;
263 size_t scm_i_heap_segment_table_size;
264 scm_t_cell *lowest_cell;
265 scm_t_cell *highest_cell;
266
267
268 void
scm_i_clear_mark_space(void)269 scm_i_clear_mark_space (void)
270 {
271 int i = 0;
272 for (; i < scm_i_heap_segment_table_size; i++)
273 {
274 scm_i_clear_segment_mark_space (scm_i_heap_segment_table[i]);
275 }
276 }
277
278
279 /*
280 RETURN: index of inserted segment.
281 */
282 int
scm_i_insert_segment(scm_t_heap_segment * seg)283 scm_i_insert_segment (scm_t_heap_segment * seg)
284 {
285 size_t size = (scm_i_heap_segment_table_size + 1) * sizeof (scm_t_heap_segment *);
286 SCM_SYSCALL(scm_i_heap_segment_table = ((scm_t_heap_segment **)
287 realloc ((char *)scm_i_heap_segment_table, size)));
288
289 /*
290 We can't alloc 4 more bytes. This is hopeless.
291 */
292 if (!scm_i_heap_segment_table)
293 {
294 fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
295 abort ();
296 }
297
298 if (!lowest_cell)
299 {
300 lowest_cell = seg->bounds[0];
301 highest_cell = seg->bounds[1];
302 }
303 else
304 {
305 lowest_cell = SCM_MIN (lowest_cell, seg->bounds[0]);
306 highest_cell = SCM_MAX (highest_cell, seg->bounds[1]);
307 }
308
309
310 {
311 int i = 0;
312 int j = 0;
313
314 while (i < scm_i_heap_segment_table_size
315 && scm_i_heap_segment_table[i]->bounds[0] <= seg->bounds[0])
316 i++;
317
318 /*
319 We insert a new entry; if that happens to be before the
320 "current" segment of a freelist, we must move the freelist index
321 as well.
322 */
323 if (scm_i_master_freelist.heap_segment_idx >= i)
324 scm_i_master_freelist.heap_segment_idx ++;
325 if (scm_i_master_freelist2.heap_segment_idx >= i)
326 scm_i_master_freelist2.heap_segment_idx ++;
327
328 for (j = scm_i_heap_segment_table_size; j > i; --j)
329 scm_i_heap_segment_table[j] = scm_i_heap_segment_table[j - 1];
330
331 scm_i_heap_segment_table [i] = seg;
332 scm_i_heap_segment_table_size ++;
333
334 return i;
335 }
336 }
337
338 SCM
scm_i_sweep_some_segments(scm_t_cell_type_statistics * fl)339 scm_i_sweep_some_segments (scm_t_cell_type_statistics * fl)
340 {
341 int i = fl->heap_segment_idx;
342 SCM collected = SCM_EOL;
343
344 if (i == -1)
345 i++;
346
347 for (;
348 i < scm_i_heap_segment_table_size; i++)
349 {
350 if (scm_i_heap_segment_table[i]->freelist != fl)
351 continue;
352
353 collected = scm_i_sweep_some_cards (scm_i_heap_segment_table[i]);
354
355
356 if (collected != SCM_EOL) /* Don't increment i */
357 break;
358 }
359
360 fl->heap_segment_idx = i;
361
362 return collected;
363 }
364
365
366 void
scm_i_reset_segments(void)367 scm_i_reset_segments (void)
368 {
369 int i = 0;
370 for (; i < scm_i_heap_segment_table_size; i++)
371 {
372 scm_t_heap_segment * seg = scm_i_heap_segment_table[i];
373 seg->next_free_card = seg->bounds[0];
374 }
375 }
376
377 /*
378 Return a hashtab with counts of live objects, with tags as keys.
379 */
380
381
382 SCM
scm_i_all_segments_statistics(SCM tab)383 scm_i_all_segments_statistics (SCM tab)
384 {
385 int i = 0;
386 for (; i < scm_i_heap_segment_table_size; i++)
387 {
388 scm_t_heap_segment * seg = scm_i_heap_segment_table[i];
389 scm_i_heap_segment_statistics (seg, tab);
390 }
391
392 return tab;
393 }
394
395
396
397
398 /*
399 Determine whether the given value does actually represent a cell in
400 some heap segment. If this is the case, the number of the heap
401 segment is returned. Otherwise, -1 is returned. Binary search is
402 used to determine the heap segment that contains the cell.
403
404
405 I think this function is too long to be inlined. --hwn
406 */
407 long int
scm_i_find_heap_segment_containing_object(SCM obj)408 scm_i_find_heap_segment_containing_object (SCM obj)
409 {
410 if (!CELL_P (obj))
411 return -1;
412
413 if ((scm_t_cell* ) obj < lowest_cell || (scm_t_cell*) obj >= highest_cell)
414 return -1;
415
416
417 {
418 scm_t_cell * ptr = SCM2PTR (obj);
419 unsigned long int i = 0;
420 unsigned long int j = scm_i_heap_segment_table_size - 1;
421
422 if (ptr < scm_i_heap_segment_table[i]->bounds[0])
423 return -1;
424 else if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
425 return -1;
426 else
427 {
428 while (i < j)
429 {
430 if (ptr < scm_i_heap_segment_table[i]->bounds[1])
431 {
432 break;
433 }
434 else if (scm_i_heap_segment_table[j]->bounds[0] <= ptr)
435 {
436 i = j;
437 break;
438 }
439 else
440 {
441 unsigned long int k = (i + j) / 2;
442
443 if (k == i)
444 return -1;
445 else if (ptr < scm_i_heap_segment_table[k]->bounds[1])
446 {
447 j = k;
448 ++i;
449 if (ptr < scm_i_heap_segment_table[i]->bounds[0])
450 return -1;
451 }
452 else if (scm_i_heap_segment_table[k]->bounds[0] <= ptr)
453 {
454 i = k;
455 --j;
456 if (scm_i_heap_segment_table[j]->bounds[1] <= ptr)
457 return -1;
458 }
459 }
460 }
461
462 if (!SCM_DOUBLECELL_ALIGNED_P (obj) && scm_i_heap_segment_table[i]->span == 2)
463 return -1;
464 else if (SCM_GC_IN_CARD_HEADERP (ptr))
465 return -1;
466 else
467 return i;
468 }
469 }
470 }
471
472
473 /*
474 Important entry point: try to grab some memory, and make it into a
475 segment.
476
477 RETURN: the index of the segment.
478 */
479 int
scm_i_get_new_heap_segment(scm_t_cell_type_statistics * freelist,policy_on_error error_policy)480 scm_i_get_new_heap_segment (scm_t_cell_type_statistics *freelist,
481 policy_on_error error_policy)
482 {
483 size_t len;
484
485 {
486 /* Assure that the new segment is predicted to be large enough.
487 *
488 * New yield should at least equal GC fraction of new heap size, i.e.
489 *
490 * y + dh > f * (h + dh)
491 *
492 * y : yield
493 * f : min yield fraction
494 * h : heap size
495 * dh : size of new heap segment
496 *
497 * This gives dh > (f * h - y) / (1 - f)
498 */
499 float f = freelist->min_yield_fraction / 100.0;
500 float h = SCM_HEAP_SIZE;
501 float min_cells
502 = (f * h - scm_gc_cells_collected) / (1.0 - f);
503
504 /* Make heap grow with factor 1.5 */
505 len = freelist->heap_size / 2;
506 #ifdef DEBUGINFO
507 fprintf (stderr, "(%ld < %ld)", (long) len, (long) min_cells);
508 #endif
509
510 if (len < min_cells)
511 len = (unsigned long) min_cells;
512 len *= sizeof (scm_t_cell);
513 /* force new sampling */
514 freelist->collected = LONG_MAX;
515 }
516
517 if (len > scm_max_segment_size)
518 len = scm_max_segment_size;
519 if (len < SCM_MIN_HEAP_SEG_SIZE)
520 len = SCM_MIN_HEAP_SEG_SIZE;
521
522 {
523 scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
524
525 /* Allocate with decaying ambition. */
526 while (len >= SCM_MIN_HEAP_SEG_SIZE)
527 {
528 if (scm_i_initialize_heap_segment_data (seg, len))
529 {
530 return scm_i_insert_segment (seg);
531 }
532
533 len /= 2;
534 }
535 }
536
537 if (error_policy == abort_on_error)
538 {
539 fprintf (stderr, "scm_i_get_new_heap_segment: Could not grow heap.\n");
540 abort ();
541 }
542 return -1;
543 }
544
545 void
scm_i_make_initial_segment(int init_heap_size,scm_t_cell_type_statistics * freelist)546 scm_i_make_initial_segment (int init_heap_size, scm_t_cell_type_statistics *freelist)
547 {
548 scm_t_heap_segment * seg = scm_i_make_empty_heap_segment (freelist);
549
550 if (init_heap_size < 1)
551 {
552 init_heap_size = SCM_DEFAULT_INIT_HEAP_SIZE_1;
553 }
554
555 if (scm_i_initialize_heap_segment_data (seg, init_heap_size))
556 {
557 freelist->heap_segment_idx = scm_i_insert_segment (seg);
558 }
559
560 /*
561 Why the fuck try twice? --hwn
562 */
563 if (!seg->malloced)
564 {
565 scm_i_initialize_heap_segment_data (seg, SCM_HEAP_SEG_SIZE);
566 }
567
568 if (freelist->min_yield_fraction)
569 freelist->min_yield = (freelist->heap_size * freelist->min_yield_fraction
570 / 100);
571 }
572