@@ -755,6 +755,27 @@ static void update_major_slice_work(intnat howmuch,
755
755
atomic_fetch_add (& work_counter , dom_st -> major_work_done_between_slices );
756
756
dom_st -> major_work_done_between_slices = 0 ;
757
757
atomic_fetch_add (& alloc_counter , new_work );
758
+
759
+ /* If the work_counter is falling far behind the alloc_counter,
760
+ * artificially catch up some of the difference. This is a band-aid
761
+ * for general GC pacing problems revealed by the mark-delay changes
762
+ * (see comments on ocaml/ocaml PR #13580): when we rework the
763
+ * pacing this should go away. */
764
+ int64_t pending = diffmod (atomic_load (& alloc_counter ),
765
+ atomic_load (& work_counter ));
766
+ if (pending > (int64_t )total_cycle_work * 2 ) {
767
+ intnat catchup = pending - total_cycle_work ;
768
+ caml_gc_message (0x40 ,
769
+ "work counter %" ARCH_INTNAT_PRINTF_FORMAT "u falling behind "
770
+ "alloc counter %" ARCH_INTNAT_PRINTF_FORMAT "u by more than "
771
+ "twice a total cycle's work %" ARCH_INTNAT_PRINTF_FORMAT "d; "
772
+ "catching up by %" ARCH_INTNAT_PRINTF_FORMAT "d\n" ,
773
+ atomic_load (& work_counter ),
774
+ atomic_load (& alloc_counter ),
775
+ total_cycle_work , catchup );
776
+ atomic_fetch_add (& work_counter , catchup );
777
+ }
778
+
758
779
if (howmuch == AUTO_TRIGGERED_MAJOR_SLICE ||
759
780
howmuch == GC_CALCULATE_MAJOR_SLICE ) {
760
781
dom_st -> slice_target = atomic_load (& alloc_counter );
0 commit comments