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_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); }
void caml_do_roots (scanning_action f) { /* Global variables */ f(caml_global_data, &caml_global_data); /* The stack and the local C roots */ caml_do_local_roots(f, caml_extern_sp, caml_stack_high, caml_local_roots); /* Global C roots */ caml_scan_global_roots(f); /* Finalised values */ caml_final_do_strong_roots (f); /* Hook */ if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f); }
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(); }
void caml_do_roots (scanning_action f) { struct global_root * gr; /* Global variables */ f(caml_global_data, &caml_global_data); /* The stack and the local C roots */ caml_do_local_roots(f, caml_extern_sp, caml_stack_high, caml_local_roots); /* Global C roots */ for (gr = caml_global_roots.forward[0]; gr != NULL; gr = gr->forward[0]) { f(*(gr->root), gr->root); } /* Finalised values */ caml_final_do_strong_roots (f); /* Hook */ if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f); }
/* 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"); }
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 }
void caml_empty_minor_heap_domain (struct domain* domain) { CAMLnoalloc; caml_domain_state* domain_state = domain->state; struct caml_minor_tables *minor_tables = domain_state->minor_tables; unsigned rewrite_successes = 0; unsigned rewrite_failures = 0; char* young_ptr = domain_state->young_ptr; char* young_end = domain_state->young_end; uintnat minor_allocated_bytes = young_end - young_ptr; struct oldify_state st = {0}; value **r; struct caml_ephe_ref_elt *re; struct caml_custom_elt *elt; st.promote_domain = domain; if (minor_allocated_bytes != 0) { uintnat prev_alloc_words = domain_state->allocated_words; #ifdef DEBUG /* In DEBUG mode, verify that the minor_ref table contains all young-young pointers from older to younger objects */ { struct addrmap young_young_ptrs = ADDRMAP_INIT; mlsize_t i; value iter; for (r = minor_tables->minor_ref.base; r < minor_tables->minor_ref.ptr; r++) { *caml_addrmap_insert_pos(&young_young_ptrs, (value)*r) = 1; } for (iter = (value)young_ptr; iter < (value)young_end; iter = next_minor_block(domain_state, iter)) { value hd = Hd_hp(iter); if (hd != 0) { value curr = Val_hp(iter); tag_t tag = Tag_hd (hd); if (tag < No_scan_tag && tag != Cont_tag) { // FIXME: should scan Cont_tag for (i = 0; i < Wosize_hd(hd); i++) { value* f = Op_val(curr) + i; if (Is_block(*f) && is_in_interval(*f, young_ptr, young_end) && *f < curr) { CAMLassert(caml_addrmap_contains(&young_young_ptrs, (value)f)); } } } } } caml_addrmap_clear(&young_young_ptrs); } #endif caml_gc_log ("Minor collection of domain %d starting", domain->state->id); caml_ev_begin("minor_gc"); caml_ev_begin("minor_gc/roots"); caml_do_local_roots(&oldify_one, &st, domain, 0); caml_scan_stack(&oldify_one, &st, domain_state->current_stack); for (r = minor_tables->major_ref.base; r < minor_tables->major_ref.ptr; r++) { value x = **r; oldify_one (&st, x, &x); } caml_ev_end("minor_gc/roots"); caml_ev_begin("minor_gc/promote"); oldify_mopup (&st); caml_ev_end("minor_gc/promote"); caml_ev_begin("minor_gc/ephemerons"); for (re = minor_tables->ephe_ref.base; re < minor_tables->ephe_ref.ptr; re++) { CAMLassert (Ephe_domain(re->ephe) == domain); if (re->offset == CAML_EPHE_DATA_OFFSET) { /* Data field has already been handled in oldify_mopup. Handle only * keys here. */ continue; } value* key = &Op_val(re->ephe)[re->offset]; if (*key != caml_ephe_none && Is_block(*key) && is_in_interval(*key, young_ptr, young_end)) { resolve_infix_val(key); if (Hd_val(*key) == 0) { /* value copied to major heap */ *key = Op_val(*key)[0]; } else { CAMLassert(!ephe_check_alive_data(re,young_ptr,young_end)); *key = caml_ephe_none; Ephe_data(re->ephe) = caml_ephe_none; } } } caml_ev_end("minor_gc/ephemerons"); caml_ev_begin("minor_gc/update_minor_tables"); for (r = minor_tables->major_ref.base; r < minor_tables->major_ref.ptr; r++) { value v = **r; if (Is_block (v) && is_in_interval ((value)Hp_val(v), young_ptr, young_end)) { value vnew; header_t hd = Hd_val(v); int offset = 0; if (Tag_hd(hd) == Infix_tag) { offset = Infix_offset_hd(hd); v -= offset; } CAMLassert (Hd_val(v) == 0); vnew = Op_val(v)[0] + offset; CAMLassert (Is_block(vnew) && !Is_minor(vnew)); CAMLassert (Hd_val(vnew)); if (Tag_hd(hd) == Infix_tag) { CAMLassert(Tag_val(vnew) == Infix_tag); v += offset; } if (caml_domain_alone()) { **r = vnew; ++rewrite_successes; } else { if (atomic_compare_exchange_strong((atomic_value*)*r, &v, vnew)) ++rewrite_successes; else ++rewrite_failures; } } } CAMLassert (!caml_domain_alone() || rewrite_failures == 0); caml_ev_end("minor_gc/update_minor_tables"); caml_ev_begin("minor_gc/finalisers"); caml_final_update_last_minor(domain); /* Run custom block finalisation of dead minor values */ for (elt = minor_tables->custom.base; elt < minor_tables->custom.ptr; elt++) { value v = elt->block; if (Hd_val(v) == 0) { /* !!caml_adjust_gc_speed(elt->mem, elt->max); */ } else { /* Block will be freed: call finalisation function, if any */ void (*final_fun)(value) = Custom_ops_val(v)->finalize; if (final_fun != NULL) final_fun(v); } } caml_final_empty_young(domain); caml_ev_end("minor_gc/finalisers"); clear_table ((struct generic_table *)&minor_tables->major_ref); clear_table ((struct generic_table *)&minor_tables->minor_ref); clear_table ((struct generic_table *)&minor_tables->ephe_ref); clear_table ((struct generic_table *)&minor_tables->custom); domain_state->young_ptr = domain_state->young_end; domain_state->stat_minor_words += Wsize_bsize (minor_allocated_bytes); domain_state->stat_minor_collections++; domain_state->stat_promoted_words += domain_state->allocated_words - prev_alloc_words; caml_ev_end("minor_gc"); caml_gc_log ("Minor collection of domain %d completed: %2.0f%% of %u KB live, rewrite: successes=%u failures=%u", domain->state->id, 100.0 * (double)st.live_bytes / (double)minor_allocated_bytes, (unsigned)(minor_allocated_bytes + 512)/1024, rewrite_successes, rewrite_failures); } else { caml_final_empty_young(domain); caml_gc_log ("Minor collection of domain %d: skipping", domain->state->id); } #ifdef DEBUG { value *p; for (p = (value *) domain_state->young_start; p < (value *) domain_state->young_end; ++p){ *p = Debug_free_minor; } } #endif }
CAMLexport value caml_promote(struct domain* domain, value root) { value **r; value iter, f; mlsize_t i; caml_domain_state* domain_state = domain->state; struct caml_minor_tables *minor_tables = domain_state->minor_tables; char* young_ptr = domain_state->young_ptr; char* young_end = domain_state->young_end; float percent_to_scan; uintnat prev_alloc_words = domain_state->allocated_words; struct oldify_state st = {0}; struct caml_ephe_ref_elt *re; /* Integers are already shared */ if (Is_long(root)) return root; /* Objects which are in the major heap are already shared. */ if (!Is_minor(root)) return root; st.oldest_promoted = (value)domain_state->young_start; st.promote_domain = domain; CAMLassert(caml_owner_of_young_block(root) == domain); oldify_one (&st, root, &root); oldify_mopup (&st); CAMLassert (!Is_minor(root)); /* FIXME: surely a newly-allocated root is already darkened? */ caml_darken(0, root, 0); percent_to_scan = st.oldest_promoted <= (value)young_ptr ? 0.0 : (((float)(st.oldest_promoted - (value)young_ptr)) * 100.0 / ((value)young_end - (value)domain_state->young_start)); if (percent_to_scan > Percent_to_promote_with_GC) { caml_gc_log("caml_promote: forcing minor GC. %%_minor_to_scan=%f", percent_to_scan); // ??? caml_empty_minor_heap_domain (domain); } else { caml_do_local_roots (&forward_pointer, st.promote_domain, domain, 1); caml_scan_stack (&forward_pointer, st.promote_domain, domain_state->current_stack); /* Scan major to young pointers. */ for (r = minor_tables->major_ref.base; r < minor_tables->major_ref.ptr; r++) { value old_p = **r; if (Is_block(old_p) && is_in_interval(old_p,young_ptr,young_end)) { value new_p = old_p; forward_pointer (st.promote_domain, new_p, &new_p); if (old_p != new_p) { if (caml_domain_alone()) **r = new_p; else atomic_compare_exchange_strong((atomic_value*)*r, &old_p, new_p); } } } /* Scan ephemeron ref table */ for (re = minor_tables->ephe_ref.base; re < minor_tables->ephe_ref.ptr; re++) { value* key = &Op_val(re->ephe)[re->offset]; if (Is_block(*key) && is_in_interval(*key,young_ptr,young_end)) { forward_pointer (st.promote_domain, *key, key); } } /* Scan young to young pointers */ for (r = minor_tables->minor_ref.base; r < minor_tables->minor_ref.ptr; r++) { forward_pointer (st.promote_domain, **r, *r); } /* Scan newer objects */ for (iter = (value)young_ptr; iter <= st.oldest_promoted; iter = next_minor_block(domain_state, iter)) { value hd = Hd_hp(iter); value curr = Val_hp(iter); if (hd != 0) { tag_t tag = Tag_hd (hd); if (tag == Cont_tag) { struct stack_info* stk = Ptr_val(Op_val(curr)[0]); if (stk != NULL) caml_scan_stack(&forward_pointer, st.promote_domain, stk); } else if (tag < No_scan_tag) { for (i = 0; i < Wosize_hd (hd); i++) { f = Op_val(curr)[i]; if (Is_block(f)) { forward_pointer (st.promote_domain, f,((value*)curr) + i); } } } } } } domain_state->stat_promoted_words += domain_state->allocated_words - prev_alloc_words; return root; }