void caml_finish_marking () {
caml_save_stack_gc();
caml_do_local_roots(&caml_darken, caml_domain_self());
caml_scan_global_roots(&caml_darken);
caml_empty_mark_stack();
caml_domain_state->allocated_words = 0;
caml_restore_stack_gc();
}
void caml_verify_heap(struct heap_verify_state* st) {
caml_save_stack_gc();
while (st->sp) verify_object(st, st->stack[--st->sp]);
caml_addrmap_clear(&st->seen);
caml_stat_free(st->stack);
caml_stat_free(st);
caml_restore_stack_gc();
}
void caml_finish_marking_domain (struct domain* domain) {
//caml_gc_log("caml_finish_marking_domain(0): domain=%d", domain->id);
caml_save_stack_gc();
caml_do_local_roots(&caml_darken, domain);
caml_empty_mark_stack_domain(domain);
/* Previous step might have pushed values into our mark stack. Hence,
* empty our mark stack */
caml_empty_mark_stack();
caml_domain_state->allocated_words = 0;
caml_restore_stack_gc();
//caml_gc_log("caml_finish_marking_domain(1): domain=%d", domain->id);
}
static void verify_heap() {
caml_save_stack_gc();
caml_do_local_roots(&verify_push, caml_domain_self());
caml_scan_global_roots(&verify_push);
while (verify_sp) verify_object(verify_stack[--verify_sp]);
caml_gc_log("Verify: %lu objs", verify_objs);
caml_addrmap_clear(&verify_seen);
verify_objs = 0;
caml_stat_free(verify_stack);
verify_stack = 0;
verify_stack_len = 0;
verify_sp = 0;
caml_restore_stack_gc();
}
intnat caml_major_collection_slice(intnat howmuch)
{
intnat computed_work = howmuch ? howmuch : default_slice_budget();
intnat budget = computed_work;
intnat sweep_work, mark_work;
uintnat blocks_marked_before = stat_blocks_marked;
value v;
caml_save_stack_gc();
sweep_work = budget;
budget = caml_sweep(caml_domain_self()->shared_heap, budget);
sweep_work -= budget;
if (gc_phase == Phase_idle) {
caml_do_local_roots(&caml_darken, caml_domain_self());
caml_scan_global_roots(&caml_darken);
gc_phase = Phase_marking;
}
mark_work = budget;
if (mark_stack_pop(&v))
budget = mark(v, budget);
mark_work -= budget;
caml_gc_log("Major slice: %lu alloc, %ld work, %ld sweep, %ld mark (%lu blocks)",
(unsigned long)caml_domain_state->allocated_words,
(long)computed_work, (long)sweep_work, (long)mark_work,
(unsigned long)(stat_blocks_marked - blocks_marked_before));
caml_domain_state->allocated_words = 0;
caml_restore_stack_gc();
if (budget > 0) {
caml_trigger_stw_gc();
caml_handle_gc_interrupt();
}
return computed_work;
}
/* Make sure the minor heap is empty by performing a minor collection if
* needed. */
void caml_empty_minor_heap (void)
{
uintnat minor_allocated_bytes = caml_domain_state->young_end - caml_domain_state->young_ptr;
unsigned rewritten = 0;
struct caml_ref_entry *r;
caml_save_stack_gc();
stat_live_bytes = 0;
if (minor_allocated_bytes != 0){
caml_gc_log ("Minor collection starting");
caml_do_local_roots(&caml_oldify_one, caml_domain_self());
for (r = caml_domain_state->remembered_set->ref.base; r < caml_domain_state->remembered_set->ref.ptr; r++){
value x;
caml_oldify_one (Op_val(r->obj)[r->field], &x);
}
for (r = caml_domain_state->remembered_set->fiber_ref.base; r < caml_domain_state->remembered_set->fiber_ref.ptr; r++) {
caml_scan_dirty_stack(&caml_oldify_one, r->obj);
}
caml_oldify_mopup ();
for (r = caml_domain_state->remembered_set->ref.base; r < caml_domain_state->remembered_set->ref.ptr; r++){
value v = Op_val(r->obj)[r->field];
if (Is_block(v) && Is_young(v)) {
Assert (Hp_val (v) >= caml_domain_state->young_ptr);
value vnew;
header_t hd = Hd_val(v);
// FIXME: call oldify_one here?
if (Is_promoted_hd(hd)) {
vnew = caml_addrmap_lookup(&caml_domain_state->remembered_set->promotion, v);
} else {
int offset = 0;
if (Tag_hd(hd) == Infix_tag) {
offset = Infix_offset_hd(hd);
v -= offset;
}
Assert (Hd_val (v) == 0);
vnew = Op_val(v)[0] + offset;
}
Assert(Is_block(vnew) && !Is_young(vnew));
Assert(Hd_val(vnew));
if (Tag_hd(hd) == Infix_tag) { Assert(Tag_val(vnew) == Infix_tag); }
rewritten += caml_atomic_cas_field(r->obj, r->field, v, vnew);
}
}
caml_addrmap_iter(&caml_domain_state->remembered_set->promotion, unpin_promoted_object);
if (caml_domain_state->young_ptr < caml_domain_state->young_start)
caml_domain_state->young_ptr = caml_domain_state->young_start;
caml_stat_minor_words += Wsize_bsize (minor_allocated_bytes);
caml_domain_state->young_ptr = caml_domain_state->young_end;
clear_table (&caml_domain_state->remembered_set->ref);
caml_addrmap_clear(&caml_domain_state->remembered_set->promotion);
caml_addrmap_clear(&caml_domain_state->remembered_set->promotion_rev);
caml_gc_log ("Minor collection completed: %u of %u kb live, %u pointers rewritten",
(unsigned)stat_live_bytes/1024, (unsigned)minor_allocated_bytes/1024, rewritten);
}
for (r = caml_domain_state->remembered_set->fiber_ref.base; r < caml_domain_state->remembered_set->fiber_ref.ptr; r++) {
caml_scan_dirty_stack(&caml_darken, r->obj);
caml_clean_stack(r->obj);
}
clear_table (&caml_domain_state->remembered_set->fiber_ref);
caml_restore_stack_gc();
#ifdef DEBUG
{
value *p;
for (p = (value *) caml_domain_state->young_start;
p < (value *) caml_domain_state->young_end; ++p){
*p = Debug_free_minor;
}
++ minor_gc_counter;
}
#endif
}
