diff --git a/manual/src/cmds/runtime.etex b/manual/src/cmds/runtime.etex index 6e9629ebfb..7e6e5c307d 100644 --- a/manual/src/cmds/runtime.etex +++ b/manual/src/cmds/runtime.etex @@ -164,6 +164,8 @@ The following environment variables are also consulted: $2^{20}$, and $2^{30}$ respectively. \item[o] ("space_overhead") The major GC speed setting. See the Gc module documentation for details. + \item[O] ("max_overhead") The compaction control setting. + See the Gc module documentation for details. \item[p] (parser trace) Turn on debugging support for "ocamlyacc"-generated parsers. When this option is on, the pushdown automaton that executes the parsers prints a diff --git a/runtime/caml/config.h b/runtime/caml/config.h index db654f0230..891efc587d 100644 --- a/runtime/caml/config.h +++ b/runtime/caml/config.h @@ -242,6 +242,11 @@ typedef uint64_t uintnat; total size of live objects. */ #define Percent_free_def 160 +/* Default setting for the compacter: 500% + (i.e. trigger the compacter when 5/6 of the heap is free or garbage). + */ +#define Max_percent_free_def 500 + /* Default setting for the major GC slice smoothing window: 1 (i.e. no smoothing) */ diff --git a/runtime/caml/major_gc.h b/runtime/caml/major_gc.h index 154640aad9..281784c8fd 100644 --- a/runtime/caml/major_gc.h +++ b/runtime/caml/major_gc.h @@ -47,7 +47,15 @@ void caml_darken(void*, value, volatile value* ignored); void caml_darken_cont(value); void caml_mark_root(value, value*); void caml_mark_roots_stw(int, caml_domain_state**); -void caml_finish_major_cycle(int force_compaction); + +/* Compaction modes */ +enum { + Compaction_none, + Compaction_forced, + Compaction_auto, +}; + +void caml_finish_major_cycle(int compaction_mode); /* Reset any internal accounting the GC uses to set collection pacing. * For use at times when we have disturbed the usual pacing, for * example, after any synchronous major collection. diff --git a/runtime/caml/shared_heap.h b/runtime/caml/shared_heap.h index 3504d05ba4..f7268b0552 100644 --- a/runtime/caml/shared_heap.h +++ b/runtime/caml/shared_heap.h @@ -36,6 +36,9 @@ void caml_teardown_shared_heap(struct caml_heap_state* heap); value* caml_shared_try_alloc(struct caml_heap_state*, mlsize_t, tag_t, reserved_t); +/* If we were to grow the shared heap, how much would we grow it? */ +uintnat caml_shared_heap_grow_bsize(void); + /* Copy the domain-local heap stats into a heap stats sample. */ void caml_collect_heap_stats_sample( struct caml_heap_state* local, diff --git a/runtime/caml/startup_aux.h b/runtime/caml/startup_aux.h index 03deb547eb..4c41cd325b 100644 --- a/runtime/caml/startup_aux.h +++ b/runtime/caml/startup_aux.h @@ -41,6 +41,7 @@ struct caml_params { uintnat print_config; uintnat init_percent_free; + uintnat init_max_percent_free; uintnat init_minor_heap_wsz; uintnat init_custom_major_ratio; uintnat init_custom_minor_ratio; diff --git a/runtime/gc_ctrl.c b/runtime/gc_ctrl.c index e22e963012..5b76f77ba5 100644 --- a/runtime/gc_ctrl.c +++ b/runtime/gc_ctrl.c @@ -45,7 +45,7 @@ uintnat caml_fiber_wsz; extern uintnat caml_major_heap_increment; /* percent or words; see major_gc.c */ extern uintnat caml_percent_free; /* see major_gc.c */ -extern uintnat caml_percent_max; /* see compact.c */ +extern uintnat caml_max_percent_free; /* see major_gc.c */ extern uintnat caml_allocation_policy; /* see freelist.c */ extern uintnat caml_custom_major_ratio; /* see custom.c */ extern uintnat caml_custom_minor_ratio; /* see custom.c */ @@ -138,7 +138,7 @@ CAMLprim value caml_gc_get(value v) Store_field (res, 1, Val_long (0)); Store_field (res, 2, Val_long (caml_percent_free)); /* o */ Store_field (res, 3, Val_long (atomic_load_relaxed(&caml_verb_gc))); /* v */ - Store_field (res, 4, Val_long (0)); + Store_field (res, 4, Val_long (caml_max_percent_free)); Store_field (res, 5, Val_long (caml_max_stack_wsize)); /* l */ Store_field (res, 6, Val_long (0)); Store_field (res, 7, Val_long (0)); @@ -155,6 +155,11 @@ static uintnat norm_pfree (uintnat p) return Max (p, 1); } +static uintnat norm_pmax (uintnat p) +{ + return p; +} + static uintnat norm_custom_maj (uintnat p) { return Max (p, 1); @@ -170,6 +175,7 @@ CAMLprim value caml_gc_set(value v) uintnat newminwsz = caml_norm_minor_heap_size (Long_val (Field (v, 0))); uintnat newpf = norm_pfree (Long_val (Field (v, 2))); uintnat new_verb_gc = Long_val (Field (v, 3)); + uintnat newpm = norm_pmax (Long_val (Field (v, 4))); uintnat new_max_stack_size = Long_val (Field (v, 5)); uintnat new_custom_maj = norm_custom_maj (Long_val (Field (v, 8))); uintnat new_custom_min = norm_custom_min (Long_val (Field (v, 9))); @@ -185,6 +191,12 @@ CAMLprim value caml_gc_set(value v) ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_free); } + if (newpm != caml_max_percent_free) { + caml_max_percent_free = newpm; + caml_gc_message (0x20, "New max space overhead: %" + ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_max_percent_free); + } + atomic_store_relaxed(&caml_verb_gc, new_verb_gc); /* These fields were added in 4.08.0. */ @@ -249,12 +261,12 @@ CAMLprim value caml_gc_minor(value v) return caml_raise_async_if_exception(exn, ""); } -static value gc_major_exn(int force_compaction) +static value gc_major_exn(int compaction) { CAML_EV_BEGIN(EV_EXPLICIT_GC_MAJOR); caml_gc_log ("Major GC cycle requested"); caml_empty_minor_heaps_once(); - caml_finish_major_cycle(force_compaction); + caml_finish_major_cycle(compaction); caml_reset_major_pacing(); value exn = caml_process_pending_actions_exn(); CAML_EV_END(EV_EXPLICIT_GC_MAJOR); @@ -265,7 +277,9 @@ CAMLprim value caml_gc_major(value v) { Caml_check_caml_state(); CAMLassert (v == Val_unit); - return caml_raise_async_if_exception(gc_major_exn (0), ""); + return caml_raise_async_if_exception( + gc_major_exn (Compaction_auto), + ""); } static value gc_full_major_exn(void) @@ -277,7 +291,7 @@ static value gc_full_major_exn(void) /* In general, it can require up to 3 GC cycles for a currently-unreachable object to be collected. */ for (i = 0; i < 3; i++) { - caml_finish_major_cycle(0); + caml_finish_major_cycle(i == 2 ? Compaction_auto : Compaction_none); caml_reset_major_pacing(); exn = caml_process_pending_actions_exn(); if (Is_exception_result(exn)) break; @@ -314,7 +328,7 @@ CAMLprim value caml_gc_compaction(value v) /* We do a full major before this compaction. See [caml_full_major_exn] for why this needs three iterations. */ for (i = 0; i < 3; i++) { - caml_finish_major_cycle(i == 2); + caml_finish_major_cycle(i == 2 ? Compaction_forced : Compaction_none); caml_reset_major_pacing(); exn = caml_process_pending_actions_exn(); if (Is_exception_result(exn)) break; @@ -350,6 +364,7 @@ void caml_init_gc (void) caml_max_stack_wsize = caml_params->init_max_stack_wsz; caml_fiber_wsz = (Stack_threshold * 2) / sizeof(value); caml_percent_free = norm_pfree (caml_params->init_percent_free); + caml_max_percent_free = norm_pmax (caml_params->init_max_percent_free); caml_gc_log ("Initial stack limit: %" ARCH_INTNAT_PRINTF_FORMAT "uk bytes", caml_params->init_max_stack_wsz / 1024 * sizeof (value)); @@ -371,7 +386,7 @@ void caml_init_gc (void) /* caml_major_heap_increment = major_incr; caml_percent_free = norm_pfree (percent_fr); - caml_percent_max = norm_pmax (percent_m); + caml_max_percent_free = norm_pmax (percent_m); caml_init_major_heap (major_heap_size); caml_gc_message (0x20, "Initial minor heap size: %luk bytes\n", Caml_state->minor_heap_size / 1024); @@ -380,7 +395,7 @@ void caml_init_gc (void) caml_gc_message (0x20, "Initial space overhead: %" ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_free); caml_gc_message (0x20, "Initial max overhead: %" - ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_percent_max); + ARCH_INTNAT_PRINTF_FORMAT "u%%\n", caml_max_percent_free); if (caml_major_heap_increment > 1000){ caml_gc_message (0x20, "Initial heap increment: %" ARCH_INTNAT_PRINTF_FORMAT "uk words\n", @@ -559,7 +574,8 @@ CAMLprim value caml_runtime_parameters (value unit) value res = caml_alloc_sprintf ("b=%d,c=%"F_Z"u,e=%"F_Z"u,i=%"F_Z"u,j=%"F_Z"u," "l=%"F_Z"u,M=%"F_Z"u,m=%"F_Z"u,n=%"F_Z"u," - "o=%"F_Z"u,p=%"F_Z"u,s=%"F_Z"u,t=%"F_Z"u,v=%"F_Z"u,V=%"F_Z"u,W=%"F_Z"u%s", + "o=%"F_Z"u,O=%"F_Z"u,p=%"F_Z"u,s=%"F_Z"u," + "t=%"F_Z"u,v=%"F_Z"u,V=%"F_Z"u,W=%"F_Z"u%s", /* b */ (int) Caml_state->backtrace_active, /* c */ caml_params->cleanup_on_exit, /* e */ caml_params->runtime_events_log_wsize, @@ -570,6 +586,7 @@ CAMLprim value caml_runtime_parameters (value unit) /* m */ caml_custom_minor_ratio, /* n */ caml_custom_minor_max_bsz, /* o */ caml_percent_free, + /* O */ caml_max_percent_free, /* p */ caml_params->parser_trace, /* R */ /* missing */ /* s */ caml_minor_heap_max_wsz, diff --git a/runtime/major_gc.c b/runtime/major_gc.c index 2e3fe43bdc..145dad11b7 100644 --- a/runtime/major_gc.c +++ b/runtime/major_gc.c @@ -73,6 +73,7 @@ struct mark_stack { }; uintnat caml_percent_free = Percent_free_def; +uintnat caml_max_percent_free = Max_percent_free_def; /* This variable is only written with the world stopped, so it need not be atomic */ @@ -460,7 +461,7 @@ void caml_orphan_finalisers (caml_domain_state* domain_state) /* Force a major GC cycle to simplify constraints for orphaning finalisers. See note attached to the declaration of [num_domains_orphaning_finalisers] variable in major_gc.c */ - caml_finish_major_cycle(0); + caml_finish_major_cycle(Compaction_none); } CAMLassert(caml_gc_phase == Phase_sweep_and_mark_main); CAMLassert (!f->updated_first); @@ -1484,6 +1485,56 @@ void caml_mark_roots_stw (int participant_count, caml_domain_state** barrier_par } } +/* Decide, at the end of a major cycle, whether to compact. */ + +static bool should_compact_from_stw_single(int compaction_mode) +{ + if (compaction_mode == Compaction_none) { + return false; + } else if (compaction_mode == Compaction_forced) { + caml_gc_message (0x200, "Forced compaction.\n"); + return true; + } + CAMLassert (compaction_mode == Compaction_auto); + + /* runtime 4 algorithm, as close as possible. + * TODO: revisit this in future. */ + if (caml_max_percent_free >= 1000 * 1000) { + caml_gc_message (0x200, + "Max percent free %"ARCH_INTNAT_PRINTF_FORMAT"u%%:" + "compaction off.\n", caml_max_percent_free); + return false; + } + if (caml_major_cycles_completed < 3) { + caml_gc_message (0x200, + "Only %"ARCH_INTNAT_PRINTF_FORMAT"u major cycles: " + "compaction off.\n", caml_major_cycles_completed); + return false; + } + + struct gc_stats s; + caml_compute_gc_stats(&s); + + uintnat heap_words = s.heap_stats.pool_words + s.heap_stats.large_words; + + if (Bsize_wsize(heap_words) <= 2 * caml_shared_heap_grow_bsize()) + return false; + + uintnat live_words = s.heap_stats.pool_live_words + s.heap_stats.large_words; + uintnat free_words = heap_words - live_words; + double current_overhead = 100.0 * free_words / live_words; + + bool compacting = current_overhead >= caml_max_percent_free; + caml_gc_message (0x200, "Current overhead: %" + ARCH_INTNAT_PRINTF_FORMAT "u%% %s %" + ARCH_INTNAT_PRINTF_FORMAT "u%%: %scompacting.\n", + (uintnat) current_overhead, + compacting ? ">=" : "<", + caml_max_percent_free, + compacting ? "" : "not "); + return compacting; +} + static void cycle_major_heap_from_stw_single( caml_domain_state* domain, uintnat num_domains_in_stw) @@ -1574,7 +1625,7 @@ static void cycle_major_heap_from_stw_single( } struct cycle_callback_params { - int force_compaction; + int compaction_mode; }; static void stw_cycle_all_domains( @@ -1609,8 +1660,11 @@ static void stw_cycle_all_domains( (domain, (void*)0, participating_count, participating); CAML_EV_BEGIN(EV_MAJOR_GC_STW); + static bool compacting = false; Caml_global_barrier_if_final(participating_count) { cycle_major_heap_from_stw_single(domain, (uintnat) participating_count); + /* Do compaction decision for all domains here */ + compacting = should_compact_from_stw_single(params.compaction_mode); } /* If the heap is to be verified, do it before the domains continue @@ -1626,14 +1680,12 @@ static void stw_cycle_all_domains( caml_cycle_heap(domain->shared_heap); - /* Compact here if requested (or, in some future version, if the heap overhead - is too high). */ - if (params.force_compaction) { + if (compacting) { caml_compact_heap(domain, participating_count, participating); } - /* Update GC stats (as these could have significantly changed if there was a - compaction) */ + /* Update GC stats (these could have significantly changed e.g. due + * to compaction). */ caml_collect_gc_stats_sample_stw(domain); /* Collect domain-local stats to emit to runtime events */ @@ -1771,7 +1823,7 @@ static void major_collection_slice(intnat howmuch, int participant_count, caml_domain_state** barrier_participants, collection_slice_mode mode, - int force_compaction) + int compaction_mode) { caml_domain_state* domain_state = Caml_state; intnat sweep_work = 0, mark_work = 0; @@ -1995,7 +2047,7 @@ static void major_collection_slice(intnat howmuch, saved_major_cycle = caml_major_cycles_completed; struct cycle_callback_params params; - params.force_compaction = force_compaction; + params.compaction_mode = compaction_mode; while (saved_major_cycle == caml_major_cycles_completed) { if (barrier_participants) { @@ -2012,7 +2064,7 @@ static void major_collection_slice(intnat howmuch, void caml_opportunistic_major_collection_slice(intnat howmuch) { - major_collection_slice(howmuch, 0, 0, Slice_opportunistic, 0); + major_collection_slice(howmuch, 0, 0, Slice_opportunistic, Compaction_none); } void caml_major_collection_slice(intnat howmuch) @@ -2026,7 +2078,7 @@ void caml_major_collection_slice(intnat howmuch) 0, 0, Slice_interruptible, - 0 + Compaction_auto ); if (caml_incoming_interrupts_queued()) { caml_gc_log("Major slice interrupted, rescheduling major slice"); @@ -2035,7 +2087,7 @@ void caml_major_collection_slice(intnat howmuch) } else { /* TODO: could make forced API slices interruptible, but would need to do accounting or pass up interrupt */ - major_collection_slice(howmuch, 0, 0, Slice_uninterruptible, 0); + major_collection_slice(howmuch, 0, 0, Slice_uninterruptible, Compaction_auto); } /* Record that this domain has completed a major slice for this minor cycle. */ @@ -2044,7 +2096,7 @@ void caml_major_collection_slice(intnat howmuch) struct finish_major_cycle_params { uintnat saved_major_cycles; - int force_compaction; + int compaction_mode; }; static void stw_finish_major_cycle (caml_domain_state* domain, void* arg, @@ -2073,18 +2125,18 @@ static void stw_finish_major_cycle (caml_domain_state* domain, void* arg, CAML_EV_BEGIN(EV_MAJOR_FINISH_CYCLE); while (params.saved_major_cycles == caml_major_cycles_completed) { major_collection_slice(10000000, participating_count, participating, - Slice_uninterruptible, params.force_compaction); + Slice_uninterruptible, params.compaction_mode); } CAML_EV_END(EV_MAJOR_FINISH_CYCLE); } -void caml_finish_major_cycle (int force_compaction) +void caml_finish_major_cycle (int compaction_mode) { uintnat saved_major_cycles = caml_major_cycles_completed; while( saved_major_cycles == caml_major_cycles_completed ) { struct finish_major_cycle_params params; - params.force_compaction = force_compaction; + params.compaction_mode = compaction_mode; params.saved_major_cycles = caml_major_cycles_completed; caml_try_run_on_all_domains(&stw_finish_major_cycle, (void*)¶ms, 0); diff --git a/runtime/shared_heap.c b/runtime/shared_heap.c index 936dd413e2..a10b637d83 100644 --- a/runtime/shared_heap.c +++ b/runtime/shared_heap.c @@ -199,7 +199,27 @@ void caml_teardown_shared_heap(struct caml_heap_state* heap) { released, released_large); } -/* this _must_ be called either with the pool_freelist.lock held or +/* TODO: resurrect major_heap_increment */ + +uintnat new_chunk_bsize(void) +{ + uintnat new_pools = pool_freelist.active_pools * 15 / 100; + uintnat min_new_pools = + Wsize_bsize(caml_pool_min_chunk_bsz) / POOL_WSIZE; + if (new_pools < min_new_pools) new_pools = min_new_pools; + + return caml_mem_round_up_mapping_size(Bsize_wsize(POOL_WSIZE) * new_pools); +} + +uintnat caml_shared_heap_grow_bsize(void) +{ + caml_plat_lock_blocking(&pool_freelist.lock); + uintnat res = new_chunk_bsize(); + caml_plat_unlock(&pool_freelist.lock); + return res; +} + +/* This _must_ be called either with the pool_freelist.lock held or during a stw in only a single domain */ static pool* alloc_pool(struct caml_heap_state* local) { pool* r = NULL; diff --git a/runtime/startup_aux.c b/runtime/startup_aux.c index e0dcee844f..fe1d2361c9 100644 --- a/runtime/startup_aux.c +++ b/runtime/startup_aux.c @@ -69,6 +69,7 @@ static void init_startup_params(void) } params.init_percent_free = Percent_free_def; + params.init_max_percent_free = Max_percent_free_def; params.init_minor_heap_wsz = Minor_heap_def; params.init_custom_major_ratio = Custom_major_ratio_def; params.init_custom_minor_ratio = Custom_minor_ratio_def; @@ -128,6 +129,7 @@ static void parse_ocamlrunparam(char_os* opt) case 'm': scanmult (opt, ¶ms.init_custom_minor_ratio); break; case 'n': scanmult (opt, ¶ms.init_custom_minor_max_bsz); break; case 'o': scanmult (opt, ¶ms.init_percent_free); break; + case 'O': scanmult (opt, ¶ms.init_max_percent_free); break; case 'p': scanmult (opt, ¶ms.parser_trace); break; case 'R': break; /* see stdlib/hashtbl.mli */ case 's': scanmult (opt, ¶ms.init_minor_heap_wsz); break; diff --git a/stdlib/gc.mli b/stdlib/gc.mli index 8b1e1ebedc..de488b2db1 100644 --- a/stdlib/gc.mli +++ b/stdlib/gc.mli @@ -168,9 +168,7 @@ type control = If [max_overhead >= 1000000], compaction is never triggered. On runtime4, if compaction is permanently disabled, it is strongly suggested to set [allocation_policy] to 2. - Default: 500. - This metric is currently not available in OCaml 5: the field value is - always [0]. *) + Default: 500. *) stack_limit : int; (** The maximum size of the fiber stacks (in words).