230 lines
6.5 KiB
C
230 lines
6.5 KiB
C
/***********************************************************************/
|
|
/* */
|
|
/* Caml Special Light */
|
|
/* */
|
|
/* Damien Doligez, projet Para, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 1995 Institut National de Recherche en Informatique et */
|
|
/* Automatique. Distributed only by permission. */
|
|
/* */
|
|
/***********************************************************************/
|
|
|
|
/* $Id$ */
|
|
|
|
#include <string.h>
|
|
#include "fail.h"
|
|
#include "freelist.h"
|
|
#include "gc.h"
|
|
#include "gc_ctrl.h"
|
|
#include "major_gc.h"
|
|
#include "memory.h"
|
|
#include "minor_gc.h"
|
|
#include "misc.h"
|
|
#include "mlvalues.h"
|
|
#include "signals.h"
|
|
|
|
/* Allocate more memory from malloc for the heap.
|
|
Return a block of at least the requested size (in words).
|
|
Return NULL when out of memory.
|
|
*/
|
|
static char *expand_heap (request)
|
|
mlsize_t request;
|
|
{
|
|
char *mem;
|
|
page_table_entry *new_page_table;
|
|
asize_t new_page_table_size;
|
|
asize_t malloc_request;
|
|
asize_t i, more_pages;
|
|
|
|
malloc_request = round_heap_chunk_size (Bhsize_wosize (request));
|
|
gc_message ("Growing heap to %ldk\n",
|
|
(stat_heap_size + malloc_request) / 1024);
|
|
mem = aligned_malloc (malloc_request + sizeof (heap_chunk_head),
|
|
sizeof (heap_chunk_head));
|
|
if (mem == NULL){
|
|
gc_message ("No room for growing heap\n", 0);
|
|
return NULL;
|
|
}
|
|
mem += sizeof (heap_chunk_head);
|
|
(((heap_chunk_head *) mem) [-1]).size = malloc_request;
|
|
Assert (Wosize_bhsize (malloc_request) >= request);
|
|
Hd_hp (mem) = Make_header (Wosize_bhsize (malloc_request), 0, Blue);
|
|
|
|
if (mem < heap_start){
|
|
more_pages = -Page (mem);
|
|
}else if (Page (mem + malloc_request) > page_table_size){
|
|
Assert (mem >= heap_end);
|
|
more_pages = Page (mem + malloc_request) - page_table_size;
|
|
}else{
|
|
more_pages = 0;
|
|
}
|
|
|
|
if (more_pages != 0){
|
|
new_page_table_size = page_table_size + more_pages;
|
|
new_page_table =
|
|
(page_table_entry *)
|
|
malloc(new_page_table_size * sizeof(page_table_entry));
|
|
if (new_page_table == NULL){
|
|
gc_message ("No room for growing page table\n", 0);
|
|
free (mem);
|
|
return NULL;
|
|
}
|
|
} else {
|
|
new_page_table = NULL;
|
|
new_page_table_size = 0;
|
|
}
|
|
|
|
if (mem < heap_start){
|
|
Assert (more_pages != 0);
|
|
for (i = 0; i < more_pages; i++){
|
|
new_page_table [i] = Not_in_heap;
|
|
}
|
|
bcopy (page_table, new_page_table + more_pages,
|
|
page_table_size * sizeof(page_table_entry));
|
|
(((heap_chunk_head *) mem) [-1]).next = heap_start;
|
|
heap_start = mem;
|
|
}else{
|
|
char **last;
|
|
char *cur;
|
|
|
|
if (mem >= heap_end) heap_end = mem + malloc_request;
|
|
if (more_pages != 0){
|
|
for (i = page_table_size; i < new_page_table_size; i++){
|
|
new_page_table [i] = Not_in_heap;
|
|
}
|
|
bcopy (page_table, new_page_table,
|
|
page_table_size * sizeof(page_table_entry));
|
|
}
|
|
last = &heap_start;
|
|
cur = *last;
|
|
while (cur != NULL && cur < mem){
|
|
last = &((((heap_chunk_head *) cur) [-1]).next);
|
|
cur = *last;
|
|
}
|
|
(((heap_chunk_head *) mem) [-1]).next = cur;
|
|
*last = mem;
|
|
}
|
|
|
|
if (more_pages != 0){
|
|
free ((char *) page_table);
|
|
page_table = new_page_table;
|
|
page_table_size = new_page_table_size;
|
|
}
|
|
|
|
for (i = Page (mem); i < Page (mem + malloc_request); i++){
|
|
page_table [i] = In_heap;
|
|
}
|
|
stat_heap_size += malloc_request;
|
|
return Bp_hp (mem);
|
|
}
|
|
|
|
value alloc_shr (wosize, tag)
|
|
mlsize_t wosize;
|
|
tag_t tag;
|
|
{
|
|
char *hp, *new_block;
|
|
|
|
hp = fl_allocate (wosize);
|
|
if (hp == NULL){
|
|
new_block = expand_heap (wosize);
|
|
if (new_block == NULL) {
|
|
if (in_minor_collection)
|
|
fatal_error ("Fatal error: out of memory.\n");
|
|
else
|
|
raise_out_of_memory ();
|
|
}
|
|
fl_add_block (new_block);
|
|
hp = fl_allocate (wosize);
|
|
}
|
|
|
|
Assert (Is_in_heap (Val_hp (hp)));
|
|
|
|
if (gc_phase == Phase_mark || (addr)hp >= (addr)gc_sweep_hp){
|
|
Hd_hp (hp) = Make_header (wosize, tag, Black);
|
|
}else{
|
|
Hd_hp (hp) = Make_header (wosize, tag, White);
|
|
}
|
|
allocated_words += Whsize_wosize (wosize);
|
|
if (allocated_words > Wsize_bsize (minor_heap_size)) urge_major_slice ();
|
|
return Val_hp (hp);
|
|
}
|
|
|
|
/* Use this function to tell the major GC to speed up when you use
|
|
finalized objects to automatically deallocate extra-heap objects.
|
|
The GC will do at least one cycle every [max] allocated words;
|
|
[mem] is the number of words allocated this time.
|
|
Note that only [mem/max] is relevant. You can use numbers of bytes
|
|
(or kilobytes, ...) instead of words. You can change units between
|
|
calls to [adjust_collector_speed].
|
|
*/
|
|
void adjust_gc_speed (mem, max)
|
|
mlsize_t mem, max;
|
|
{
|
|
if (max == 0) max = 1;
|
|
if (mem > max) mem = max;
|
|
extra_heap_memory += ((float) mem / max) * stat_heap_size;
|
|
if (extra_heap_memory > stat_heap_size){
|
|
extra_heap_memory = stat_heap_size;
|
|
}
|
|
if (extra_heap_memory > Wsize_bsize (minor_heap_size) / 2)
|
|
urge_major_slice ();
|
|
}
|
|
|
|
/* You must use [initialize] to store the initial value in a field of
|
|
a shared block, unless you are sure the value is not a young block.
|
|
A block value [v] is a shared block if and only if [Is_in_heap (v)]
|
|
is true.
|
|
*/
|
|
/* [initialize] never calls the GC, so you may call it while an object is
|
|
unfinished (i.e. just after a call to [alloc_shr].) */
|
|
void initialize (fp, val)
|
|
value *fp;
|
|
value val;
|
|
{
|
|
*fp = val;
|
|
Assert (Is_in_heap (fp));
|
|
if (Is_block (val) && Is_young (val)){
|
|
*ref_table_ptr++ = fp;
|
|
if (ref_table_ptr >= ref_table_limit){
|
|
realloc_ref_table ();
|
|
}
|
|
}
|
|
}
|
|
|
|
/* You must use [modify] to change a field of an existing shared block,
|
|
unless you are sure the value being overwritten is not a shared block and
|
|
the value being written is not a young block. */
|
|
/* [modify] never calls the GC. */
|
|
void modify (fp, val)
|
|
value *fp;
|
|
value val;
|
|
{
|
|
Modify (fp, val);
|
|
}
|
|
|
|
char *stat_alloc (sz)
|
|
asize_t sz;
|
|
{
|
|
char *result = (char *) malloc (sz);
|
|
|
|
if (result == NULL) raise_out_of_memory ();
|
|
return result;
|
|
}
|
|
|
|
void stat_free (blk)
|
|
char * blk;
|
|
{
|
|
free (blk);
|
|
}
|
|
|
|
char *stat_resize (blk, sz)
|
|
char *blk;
|
|
asize_t sz;
|
|
{
|
|
char *result = (char *) realloc (blk, sz);
|
|
|
|
if (result == NULL) raise_out_of_memory ();
|
|
return result;
|
|
}
|
|
|