void caml_compact_heap (void) { uintnat target_size, live; do_compaction (); /* 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) heapsize = caml_heap_size (exact) live = heap_size - freewords target_size = live * (1 + caml_percent_free / 100) = live / 100 * (100 + caml_percent_free) We add 1 to live/100 to make sure it isn't 0. We recompact if target_size < heap_size / 2 */ live = caml_stat_heap_size - Bsize_wsize (caml_fl_cur_size); target_size = (live / 100 + 1) * (100 + caml_percent_free); target_size = caml_round_heap_chunk_size (target_size); if (target_size < caml_stat_heap_size / 2) { char *chunk; /* round it up to a page size */ chunk = caml_alloc_for_heap (target_size); if (chunk == NULL) return; caml_make_free_blocks ((value *) chunk, Wsize_bsize (Chunk_size (chunk)), 0); if (caml_page_table_add (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 (); Assert (caml_stat_heap_chunks == 1); Assert (Chunk_next (caml_heap_start) == NULL); } }
/* Allocate more memory from malloc for the heap. Return a blue block of at least the requested size. The blue block is chained to a sequence of blue blocks (through their field 0); the last block of the chain is pointed by field 1 of the first. There may be a fragment after the last block. The caller must insert the blocks into the free list. The request must be less than or equal to Max_wosize. Return NULL when out of memory. */ static char *expand_heap (mlsize_t request) { char *mem, *hp, *prev; asize_t over_request, malloc_request, remain; Assert (request <= Max_wosize); over_request = request + request / 100 * caml_percent_free; malloc_request = caml_round_heap_chunk_size (Bhsize_wosize (over_request)); mem = caml_alloc_for_heap (malloc_request); if (mem == NULL){ caml_gc_message (0x04, "No room for growing heap\n", 0); return NULL; } remain = malloc_request; prev = hp = mem; /* FIXME find a way to do this with a call to caml_make_free_blocks */ while (Wosize_bhsize (remain) > Max_wosize){ Hd_hp (hp) = Make_header (Max_wosize, 0, Caml_blue); #ifdef DEBUG caml_set_fields (Bp_hp (hp), 0, Debug_free_major); #endif hp += Bhsize_wosize (Max_wosize); remain -= Bhsize_wosize (Max_wosize); Field (Op_hp (mem), 1) = Field (Op_hp (prev), 0) = (value) Op_hp (hp); prev = hp; } if (remain > 1){ Hd_hp (hp) = Make_header (Wosize_bhsize (remain), 0, Caml_blue); #ifdef DEBUG caml_set_fields (Bp_hp (hp), 0, Debug_free_major); #endif Field (Op_hp (mem), 1) = Field (Op_hp (prev), 0) = (value) Op_hp (hp); Field (Op_hp (hp), 0) = (value) NULL; }else{ Field (Op_hp (prev), 0) = (value) NULL; if (remain == 1) Hd_hp (hp) = Make_header (0, 0, Caml_white); } Assert (Wosize_hp (mem) >= request); if (caml_add_to_heap (mem) != 0){ caml_free_for_heap (mem); return NULL; } return Bp_hp (mem); }
/* Allocate more memory from malloc for the heap. Return a blue block of at least the requested size (in words). The caller must insert the block into the free list. The request must be less than or equal to Max_wosize. Return NULL when out of memory. */ static char *expand_heap (mlsize_t request) { char *mem; asize_t malloc_request; malloc_request = caml_round_heap_chunk_size (Bhsize_wosize (request)); mem = caml_alloc_for_heap (malloc_request); if (mem == NULL){ caml_gc_message (0x04, "No room for growing heap\n", 0); return NULL; } Assert (Wosize_bhsize (malloc_request) >= request); Hd_hp (mem) = Make_header (Wosize_bhsize (malloc_request), 0, Caml_blue); if (caml_add_to_heap (mem) != 0){ caml_free_for_heap (mem); return NULL; } return Bp_hp (mem); }