Delay the start of marking with a new GC phase

ocaml/runtime/array.c

@@ -860,7 +860,8 @@ CAMLprim value caml_array_fill(value array,
       *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);

ocaml/runtime/caml/major_gc.h

@@ -19,6 +19,7 @@
 #ifdef CAML_INTERNALS
 
 typedef enum {
+  Phase_sweep_main,
   Phase_sweep_and_mark_main,
   Phase_mark_final,
   Phase_sweep_ephe
@@ -27,6 +28,8 @@ extern gc_phase_t caml_gc_phase;
 
 Caml_inline char caml_gc_phase_char(gc_phase_t phase) {
   switch (phase) {
+    case Phase_sweep_main:
+      return 'S';
     case Phase_sweep_and_mark_main:
       return 'M';
     case Phase_mark_final:
@@ -38,6 +41,10 @@ Caml_inline char caml_gc_phase_char(gc_phase_t phase) {
   }
 }
 
+Caml_inline int caml_marking_started(void) {
+  return caml_gc_phase != Phase_sweep_main;
+}
+
 intnat caml_opportunistic_major_work_available (void);
 void caml_opportunistic_major_collection_slice (intnat);
 /* auto-triggered slice from within the GC */

ocaml/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);

ocaml/runtime/domain.c

@@ -1784,11 +1784,12 @@ static void handover_finalisers(caml_domain_state* domain_state)
 
   if (f->todo_head != NULL || f->first.size != 0 || f->last.size != 0) {
     /* have some final structures */
-    if (caml_gc_phase != Phase_sweep_and_mark_main) {
+    if (caml_gc_phase != Phase_sweep_main &&
+        caml_gc_phase != Phase_sweep_and_mark_main) {
       /* Force a major GC cycle to simplify constraints for
        * handing over finalisers. */
       caml_finish_major_cycle(0);
-      CAMLassert(caml_gc_phase == Phase_sweep_and_mark_main);
+      CAMLassert(caml_gc_phase == Phase_sweep_main);
     }
     caml_add_orphaned_finalisers (f);
     /* Create a dummy final info */

ocaml/runtime/fiber.c

@@ -845,9 +845,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()) {

ocaml/runtime/intern.c

@@ -407,7 +407,7 @@ static value intern_alloc_obj(struct caml_intern_state* s, caml_domain_state* d,
       intern_cleanup (s);
       caml_raise_out_of_memory();
     }
-    Hd_hp(p) = Make_header (wosize, tag, caml_global_heap_state.MARKED);
+    Hd_hp(p) = Make_header (wosize, tag, caml_allocation_status());
   }
   return Val_hp(p);
 }

ocaml/runtime/major_gc.c

@@ -217,6 +217,9 @@ static void ephe_next_cycle (void)
 
 static void ephe_todo_list_emptied (void)
 {
+  /* If we haven't started marking, the todo list can grow (during ephemeron
+     allocation), so we should not yet announce that it has emptied */
+  CAMLassert (caml_marking_started());
   caml_plat_lock(&ephe_lock);
 
   /* Force next ephemeron marking cycle in order to avoid reasoning about
@@ -263,7 +266,7 @@ static caml_plat_mutex orphaned_lock = CAML_PLAT_MUTEX_INITIALIZER;
 
 void caml_add_orphaned_finalisers (struct caml_final_info* f)
 {
-  CAMLassert (caml_gc_phase == Phase_sweep_and_mark_main);
+  CAMLassert (caml_gc_phase == Phase_sweep_main);
   CAMLassert (!f->updated_first);
   CAMLassert (!f->updated_last);
 
@@ -384,7 +387,7 @@ void caml_adopt_orphaned_work (void)
     CAMLassert (!f->updated_last);
     CAMLassert (!myf->updated_first);
     CAMLassert (!myf->updated_last);
-    CAMLassert (caml_gc_phase == Phase_sweep_and_mark_main);
+    CAMLassert (caml_gc_phase == Phase_sweep_main);
     if (f->todo_head) {
       if (myf->todo_tail == NULL) {
         CAMLassert(myf->todo_head == NULL);
@@ -1053,6 +1056,7 @@ void caml_darken(void* state, value v, volatile value* ignored) {
   header_t hd;
   if (!Is_markable (v)) return; /* foreign stack, at least */
 
+  CAMLassert(caml_marking_started());
   hd = Hd_val(v);
   if (Tag_hd(hd) == Infix_tag) {
     v -= Infix_offset_hd(hd);
@@ -1089,6 +1093,7 @@ static intnat ephe_mark (intnat budget, uintnat for_cycle,
   int alive_data;
   intnat marked = 0, made_live = 0;
 
+  CAMLassert(caml_marking_started());
   if (domain_state->ephe_info->cursor.cycle == for_cycle &&
       !force_alive) {
     prev_linkp = domain_state->ephe_info->cursor.todop;
@@ -1189,6 +1194,51 @@ static intnat ephe_sweep (caml_domain_state* domain_state, intnat budget)
   return budget;
 }
 
+static void start_marking (int participant_count, caml_domain_state** barrier_participants)
+{
+  caml_domain_state* domain = Caml_state;
+  /* Need to ensure the minor heap is empty before we snapshot the roots,
+     because the minor heap may currently point to UNMARKED major blocks */
+  if (barrier_participants) {
+    caml_empty_minor_heap_no_major_slice_from_stw
+      (domain, (void*)0, participant_count, barrier_participants);
+  } else {
+    caml_empty_minor_heaps_once ();
+  }
+
+  /* CR ocaml 5 domains (sdolan):
+     Either this transition needs to be synchronised between domains,
+     or a different write barrier needs to be used while some domains
+     have started marking and others have not. */
+  CAMLassert(caml_domain_alone());
+  caml_gc_phase = Phase_sweep_and_mark_main;
+
+  CAML_EV_BEGIN(EV_MAJOR_MARK_ROOTS);
+  caml_do_roots (&caml_darken, darken_scanning_flags, domain, domain, 0);
+  {
+    uintnat work_unstarted = WORK_UNSTARTED;
+    if(atomic_compare_exchange_strong(&domain_global_roots_started,
+                                      &work_unstarted,
+                                      WORK_STARTED)){
+        caml_scan_global_roots(&caml_darken, domain);
+    }
+  }
+  CAML_EV_END(EV_MAJOR_MARK_ROOTS);
+  caml_gc_log("Marking started, %ld entries on mark stack",
+              (long)domain->mark_stack->count);
+
+  if (domain->mark_stack->count == 0 &&
+      !caml_addrmap_iter_ok(&domain->mark_stack->compressed_stack,
+                            domain->mark_stack->compressed_stack_iter)
+      ) {
+    atomic_fetch_add_verify_ge0(&num_domains_to_mark, -1);
+    domain->marking_done = 1;
+  }
+
+  if (domain->ephe_info->todo == (value) NULL)
+    ephe_todo_list_emptied();
+}
+
 struct cycle_callback_params {
   int force_compaction;
 };
@@ -1286,7 +1336,7 @@ static void stw_cycle_all_domains(caml_domain_state* domain, void* args,
       atomic_store_release(&num_domains_to_sweep, num_domains_in_stw);
       atomic_store_release(&num_domains_to_mark, num_domains_in_stw);
 
-      caml_gc_phase = Phase_sweep_and_mark_main;
+      caml_gc_phase = Phase_sweep_main;
       atomic_store(&ephe_cycle_info.num_domains_todo, num_domains_in_stw);
       atomic_store(&ephe_cycle_info.ephe_cycle, 1);
       atomic_store(&ephe_cycle_info.num_domains_done, 0);
@@ -1345,30 +1395,8 @@ static void stw_cycle_all_domains(caml_domain_state* domain, void* args,
                   (uintnat)local_stats.large_blocks);
 
   domain->sweeping_done = 0;
-
-  /* Mark roots for new cycle */
   domain->marking_done = 0;
 
-  CAML_EV_BEGIN(EV_MAJOR_MARK_ROOTS);
-  caml_do_roots (&caml_darken, darken_scanning_flags, domain, domain, 0);
-  {
-    uintnat work_unstarted = WORK_UNSTARTED;
-    if(atomic_compare_exchange_strong(&domain_global_roots_started,
-                                      &work_unstarted,
-                                      WORK_STARTED)){
-        caml_scan_global_roots(&caml_darken, domain);
-    }
-  }
-  CAML_EV_END(EV_MAJOR_MARK_ROOTS);
-
-  if (domain->mark_stack->count == 0 &&
-      !caml_addrmap_iter_ok(&domain->mark_stack->compressed_stack,
-                            domain->mark_stack->compressed_stack_iter)
-      ) {
-    atomic_fetch_add_verify_ge0(&num_domains_to_mark, -1);
-    domain->marking_done = 1;
-  }
-
   /* Ephemerons */
   // Adopt orphaned work from domains that were spawned and terminated in
   // the previous cycle.
@@ -1383,8 +1411,6 @@ static void stw_cycle_all_domains(caml_domain_state* domain, void* args,
   domain->ephe_info->cycle = 0;
   domain->ephe_info->cursor.todop = NULL;
   domain->ephe_info->cursor.cycle = 0;
-  if (domain->ephe_info->todo == (value) NULL)
-    ephe_todo_list_emptied();
 
   /* Finalisers */
   domain->final_info->updated_first = 0;
@@ -1539,8 +1565,17 @@ static void major_collection_slice(intnat howmuch,
     if (log_events) CAML_EV_END(EV_MAJOR_SWEEP);
   }
 
+  if (domain_state->sweeping_done &&
+      caml_gc_phase == Phase_sweep_main &&
+      get_major_slice_work(mode) > 0 &&
+      mode != Slice_opportunistic) {
+    start_marking(participant_count, barrier_participants);
+  }
+
+
 mark_again:
-  if (!domain_state->marking_done &&
+  if (caml_marking_started() &&
+      !domain_state->marking_done &&
       get_major_slice_work(mode) > 0) {
     if (log_events) CAML_EV_BEGIN(EV_MAJOR_MARK);
 
@@ -1555,7 +1590,7 @@ static void major_collection_slice(intnat howmuch,
     if (log_events) CAML_EV_END(EV_MAJOR_MARK);
   }
 
-  if (mode != Slice_opportunistic) {
+  if (mode != Slice_opportunistic && caml_marking_started()) {
     /* Finalisers */
     if (caml_gc_phase == Phase_mark_final &&
         get_major_slice_work(mode) > 0 &&
@@ -1810,6 +1845,9 @@ void caml_finish_marking (void)
 {
   if (!Caml_state->marking_done) {
     CAML_EV_BEGIN(EV_MAJOR_FINISH_MARKING);
+    if (!caml_marking_started()) {
+      start_marking(0, NULL);
+    }
     caml_empty_mark_stack();
     caml_shrink_mark_stack();
     Caml_state->stat_major_words += Caml_state->allocated_words;
@@ -1930,6 +1968,7 @@ int caml_init_major_gc(caml_domain_state* d) {
                   caml_addrmap_iterator(&d->mark_stack->compressed_stack);
 
   /* Fresh domains do not need to performing marking or sweeping. */
+  /* CR ocaml 5 domains: how does this interact with Phase_sweep_main? */
   d->sweeping_done = 1;
   d->marking_done = 1;
   /* Finalisers. Fresh domains participate in updating finalisers. */

ocaml/runtime/memory.c

@@ -137,7 +137,8 @@ Caml_inline void write_barrier(
           then this is in a remembered set already */
        if (Is_young(old_val)) return;
        /* old is a block and in the major heap */
-       caml_darken(Caml_state, old_val, 0);
+       if (caml_marking_started())
+         caml_darken(Caml_state, old_val, 0);
      }
      /* this update is creating a new link from major to minor, remember it */
      if (Is_block_and_young(new_val)) {

ocaml/runtime/minor_gc.c

@@ -297,7 +297,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
     {
       /* Conflict - fix up what we allocated on the major heap */
       *Hp_val(result) = Make_header(1, No_scan_tag,
-                                    caml_global_heap_state.MARKED);
+                                    caml_allocation_status());
       #ifdef DEBUG
       Field(result, 0) = Val_long(1);
       #endif
@@ -322,7 +322,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
     } else {
       /* Conflict - fix up what we allocated on the major heap */
       *Hp_val(result) = Make_header(sz, No_scan_tag,
-                                    caml_global_heap_state.MARKED);
+                                    caml_allocation_status());
       #ifdef DEBUG
       {
         int c;
@@ -344,7 +344,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
     if( !try_update_object_header(v, p, result, 0) ) {
       /* Conflict */
       *Hp_val(result) = Make_header(sz, No_scan_tag,
-                                    caml_global_heap_state.MARKED);
+                                    caml_allocation_status());
       #ifdef DEBUG
       for( i = 0; i < sz ; i++ ) {
         Field(result, i) = Val_long(1);
@@ -376,7 +376,7 @@ static void oldify_one (void* st_v, value v, volatile value *p)
         goto tail_call;
       } else {
         *Hp_val(result) = Make_header(1, No_scan_tag,
-                                      caml_global_heap_state.MARKED);
+                                      caml_allocation_status());
         #ifdef DEBUG
         Field(result, 0) = Val_long(1);
         #endif

ocaml/runtime/shared_heap.c

@@ -474,7 +474,7 @@ value* caml_shared_try_alloc(struct caml_heap_state* local, mlsize_t wosize,
     p = large_allocate(local, Bsize_wsize(whsize));
     if (!p) return 0;
   }
-  colour = caml_global_heap_state.MARKED;
+  colour = caml_allocation_status();
   Hd_hp (p) = Make_header_with_reserved(wosize, tag, colour, reserved);
 #ifdef DEBUG
   {

ocaml/runtime/weak.c

@@ -59,8 +59,16 @@ CAMLprim value caml_ephe_create (value len)
     caml_invalid_argument ("Weak.create");
   res = caml_alloc_shr (size, Abstract_tag);
 
-  Ephe_link(res) = domain_state->ephe_info->live;
-  domain_state->ephe_info->live = res;
+  /* The new ephemeron needs to be added to:
+       live, if marking has started, to be marked next cycle
+       todo, if marking has not started, to be marked this cycle */
+  if (caml_marking_started()) {
+    Ephe_link(res) = domain_state->ephe_info->live;
+    domain_state->ephe_info->live = res;
+  } else {
+    Ephe_link(res) = domain_state->ephe_info->todo;
+    domain_state->ephe_info->todo = res;
+  }
   for (i = CAML_EPHE_DATA_OFFSET; i < size; i++)
     Field(res, i) = caml_ephe_none;
   /* run memprof callbacks */
@@ -255,7 +263,8 @@ static value ephe_get_field (value e, mlsize_t offset)
   if (elt == caml_ephe_none) {
     res = Val_none;
   } else {
-    caml_darken (Caml_state, elt, 0);
+    if (caml_marking_started())
+      caml_darken (Caml_state, elt, 0);
     res = caml_alloc_small (1, Tag_some);
     Field(res, 0) = elt;
   }
@@ -307,7 +316,8 @@ static void ephe_copy_and_darken(value from, value to)
   mlsize_t to_size = Wosize_val(to);
   while (i < to_size) {
     value field = Field(from, i);
-    caml_darken (domain_state, field, 0);
+    if (caml_marking_started())
+      caml_darken (domain_state, field, 0);
     Store_field(to, i, field);
     ++ i;
   }
@@ -469,7 +479,8 @@ CAMLprim value caml_ephe_blit_key (value es, value ofs,
 CAMLprim value caml_ephe_blit_data (value es, value ed)
 {
   ephe_blit_field (es, CAML_EPHE_DATA_OFFSET, ed, CAML_EPHE_DATA_OFFSET, 1);
-  caml_darken(0, Field(ed, CAML_EPHE_DATA_OFFSET), 0);
+  if (caml_marking_started())
+    caml_darken(0, Field(ed, CAML_EPHE_DATA_OFFSET), 0);
   /* [ed] may be in [Caml_state->ephe_info->live] list. The data value may be
      unmarked. The ephemerons on the live list are not scanned during ephemeron
      marking. Hence, unconditionally darken the data value. */

ocaml/testsuite/tests/lib-runtime-events/test_instrumented.reference

@@ -1 +1 @@
-lost_event_words: 0, total_sizes: 2000004, total_minors: 15
+lost_event_words: 0, total_sizes: 2000004, total_minors: 20