Better compaction heuristic (#10194)

* add instrumentation for compaction heuristic

* cosmetic changes

* compaction-triggering heuristic: use measured overhead from previous GC cycle

* optimization: use the `work` parameter to count marked words

* fix counting bug found by @stedolan

Changes

@@ -88,6 +88,11 @@ Working version
   experimental.
   (Nicolás Ojeda Bär, review by David Allsopp)
 
+- #10194: Change compaction-triggering heuristic: use the overhead measured
+  by the previous GC cycle instead of an indirect (and noisy) computation
+  of the current overhead.
+  (Damien Doligez, review by Stephen Dolan)
+
 ### Code generation and optimizations:
 
 - #1400: Add an optional invariants check on Cmm, which can be activated

runtime/caml/compact.h

@@ -28,7 +28,7 @@
 */
 void caml_compact_heap (intnat new_allocation_policy);
 
-void caml_compact_heap_maybe (void);
+void caml_compact_heap_maybe (double previous_overhead);
 void caml_invert_root (value v, value *p);
 
 #endif /* CAML_INTERNALS */

runtime/compact.c

@@ -460,17 +460,8 @@ void caml_compact_heap (intnat new_allocation_policy)
   }
 }
 
-void caml_compact_heap_maybe (void)
+void caml_compact_heap_maybe (double previous_overhead)
 {
-  /* Estimated free+garbage words in the heap:
-         FW = fl_size_at_phase_change + 3 * (caml_fl_cur_wsz
-                                             - caml_fl_wsz_at_phase_change)
-         FW = 3 * caml_fl_cur_wsz - 2 * caml_fl_wsz_at_phase_change
-     Estimated live words:      LW = Caml_state->stat_heap_wsz - FW
-     Estimated free percentage: FP = 100 * FW / LW
-     We compact the heap if FP > caml_percent_max
-  */
-  double fw, fp;
   CAMLassert (caml_gc_phase == Phase_idle);
   if (caml_percent_max >= 1000000) return;
   if (Caml_state->stat_major_collections < 3) return;
@@ -482,41 +473,26 @@ void caml_compact_heap_maybe (void)
     return;
 #endif
 
-  fw = 3.0 * caml_fl_cur_wsz - 2.0 * caml_fl_wsz_at_phase_change;
-  if (fw < 0) fw = caml_fl_cur_wsz;
+  if (previous_overhead >= caml_percent_max){
+    double current_overhead;
 
-  if (fw >= Caml_state->stat_heap_wsz){
-    fp = 1000000.0;
-  }else{
-    fp = 100.0 * fw / (Caml_state->stat_heap_wsz - fw);
-    if (fp > 1000000.0) fp = 1000000.0;
-  }
-  caml_gc_message (0x200, "FL size at phase change = %"
-                          ARCH_INTNAT_PRINTF_FORMAT "u words\n",
-                   (uintnat) caml_fl_wsz_at_phase_change);
-  caml_gc_message (0x200, "FL current size = %"
-                          ARCH_INTNAT_PRINTF_FORMAT "u words\n",
-                   (uintnat) caml_fl_cur_wsz);
-  caml_gc_message (0x200, "Estimated overhead = %"
-                          ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
-                   (uintnat) fp);
-  if (fp >= caml_percent_max){
     caml_gc_message (0x200, "Automatic compaction triggered.\n");
     caml_empty_minor_heap ();  /* minor heap must be empty for compaction */
     caml_gc_message
       (0x1, "Finishing major GC cycle (triggered by compaction)\n");
     caml_finish_major_cycle ();
     ++ Caml_state->stat_forced_major_collections;
 
-    fw = caml_fl_cur_wsz;
-    fp = 100.0 * fw / (Caml_state->stat_heap_wsz - fw);
-    caml_gc_message (0x200, "Measured overhead: %"
+    /* Note: There is no floating garbage because we just did a complete
+       major cycle*/
+    current_overhead =
+      100.0 * caml_fl_cur_wsz / (Caml_state->stat_heap_wsz - caml_fl_cur_wsz);
+    caml_gc_message (0x200, "Current overhead: %"
                             ARCH_INTNAT_PRINTF_FORMAT "u%%\n",
-                     (uintnat) fp);
-    if (fp >= caml_percent_max)
-         caml_compact_heap (-1);
+                     (uintnat) current_overhead);
+    if (current_overhead >= caml_percent_max)
+      caml_compact_heap (-1);
     else
-         caml_gc_message (0x200, "Automatic compaction aborted.\n");
-
+      caml_gc_message (0x200, "Automatic compaction aborted.\n");
   }
 }

runtime/major_gc.c

@@ -56,6 +56,7 @@ struct mark_stack {
 };
 
 uintnat caml_percent_free;
+static uintnat marked_words, heap_wsz_at_cycle_start;
 uintnat caml_major_heap_increment;
 CAMLexport char *caml_heap_start;
 char *caml_gc_sweep_hp;
@@ -304,6 +305,7 @@ void caml_darken (value v, value *p)
     if (Is_white_hd (h)){
       ephe_list_pure = 0;
       Hd_val (v) = Blackhd_hd (h);
+      marked_words += Whsize_hd (h);
       if (t < No_scan_tag){
         mark_stack_push(Caml_state->mark_stack, v, 0, NULL);
       }
@@ -380,8 +382,10 @@ static void start_cycle (void)
   CAMLassert (Caml_state->mark_stack->count == 0);
   CAMLassert (redarken_first_chunk == NULL);
   caml_gc_message (0x01, "Starting new major GC cycle\n");
+  marked_words = 0;
   caml_darken_all_roots_start ();
   caml_gc_phase = Phase_mark;
+  heap_wsz_at_cycle_start = Caml_state->stat_heap_wsz;
   caml_gc_subphase = Subphase_mark_roots;
   ephe_list_pure = 1;
   ephes_checked_if_pure = &caml_ephe_list_head;
@@ -571,6 +575,7 @@ static void mark_slice (intnat work)
   caml_gc_message (0x40, "Marking %"ARCH_INTNAT_PRINTF_FORMAT"d words\n", work);
   caml_gc_message (0x40, "Subphase = %d\n", caml_gc_subphase);
 
+  marked_words += work;
   while (1){
     int can_mark = 0;
 
@@ -620,7 +625,9 @@ static void mark_slice (intnat work)
       }
     } else if (caml_gc_subphase == Subphase_mark_roots) {
       CAML_EV_BEGIN(EV_MAJOR_MARK_ROOTS);
+      marked_words -= work;
       work = caml_darken_all_roots_slice (work);
+      marked_words += work;
       CAML_EV_END(EV_MAJOR_MARK_ROOTS);
       if (work > 0){
         caml_gc_subphase = Subphase_mark_main;
@@ -659,6 +666,7 @@ static void mark_slice (intnat work)
           /* Initialise the sweep phase. */
           init_sweep_phase();
         }
+        marked_words -= work;
         work = 0;
         CAML_EV_END(EV_MAJOR_MARK_FINAL);
       }
@@ -667,6 +675,7 @@ static void mark_slice (intnat work)
       }
     }
   }
+  marked_words -= work;  /* work may be negative */
   CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_FIELDS, slice_fields);
   CAML_EV_COUNTER(EV_C_MAJOR_MARK_SLICE_POINTERS, slice_pointers);
 }
@@ -945,8 +954,25 @@ void caml_major_collection_slice (intnat howmuch)
   }
 
   if (caml_gc_phase == Phase_idle){
+    double previous_overhead; // overhead at the end of the previous cycle
+
     CAML_EV_BEGIN(EV_MAJOR_CHECK_AND_COMPACT);
-    caml_compact_heap_maybe ();
+    caml_gc_message (0x200, "marked words = %"
+                     ARCH_INTNAT_PRINTF_FORMAT "u words\n",
+                     marked_words);
+    caml_gc_message (0x200, "heap size at start of cycle = %"
+                     ARCH_INTNAT_PRINTF_FORMAT "u words\n",
+                     heap_wsz_at_cycle_start);
+    if (marked_words == 0){
+      previous_overhead = 1000000.;
+      caml_gc_message (0x200, "overhead at start of cycle = +inf\n");
+    }else{
+      previous_overhead =
+        100.0 * (heap_wsz_at_cycle_start - marked_words) / marked_words;
+      caml_gc_message (0x200, "overhead at start of cycle = %.0f%%\n",
+                       previous_overhead);
+    }
+    caml_compact_heap_maybe (previous_overhead);
     CAML_EV_END(EV_MAJOR_CHECK_AND_COMPACT);
   }