Fixes to obscure mark-delay problems

runtime/major_gc.c

@@ -755,6 +755,27 @@ static void update_major_slice_work(intnat howmuch,
   atomic_fetch_add (&work_counter, dom_st->major_work_done_between_slices);
   dom_st->major_work_done_between_slices = 0;
   atomic_fetch_add (&alloc_counter, new_work);
+
+  /* If the work_counter is falling far behind the alloc_counter,
+   * artificially catch up some of the difference. This is a band-aid
+   * for general GC pacing problems revealed by the mark-delay changes
+   * (see comments on ocaml/ocaml PR #13580): when we rework the
+   * pacing this should go away. */
+  int64_t pending = diffmod(atomic_load(&alloc_counter),
+                             atomic_load(&work_counter));
+  if (pending > (int64_t)total_cycle_work * 2) {
+    intnat catchup = pending - total_cycle_work;
+    caml_gc_message(0x40,
+                    "work counter %"ARCH_INTNAT_PRINTF_FORMAT"u falling behind "
+                    "alloc counter %"ARCH_INTNAT_PRINTF_FORMAT"u by more than "
+                    "twice a total cycle's work %"ARCH_INTNAT_PRINTF_FORMAT"d; "
+                    "catching up by %"ARCH_INTNAT_PRINTF_FORMAT "d\n",
+                    atomic_load(&work_counter),
+                    atomic_load(&alloc_counter),
+                    total_cycle_work, catchup);
+    atomic_fetch_add (&work_counter, catchup);
+  }
+
   if (howmuch == AUTO_TRIGGERED_MAJOR_SLICE ||
       howmuch == GC_CALCULATE_MAJOR_SLICE) {
     dom_st->slice_target = atomic_load (&alloc_counter);
@@ -1410,13 +1431,14 @@ void caml_mark_roots_stw (int participant_count, caml_domain_state** barrier_par
   Caml_global_barrier_if_final(participant_count) {
     caml_gc_phase = Phase_sweep_and_mark_main;
     atomic_store_relaxed(&global_roots_scanned, WORK_UNSTARTED);
+    /* Adopt orphaned work from domains that were spawned and
+       terminated in the previous cycle. Do this in the barrier,
+       before any domain can terminate on this cycle. */
+    adopt_orphaned_work (caml_global_heap_state.UNMARKED);
   }
 
   caml_domain_state* domain = Caml_state;
 
-  /* Adopt orphaned work from domains that were spawned and terminated in the
-     previous cycle. */
-  adopt_orphaned_work (caml_global_heap_state.UNMARKED);
 
   begin_ephe_marking();
 
@@ -1799,12 +1821,18 @@ static void major_collection_slice(intnat howmuch,
 
   if (domain_state->sweeping_done) {
     /* We do not immediately trigger a minor GC, but instead wait for
-       the next one to happen normally. This gives some chance that
-       other domains will finish sweeping as well. */
+       the next one to happen normally, when marking will start. This
+       gives some chance that other domains will finish sweeping as
+       well. */
     request_mark_phase();
+    /* If there was no sweeping to do, but marking hasn't started,
+       then minor GC has not occurred naturally between major slices -
+       so we should force one now. */
+    if (sweep_work == 0 && !caml_marking_started()) {
+        caml_request_minor_gc();
+    }
   }
 
-
 mark_again:
   if (caml_marking_started() &&
       !domain_state->marking_done &&