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;
}
CAMLprim value caml_gc_major_slice (value v)
{
CAML_INSTR_SETUP (tmr, "");
Assert (Is_long (v));
caml_empty_minor_heap ();
caml_major_collection_slice (Long_val (v));
CAML_INSTR_TIME (tmr, "explicit/gc_major_slice");
return Val_long (0);
}
CAMLprim value caml_gc_minor(value v)
{
CAML_INSTR_SETUP (tmr, "");
Assert (v == Val_unit);
caml_request_minor_gc ();
caml_gc_dispatch ();
CAML_INSTR_TIME (tmr, "explicit/gc_minor");
return Val_unit;
}
CAMLprim value caml_gc_stat(value v)
{
value result;
CAML_INSTR_SETUP (tmr, "");
Assert (v == Val_unit);
result = heap_stats (1);
CAML_INSTR_TIME (tmr, "explicit/gc_stat");
return result;
}
/* Note, in byte-code there is only one global root, so [do_globals] is
ignored and [caml_darken_all_roots_slice] does nothing. */
void caml_do_roots (scanning_action f, int do_globals)
{
CAML_INSTR_SETUP (tmr, "major_roots");
/* Global variables */
f(caml_global_data, &caml_global_data);
CAML_INSTR_TIME (tmr, "major_roots/global");
/* The stack and the local C roots */
caml_do_local_roots(f, caml_extern_sp, caml_stack_high, caml_local_roots);
CAML_INSTR_TIME (tmr, "major_roots/local");
/* Global C roots */
caml_scan_global_roots(f);
CAML_INSTR_TIME (tmr, "major_roots/C");
/* Finalised values */
caml_final_do_strong_roots (f);
CAML_INSTR_TIME (tmr, "major_roots/finalised");
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f);
CAML_INSTR_TIME (tmr, "major_roots/hook");
}
CAMLprim value caml_gc_major(value v)
{
CAML_INSTR_SETUP (tmr, "");
Assert (v == Val_unit);
caml_gc_message (0x1, "Major GC cycle requested\n", 0);
caml_empty_minor_heap ();
caml_finish_major_cycle ();
test_and_compact ();
caml_final_do_calls ();
CAML_INSTR_TIME (tmr, "explicit/gc_major");
return Val_unit;
}
CAMLprim value caml_gc_compaction(value v)
{
CAML_INSTR_SETUP (tmr, "");
Assert (v == Val_unit);
caml_gc_message (0x10, "Heap compaction requested\n", 0);
caml_empty_minor_heap ();
caml_finish_major_cycle ();
caml_final_do_calls ();
caml_empty_minor_heap ();
caml_finish_major_cycle ();
caml_compact_heap ();
caml_final_do_calls ();
CAML_INSTR_TIME (tmr, "explicit/gc_compact");
return Val_unit;
}
CAMLprim value caml_gc_set(value v)
{
uintnat newpf, newpm;
asize_t newheapincr;
asize_t newminwsz;
uintnat oldpolicy;
CAML_INSTR_SETUP (tmr, "");
caml_verb_gc = Long_val (Field (v, 3));
#ifndef NATIVE_CODE
caml_change_max_stack_size (Long_val (Field (v, 5)));
#endif
newpf = norm_pfree (Long_val (Field (v, 2)));
if (newpf != caml_percent_free){
caml_percent_free = newpf;
caml_gc_message (0x20, "New space overhead: %d%%\n", caml_percent_free);
}
newpm = norm_pmax (Long_val (Field (v, 4)));
if (newpm != caml_percent_max){
caml_percent_max = newpm;
caml_gc_message (0x20, "New max overhead: %d%%\n", caml_percent_max);
}
newheapincr = Long_val (Field (v, 1));
if (newheapincr != caml_major_heap_increment){
caml_major_heap_increment = newheapincr;
if (newheapincr > 1000){
caml_gc_message (0x20, "New heap increment size: %luk words\n",
caml_major_heap_increment/1024);
}else{
caml_gc_message (0x20, "New heap increment size: %lu%%\n",
caml_major_heap_increment);
}
}
oldpolicy = caml_allocation_policy;
caml_set_allocation_policy (Long_val (Field (v, 6)));
if (oldpolicy != caml_allocation_policy){
caml_gc_message (0x20, "New allocation policy: %d\n",
caml_allocation_policy);
}
/* This field was added in 4.03.0. */
if (Wosize_val (v) >= 8){
int old_window = caml_major_window;
caml_set_major_window (norm_window (Long_val (Field (v, 7))));
if (old_window != caml_major_window){
caml_gc_message (0x20, "New smoothing window size: %d\n",
caml_major_window);
}
}
/* Minor heap size comes last because it will trigger a minor collection
(thus invalidating [v]) and it can raise [Out_of_memory]. */
newminwsz = norm_minsize (Long_val (Field (v, 0)));
if (newminwsz != caml_minor_heap_wsz){
caml_gc_message (0x20, "New minor heap size: %luk words\n",
newminwsz / 1024);
caml_set_minor_heap_size (Bsize_wsize (newminwsz));
}
CAML_INSTR_TIME (tmr, "explicit/gc_set");
return Val_unit;
}
