Introduce automatic compaction to runtime 5.

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

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)
 */

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.

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,

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;

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,

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*)&params, 0);