void caml_set_minor_heap_size (asize_t size) { char *new_heap; void *new_heap_base; Assert (size >= Minor_heap_min); Assert (size <= Minor_heap_max); Assert (size % sizeof (value) == 0); if (caml_young_ptr != caml_young_end) caml_minor_collection (); Assert (caml_young_ptr == caml_young_end); new_heap = caml_aligned_malloc(size, 0, &new_heap_base); if (new_heap == NULL) caml_raise_out_of_memory(); if (caml_page_table_add(In_young, new_heap, new_heap + size) != 0) caml_raise_out_of_memory(); if (caml_young_start != NULL){ caml_page_table_remove(In_young, caml_young_start, caml_young_end); free (caml_young_base); } caml_young_base = new_heap_base; caml_young_start = new_heap; caml_young_end = new_heap + size; caml_young_limit = caml_young_start; caml_young_ptr = caml_young_end; caml_minor_heap_size = size; reset_table (&caml_ref_table); reset_table (&caml_weak_ref_table); }
void caml_set_minor_heap_size (asize_t size) { char *new_heap; void *new_heap_base; Assert (size >= Minor_heap_min); Assert (size <= Minor_heap_max); Assert (size % sizeof (value) == 0); if (caml_young_ptr != caml_young_end) caml_minor_collection (); Assert (caml_young_ptr == caml_young_end); new_heap = caml_aligned_malloc(size, 0, &new_heap_base); if (new_heap == NULL) caml_raise_out_of_memory(); if (caml_page_table_add(In_young, new_heap, new_heap + size) != 0) caml_raise_out_of_memory(); if (caml_young_start != NULL){ #ifdef SYS_xen /* XXX temporary until memory allocator works properly */ printk("caml_set_minor_heap_size: resize unsupported\n"); caml_raise_out_of_memory(); #else caml_page_table_remove(In_young, caml_young_start, caml_young_end); free (caml_young_base); #endif } caml_young_base = new_heap_base; caml_young_start = new_heap; caml_young_end = new_heap + size; caml_young_limit = caml_young_start; caml_young_ptr = caml_young_end; caml_minor_heap_size = size; reset_table (&caml_ref_table); reset_table (&caml_weak_ref_table); }
static void realloc_minor (value t, value null) { CAMLparam2(t, null); size_t size = t_minor_size(t); if (size == 0) size = 1; size = size * 2; if ((size * 2 > Max_young_wosize) || (caml_young_ptr - Whsize_wosize (size * 2) < caml_young_start)) { // Not enough room, no need to allocate: // collect minor heap, flush minor table if (!t_major_has_capacity(t, t_major_fill(t) + t_minor_fill(t) + 1)) realloc_major(t, null); caml_minor_collection(); flush_minor(t, null); } else { rehash_minor(t, null, size); } CAMLreturn0; }
/* size in bytes */ void caml_set_minor_heap_size (asize_t size) { if (caml_domain_state->young_ptr != caml_domain_state->young_end) caml_minor_collection (); caml_reallocate_minor_heap(size); reset_table (&caml_domain_state->remembered_set->ref); }
CAMLprim value caml_gc_minor(value v) { CAML_INSTR_SETUP (tmr, ""); CAMLassert (v == Val_unit); caml_minor_collection (); CAML_INSTR_TIME (tmr, "explicit/gc_minor"); return Val_unit; }
void caml_garbage_collection(void) { caml_young_limit = caml_young_start; if (caml_young_ptr < caml_young_start || caml_force_major_slice) { caml_minor_collection(); } caml_process_pending_signals(); }
void caml_set_minor_heap_size (asize_t wsize) { caml_domain_state* domain_state = Caml_state; struct caml_minor_tables *r = domain_state->minor_tables; if (domain_state->young_ptr != domain_state->young_end) caml_minor_collection (); caml_reallocate_minor_heap(wsize); reset_table ((struct generic_table *)&r->major_ref); reset_table ((struct generic_table *)&r->minor_ref); reset_table ((struct generic_table *)&r->ephe_ref); reset_table((struct generic_table *)&r->custom); }
void caml_process_event(void) { void (*async_action)(void); if (caml_force_major_slice) caml_minor_collection (); /* FIXME should be [caml_check_urgent_gc] */ caml_process_pending_signals(); async_action = caml_async_action_hook; if (async_action != NULL) { caml_async_action_hook = NULL; (*async_action)(); } }
CAMLprim value caml_make_vect(value len, value init) { CAMLparam2 (len, init); CAMLlocal1 (res); mlsize_t size, wsize, i; double d; size = Long_val(len); if (size == 0) { res = Atom(0); } else if (Is_block(init) && Is_in_value_area(init) && Tag_val(init) == Double_tag) { d = Double_val(init); wsize = size * Double_wosize; if (wsize > Max_wosize) caml_invalid_argument("Array.make"); res = caml_alloc(wsize, Double_array_tag); for (i = 0; i < size; i++) { Store_double_field(res, i, d); } } else { if (size > Max_wosize) caml_invalid_argument("Array.make"); if (size < Max_young_wosize) { res = caml_alloc_small(size, 0); for (i = 0; i < size; i++) Field(res, i) = init; } else if (Is_block(init) && Is_young(init)) { caml_minor_collection(); res = caml_alloc_shr(size, 0); for (i = 0; i < size; i++) Field(res, i) = init; res = caml_check_urgent_gc (res); } else { res = caml_alloc_shr(size, 0); for (i = 0; i < size; i++) caml_initialize(&Field(res, i), init); res = caml_check_urgent_gc (res); } } CAMLreturn (res); }
CAMLexport value caml_check_urgent_gc (value extra_root) { CAMLparam1 (extra_root); if (caml_force_major_slice) caml_minor_collection(); CAMLreturn (extra_root); }
CAMLprim value caml_gc_minor(value v) { Assert (v == Val_unit); caml_minor_collection (); return Val_unit; }