flambda-backend: Ports upstream #12439 (Fix custom block promotion) (#2068)

Author: riaqn

runtime/minor_gc.c

@@ -476,7 +476,6 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
                                    caml_domain_state** participating)
 {
   struct caml_minor_tables *self_minor_tables = domain->minor_tables;
-  struct caml_custom_elt *elt;
   value* young_ptr = domain->young_ptr;
   value* young_end = domain->young_end;
   uintnat minor_allocated_bytes = (uintnat)young_end - (uintnat)young_ptr;
@@ -586,20 +585,6 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
     }
   #endif
 
-  /* unconditionally promote custom blocks so accounting is correct */
-  for (elt = self_minor_tables->custom.base;
-       elt < self_minor_tables->custom.ptr; elt++) {
-    value *v = &elt->block;
-    if (Is_block(*v) && Is_young(*v)) {
-      caml_adjust_gc_speed(elt->mem, elt->max);
-      if (get_header_val(*v) == 0) { /* value copied to major heap */
-        *v = Field(*v, 0);
-      } else {
-        oldify_one(&st, *v, v);
-      }
-    }
-  }
-
   CAML_EV_BEGIN(EV_MINOR_FINALIZERS_OLDIFY);
   /* promote the finalizers unconditionally as we want to avoid barriers */
   caml_final_do_young_roots (&oldify_one, oldify_scanning_flags, &st,
@@ -623,13 +608,6 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
     CAMLassert (!Is_block(vnew)
             || (get_header_val(vnew) != 0 && !Is_young(vnew)));
   }
-
-  for (elt = self_minor_tables->custom.base;
-       elt < self_minor_tables->custom.ptr; elt++) {
-    value vnew = elt->block;
-    CAMLassert (!Is_block(vnew)
-            || (get_header_val(vnew) != 0 && !Is_young(vnew)));
-  }
 #endif
 
   CAML_EV_BEGIN(EV_MINOR_LOCAL_ROOTS);
@@ -674,6 +652,28 @@ void caml_empty_minor_heap_promote(caml_domain_state* domain,
                (unsigned)(minor_allocated_bytes + 512)/1024);
 }
 
+/* Finalize dead custom blocks and do the accounting for the live
+   ones. This must be done right after leaving the barrier. At this
+   point, all domains have finished minor GC, but this domain hasn't
+   resumed running OCaml code. Other domains may have resumed OCaml
+   code, but they cannot have any pointers into our minor heap. */
+static void custom_finalize_minor (caml_domain_state * domain)
+{
+  struct caml_custom_elt *elt;
+  for (elt = domain->minor_tables->custom.base;
+       elt < domain->minor_tables->custom.ptr; elt++) {
+    value *v = &elt->block;
+    if (Is_block(*v) && Is_young(*v)) {
+      if (get_header_val(*v) == 0) { /* value copied to major heap */
+        caml_adjust_gc_speed(elt->mem, elt->max);
+      } else {
+        void (*final_fun)(value) = Custom_ops_val(*v)->finalize;
+        if (final_fun != NULL) final_fun(*v);
+      }
+    }
+  }
+}
+
 void caml_do_opportunistic_major_slice
   (caml_domain_state* domain_unused, void* unused)
 {
@@ -733,6 +733,11 @@ caml_stw_empty_minor_heap_no_major_slice(caml_domain_state* domain,
     CAML_EV_END(EV_MINOR_LEAVE_BARRIER);
   }
 
+  CAML_EV_BEGIN(EV_MINOR_FINALIZED);
+  caml_gc_log("finalizing dead minor custom blocks");
+  custom_finalize_minor(domain);
+  CAML_EV_END(EV_MINOR_FINALIZED);
+
   CAML_EV_BEGIN(EV_MINOR_FINALIZERS_ADMIN);
   caml_gc_log("running finalizer data structure book-keeping");
   caml_final_update_last_minor(domain);