1 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2006 Free Software Foundation, Inc.
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.
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.
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
22 #include "libguile/_scm.h"
23 #include "libguile/pairs.h"
24 #include "libguile/gc.h"
25 #include "libguile/private-gc.h"
27 size_t scm_max_segment_size
;
30 scm_i_make_empty_heap_segment (scm_t_cell_type_statistics
*fl
)
32 scm_t_heap_segment
* shs
= malloc (sizeof (scm_t_heap_segment
));
36 fprintf (stderr
, "scm_i_get_new_heap_segment: out of memory.\n");
40 shs
->bounds
[0] = NULL
;
41 shs
->bounds
[1] = NULL
;
45 shs
->next_free_card
= NULL
;
52 scm_i_heap_segment_statistics (scm_t_heap_segment
*seg
, SCM tab
)
54 scm_t_cell
*p
= seg
->bounds
[0];
55 while (p
< seg
->bounds
[1])
57 scm_i_card_statistics (p
, tab
, seg
);
58 p
+= SCM_GC_CARD_N_CELLS
;
63 Fill SEGMENT with memory both for data and mark bits.
65 RETURN: 1 on success, 0 failure
68 scm_i_initialize_heap_segment_data (scm_t_heap_segment
* segment
, size_t requested
)
73 int card_data_cell_count
= (SCM_GC_CARD_N_CELLS
- SCM_GC_CARD_N_HEADER_CELLS
);
74 int card_count
=1 + (requested
/ sizeof (scm_t_cell
)) / card_data_cell_count
;
77 one card extra due to alignment
79 size_t mem_needed
= (1+card_count
) * SCM_GC_SIZEOF_CARD
80 + SCM_GC_CARD_BVEC_SIZE_IN_LONGS
* card_count
* SCM_SIZEOF_LONG
82 scm_t_c_bvec_long
* bvec_ptr
= 0;
83 scm_t_cell
* memory
= 0;
86 We use calloc to alloc the heap. On GNU libc this is
87 equivalent to mmapping /dev/zero
89 SCM_SYSCALL (memory
= (scm_t_cell
* ) calloc (1, mem_needed
));
94 segment
->malloced
= memory
;
95 segment
->bounds
[0] = SCM_GC_CARD_UP (memory
);
96 segment
->bounds
[1] = segment
->bounds
[0] + card_count
* SCM_GC_CARD_N_CELLS
;
98 segment
->freelist
->heap_size
+= scm_i_segment_cell_count (segment
);
100 bvec_ptr
= (scm_t_c_bvec_long
*) segment
->bounds
[1];
103 Don't init the mem or the bitvector. This is handled by lazy
107 segment
->next_free_card
= segment
->bounds
[0];
108 segment
->first_time
= 1;
113 scm_i_segment_card_count (scm_t_heap_segment
* seg
)
115 return (seg
->bounds
[1] - seg
->bounds
[0]) / SCM_GC_CARD_N_CELLS
;
119 Return the number of available single-cell data cells.
122 scm_i_segment_cell_count (scm_t_heap_segment
* seg
)
124 return scm_i_segment_card_count (seg
) * (SCM_GC_CARD_N_CELLS
- SCM_GC_CARD_N_HEADER_CELLS
)
125 + ((seg
->span
== 2) ? -1 : 0);
129 scm_i_clear_segment_mark_space (scm_t_heap_segment
*seg
)
131 scm_t_cell
* markspace
= seg
->bounds
[1];
133 memset (markspace
, 0x00,
134 scm_i_segment_card_count (seg
) * SCM_GC_CARD_BVEC_SIZE_IN_LONGS
* SCM_SIZEOF_LONG
);
137 /* Sweep cards from SEG until we've gathered THRESHOLD cells. On return,
138 SWEEP_STATS contains the number of cells that have been visited and
139 collected. A freelist is returned, potentially empty. */
141 scm_i_sweep_some_cards (scm_t_heap_segment
*seg
,
142 scm_t_sweep_statistics
*sweep_stats
)
147 int (*sweeper
) (scm_t_cell
*, SCM
*, scm_t_heap_segment
* )
148 = (seg
->first_time
) ? &scm_i_init_card_freelist
: &scm_i_sweep_card
;
150 scm_t_cell
* next_free
= seg
->next_free_card
;
153 while (collected
< threshold
&& next_free
< seg
->bounds
[1])
155 collected
+= (*sweeper
) (next_free
, &cells
, seg
);
156 next_free
+= SCM_GC_CARD_N_CELLS
;
160 sweep_stats
->swept
= cards_swept
* seg
->span
161 * (SCM_GC_CARD_N_CELLS
- SCM_GC_CARD_N_HEADER_CELLS
);
163 if (!seg
->first_time
)
165 /* scm_cells_allocated -= collected * seg->span; */
166 sweep_stats
->collected
= collected
* seg
->span
;
169 sweep_stats
->collected
= 0;
171 seg
->freelist
->collected
+= collected
* seg
->span
;
173 if(next_free
== seg
->bounds
[1])
178 seg
->next_free_card
= next_free
;
184 Force a sweep of this entire segment. This doesn't modify sweep
185 statistics, it just frees the memory pointed to by to-be-swept
188 Implementation is slightly ugh.
190 FIXME: if you do scm_i_sweep_segment(), and then allocate from this
191 segment again, the statistics are off.
194 scm_i_sweep_segment (scm_t_heap_segment
*seg
,
195 scm_t_sweep_statistics
*sweep_stats
)
197 scm_t_sweep_statistics sweep
;
198 scm_t_cell
* p
= seg
->next_free_card
;
200 scm_i_sweep_statistics_init (sweep_stats
);
202 scm_i_sweep_statistics_init (&sweep
);
203 while (scm_i_sweep_some_cards (seg
, &sweep
) != SCM_EOL
)
205 scm_i_sweep_statistics_sum (sweep_stats
, sweep
);
206 scm_i_sweep_statistics_init (&sweep
);
209 seg
->next_free_card
=p
;
213 scm_i_sweep_all_segments (char const *reason
,
214 scm_t_sweep_statistics
*sweep_stats
)
218 scm_i_sweep_statistics_init (sweep_stats
);
219 for (i
= 0; i
< scm_i_heap_segment_table_size
; i
++)
221 scm_t_sweep_statistics sweep
;
223 scm_i_sweep_segment (scm_i_heap_segment_table
[i
], &sweep
);
224 scm_i_sweep_statistics_sum (sweep_stats
, sweep
);
232 The table is sorted by the address of the data itself. This makes
233 for easy lookups. This is not portable: according to ANSI C,
234 pointers can only be compared within the same object (i.e. the same
235 block of malloced memory.). For machines with weird architectures,
236 this should be revised.
238 (Apparently, for this reason 1.6 and earlier had macros for pointer
241 perhaps it is worthwhile to remove the 2nd level of indirection in
242 the table, but this certainly makes for cleaner code.
244 scm_t_heap_segment
** scm_i_heap_segment_table
;
245 size_t scm_i_heap_segment_table_size
;
246 scm_t_cell
*lowest_cell
;
247 scm_t_cell
*highest_cell
;
251 scm_i_clear_mark_space (void)
254 for (; i
< scm_i_heap_segment_table_size
; i
++)
256 scm_i_clear_segment_mark_space (scm_i_heap_segment_table
[i
]);
262 RETURN: index of inserted segment.
265 scm_i_insert_segment (scm_t_heap_segment
* seg
)
267 size_t size
= (scm_i_heap_segment_table_size
+ 1) * sizeof (scm_t_heap_segment
*);
268 SCM_SYSCALL(scm_i_heap_segment_table
= ((scm_t_heap_segment
**)
269 realloc ((char *)scm_i_heap_segment_table
, size
)));
272 We can't alloc 4 more bytes. This is hopeless.
274 if (!scm_i_heap_segment_table
)
276 fprintf (stderr
, "scm_i_get_new_heap_segment: Could not grow heap segment table.\n");
282 lowest_cell
= seg
->bounds
[0];
283 highest_cell
= seg
->bounds
[1];
287 lowest_cell
= SCM_MIN (lowest_cell
, seg
->bounds
[0]);
288 highest_cell
= SCM_MAX (highest_cell
, seg
->bounds
[1]);
296 while (i
< scm_i_heap_segment_table_size
297 && scm_i_heap_segment_table
[i
]->bounds
[0] <= seg
->bounds
[0])
301 We insert a new entry; if that happens to be before the
302 "current" segment of a freelist, we must move the freelist index
305 if (scm_i_master_freelist
.heap_segment_idx
>= i
)
306 scm_i_master_freelist
.heap_segment_idx
++;
307 if (scm_i_master_freelist2
.heap_segment_idx
>= i
)
308 scm_i_master_freelist2
.heap_segment_idx
++;
310 for (j
= scm_i_heap_segment_table_size
; j
> i
; --j
)
311 scm_i_heap_segment_table
[j
] = scm_i_heap_segment_table
[j
- 1];
313 scm_i_heap_segment_table
[i
] = seg
;
314 scm_i_heap_segment_table_size
++;
321 scm_i_sweep_some_segments (scm_t_cell_type_statistics
*fl
,
322 scm_t_sweep_statistics
*sweep_stats
)
324 int i
= fl
->heap_segment_idx
;
325 SCM collected
= SCM_EOL
;
327 scm_i_sweep_statistics_init (sweep_stats
);
332 i
< scm_i_heap_segment_table_size
; i
++)
334 scm_t_sweep_statistics sweep
;
336 if (scm_i_heap_segment_table
[i
]->freelist
!= fl
)
339 scm_i_sweep_statistics_init (&sweep
);
340 collected
= scm_i_sweep_some_cards (scm_i_heap_segment_table
[i
],
343 scm_i_sweep_statistics_sum (sweep_stats
, sweep
);
345 if (collected
!= SCM_EOL
) /* Don't increment i */
349 fl
->heap_segment_idx
= i
;
356 scm_i_reset_segments (void)
359 for (; i
< scm_i_heap_segment_table_size
; i
++)
361 scm_t_heap_segment
* seg
= scm_i_heap_segment_table
[i
];
362 seg
->next_free_card
= seg
->bounds
[0];
367 Return a hashtab with counts of live objects, with tags as keys.
372 scm_i_all_segments_statistics (SCM tab
)
375 for (; i
< scm_i_heap_segment_table_size
; i
++)
377 scm_t_heap_segment
* seg
= scm_i_heap_segment_table
[i
];
378 scm_i_heap_segment_statistics (seg
, tab
);
385 Determine whether the given value does actually represent a cell in
386 some heap segment. If this is the case, the number of the heap
387 segment is returned. Otherwise, -1 is returned. Binary search is
388 used to determine the heap segment that contains the cell.
391 I think this function is too long to be inlined. --hwn
394 scm_i_find_heap_segment_containing_object (SCM obj
)
399 if ((scm_t_cell
* ) obj
< lowest_cell
|| (scm_t_cell
*) obj
>= highest_cell
)
404 scm_t_cell
* ptr
= SCM2PTR (obj
);
405 unsigned long int i
= 0;
406 unsigned long int j
= scm_i_heap_segment_table_size
- 1;
408 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[0])
410 else if (scm_i_heap_segment_table
[j
]->bounds
[1] <= ptr
)
416 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[1])
420 else if (scm_i_heap_segment_table
[j
]->bounds
[0] <= ptr
)
427 unsigned long int k
= (i
+ j
) / 2;
431 else if (ptr
< scm_i_heap_segment_table
[k
]->bounds
[1])
435 if (ptr
< scm_i_heap_segment_table
[i
]->bounds
[0])
438 else if (scm_i_heap_segment_table
[k
]->bounds
[0] <= ptr
)
442 if (scm_i_heap_segment_table
[j
]->bounds
[1] <= ptr
)
448 if (!SCM_DOUBLECELL_ALIGNED_P (obj
) && scm_i_heap_segment_table
[i
]->span
== 2)
450 else if (SCM_GC_IN_CARD_HEADERP (ptr
))
459 /* Important entry point: try to grab some memory, and make it into a
460 segment; return the index of the segment. SWEEP_STATS should contain
461 global GC sweep statistics collected since the last full GC. */
463 scm_i_get_new_heap_segment (scm_t_cell_type_statistics
*freelist
,
464 scm_t_sweep_statistics sweep_stats
,
465 policy_on_error error_policy
)
470 /* Assure that the new segment is predicted to be large enough.
472 * New yield should at least equal GC fraction of new heap size, i.e.
474 * y + dh > f * (h + dh)
477 * f : min yield fraction
479 * dh : size of new heap segment
481 * This gives dh > (f * h - y) / (1 - f)
483 float f
= freelist
->min_yield_fraction
/ 100.0;
484 float h
= SCM_HEAP_SIZE
;
485 float min_cells
= (f
* h
- sweep_stats
.collected
) / (1.0 - f
);
487 /* Make heap grow with factor 1.5 */
488 len
= freelist
->heap_size
/ 2;
490 fprintf (stderr
, "(%ld < %ld)", (long) len
, (long) min_cells
);
494 len
= (unsigned long) min_cells
;
496 len
*= sizeof (scm_t_cell
);
497 /* force new sampling */
498 freelist
->collected
= LONG_MAX
;
501 if (len
> scm_max_segment_size
)
502 len
= scm_max_segment_size
;
504 if (len
< SCM_MIN_HEAP_SEG_SIZE
)
505 len
= SCM_MIN_HEAP_SEG_SIZE
;
508 scm_t_heap_segment
* seg
= scm_i_make_empty_heap_segment (freelist
);
510 /* Allocate with decaying ambition. */
511 while (len
>= SCM_MIN_HEAP_SEG_SIZE
)
513 if (scm_i_initialize_heap_segment_data (seg
, len
))
515 return scm_i_insert_segment (seg
);
522 if (error_policy
== abort_on_error
)
524 fprintf (stderr
, "scm_i_get_new_heap_segment: Could not grow heap.\n");
531 scm_i_make_initial_segment (int init_heap_size
, scm_t_cell_type_statistics
*freelist
)
533 scm_t_heap_segment
* seg
= scm_i_make_empty_heap_segment (freelist
);
535 if (init_heap_size
< 1)
537 init_heap_size
= SCM_DEFAULT_INIT_HEAP_SIZE_1
;
540 if (scm_i_initialize_heap_segment_data (seg
, init_heap_size
))
542 freelist
->heap_segment_idx
= scm_i_insert_segment (seg
);
546 Why the fuck try twice? --hwn
550 scm_i_initialize_heap_segment_data (seg
, SCM_HEAP_SEG_SIZE
);
553 if (freelist
->min_yield_fraction
)
554 freelist
->min_yield
= (freelist
->heap_size
* freelist
->min_yield_fraction