static void init_atoms_r(CAML_R)
{
int i;
for(i = 0; i < 256; i++) caml_atom_table[i] = Make_header(0, i, Caml_white);
if (caml_page_table_add_r(ctx, In_static_data,
caml_atom_table, caml_atom_table + 256) != 0) {
caml_fatal_error("Fatal error: not enough memory for the initial page table");
}
}
void caml_compact_heap_r (CAML_R)
{
uintnat target_words, target_size, live;
do_compaction_r (ctx);
/* Compaction may fail to shrink the heap to a reasonable size
because it deals in complete chunks: if a very large chunk
is at the beginning of the heap, everything gets moved to
it and it is not freed.
In that case, we allocate a new chunk of the desired heap
size, chain it at the beginning of the heap (thus pretending
its address is smaller), and launch a second compaction.
This will move all data to this new chunk and free the
very large chunk.
See PR#5389
*/
/* We compute:
freewords = caml_fl_cur_size (exact)
heapwords = Wsize_bsize (caml_heap_size) (exact)
live = heapwords - freewords
wanted = caml_percent_free * (live / 100 + 1) (same as in do_compaction)
target_words = live + wanted
We add one page to make sure a small difference in counting sizes
won't make [do_compaction] keep the second block (and break all sorts
of invariants).
We recompact if target_size < heap_size / 2
*/
live = Wsize_bsize (caml_stat_heap_size) - caml_fl_cur_size;
target_words = live + caml_percent_free * (live / 100 + 1)
+ Wsize_bsize (Page_size);
target_size = caml_round_heap_chunk_size_r (ctx, Bsize_wsize (target_words));
if (target_size < caml_stat_heap_size / 2){
char *chunk;
caml_gc_message (0x10, "Recompacting heap (target=%luk)\n",
target_size / 1024);
chunk = caml_alloc_for_heap (target_size);
if (chunk == NULL) return;
/* PR#5757: we need to make the new blocks blue, or they won't be
recognized as free by the recompaction. */
caml_make_free_blocks_r (ctx, (value *) chunk,
Wsize_bsize (Chunk_size (chunk)), 0, Caml_blue);
if (caml_page_table_add_r (ctx, In_heap, chunk, chunk + Chunk_size (chunk)) != 0){
caml_free_for_heap (chunk);
return;
}
Chunk_next (chunk) = caml_heap_start;
caml_heap_start = chunk;
++ caml_stat_heap_chunks;
caml_stat_heap_size += Chunk_size (chunk);
if (caml_stat_heap_size > caml_stat_top_heap_size){
caml_stat_top_heap_size = caml_stat_heap_size;
}
do_compaction_r (ctx);
Assert (caml_stat_heap_chunks == 1);
Assert (Chunk_next (caml_heap_start) == NULL);
Assert (caml_stat_heap_size == Chunk_size (chunk));
}
}