Upstream "mark-delay" change from flambda-backend.

Co-authored-by: Stephen Dolan <[email protected]>

runtime/array.c

@@ -714,7 +714,8 @@ CAMLprim value caml_uniform_array_fill(
       *fp = val;
       if (Is_block(old)) {
         if (Is_young(old)) continue;
-        caml_darken(Caml_state, old, NULL);
+        if (caml_marking_started())
+          caml_darken(Caml_state, old, NULL);
       }
       if (is_val_young_block)
         Ref_table_add(&Caml_state->minor_tables->major_ref, fp);

runtime/caml/domain.h

@@ -125,14 +125,14 @@ int caml_try_run_on_all_domains_with_spin_work(
   int sync,
   void (*handler)(caml_domain_state*, void*, int, caml_domain_state**),
   void* data,
-  void (*leader_setup)(caml_domain_state*),
+  void (*leader_setup)(caml_domain_state*, void *),
   /* return nonzero if there may still be useful work to do while spinning */
   int (*enter_spin_callback)(caml_domain_state*, void*),
   void* enter_spin_data);
 int caml_try_run_on_all_domains(
   void (*handler)(caml_domain_state*, void*, int, caml_domain_state**),
   void*,
-  void (*leader_setup)(caml_domain_state*));
+  void (*leader_setup)(caml_domain_state*, void *));
 
 /* Function naming conventions for STW callbacks and STW critical sections.
 

runtime/caml/major_gc.h

@@ -19,13 +19,20 @@
 #ifdef CAML_INTERNALS
 
 typedef enum {
+  Phase_sweep_main,
   Phase_sweep_and_mark_main,
   Phase_mark_final,
   Phase_sweep_ephe
 } gc_phase_t;
 
 extern gc_phase_t caml_gc_phase;
 
+Caml_inline int caml_marking_started(void)
+{
+  return caml_gc_phase != Phase_sweep_main;
+}
+
+extern atomic_uintnat caml_gc_mark_phase_requested;
 intnat caml_opportunistic_major_work_available (caml_domain_state*);
 void caml_opportunistic_major_collection_slice (intnat);
 /* auto-triggered slice from within the GC */
@@ -40,7 +47,7 @@ void caml_teardown_major_gc(void);
 void caml_darken(void*, value, volatile value* ignored);
 void caml_darken_cont(value);
 void caml_mark_root(value, value*);
-void caml_empty_mark_stack(void);
+void caml_mark_roots_stw(int, caml_domain_state **);
 void caml_finish_major_cycle(int force_compaction);
 #ifdef DEBUG
 int caml_mark_stack_is_empty(void);

runtime/caml/minor_gc.h

@@ -86,7 +86,7 @@ extern void caml_realloc_ephe_ref_table (struct caml_ephe_ref_table *);
 extern void caml_realloc_custom_table (struct caml_custom_table *);
 struct caml_minor_tables* caml_alloc_minor_tables(void);
 void caml_free_minor_tables(struct caml_minor_tables*);
-void caml_empty_minor_heap_setup(caml_domain_state* domain);
+void caml_empty_minor_heap_setup(caml_domain_state* domain, void *);
 
 #ifdef DEBUG
 extern int caml_debug_is_minor(value val);

runtime/caml/shared_heap.h

@@ -23,6 +23,7 @@
 #include "domain.h"
 #include "misc.h"
 #include "gc_stats.h"
+#include "major_gc.h"
 
 CAMLextern atomic_uintnat caml_compactions_count;
 
@@ -92,6 +93,13 @@ Caml_inline int is_not_markable(value v) {
   return Has_status_val(v, NOT_MARKABLE);
 }
 
+Caml_inline status caml_allocation_status(void) {
+  return
+    caml_marking_started()
+    ? caml_global_heap_state.MARKED
+    : caml_global_heap_state.UNMARKED;
+}
+
 void caml_redarken_pool(struct pool*, scanning_action, void*);
 
 intnat caml_sweep(struct caml_heap_state*, intnat);

runtime/domain.c

@@ -1601,7 +1601,7 @@ int caml_try_run_on_all_domains_with_spin_work(
   int sync,
   void (*handler)(caml_domain_state*, void*, int, caml_domain_state**),
   void* data,
-  void (*leader_setup)(caml_domain_state*),
+  void (*leader_setup)(caml_domain_state*, void*),
   int (*enter_spin_callback)(caml_domain_state*, void*),
   void* enter_spin_data)
 {
@@ -1669,7 +1669,7 @@ int caml_try_run_on_all_domains_with_spin_work(
   }
 
   if( leader_setup ) {
-    leader_setup(domain_state);
+    leader_setup(domain_state, data);
   }
 
 #ifdef DEBUG
@@ -1736,7 +1736,7 @@ int caml_try_run_on_all_domains_with_spin_work(
 int caml_try_run_on_all_domains(
   void (*handler)(caml_domain_state*, void*, int, caml_domain_state**),
   void* data,
-  void (*leader_setup)(caml_domain_state*))
+  void (*leader_setup)(caml_domain_state*, void *))
 {
   return
       caml_try_run_on_all_domains_with_spin_work(1,
@@ -1748,7 +1748,7 @@ int caml_try_run_on_all_domains(
 int caml_try_run_on_all_domains_async(
   void (*handler)(caml_domain_state*, void*, int, caml_domain_state**),
   void* data,
-  void (*leader_setup)(caml_domain_state*))
+  void (*leader_setup)(caml_domain_state*, void *))
 {
   return
       caml_try_run_on_all_domains_with_spin_work(0,

runtime/fiber.c

@@ -628,9 +628,9 @@ CAMLprim value caml_continuation_use_noexc (value cont)
 
   /* this forms a barrier between execution and any other domains
      that might be marking this continuation */
-  if (!Is_young(cont) ) caml_darken_cont(cont);
+  if (!Is_young(cont) && caml_marking_started())
+    caml_darken_cont(cont);
 
-  /* at this stage the stack is assured to be marked */
   v = Field(cont, 0);
 
   if (caml_domain_alone()) {

runtime/intern.c

@@ -440,7 +440,7 @@ static value intern_alloc_obj(struct caml_intern_state* s, caml_domain_state* d,
     }
     d->allocated_words += Whsize_wosize(wosize);
     d->allocated_words_direct += Whsize_wosize(wosize);
-    Hd_hp(p) = Make_header (wosize, tag, caml_global_heap_state.MARKED);
+    Hd_hp(p) = Make_header (wosize, tag, caml_allocation_status());
     caml_memprof_sample_block(Val_hp(p), wosize,
                               Whsize_wosize(wosize),
                               CAML_MEMPROF_SRC_MARSHAL);