Merge pull request ocaml#12923 from NickBarnes/nick-11911-statmemprof-rebase

Statmemprof resurrected

Author: stedolan

Changes

@@ -29,6 +29,10 @@ _______________
   (Kate Deplaix and Oscar Butler-Aldridge review by Nicolás Ojeda Bär,
    Craig Ferguson and Gabriel Scherer)
 
+- #11911, #12923: Multicore statistical memory profiling (Nick Barnes,
+  review by Stephen Dolan, Gabriel Scherer, Jacques-Henri Jourdan,
+  Guillaume Munch-Maccagnoni).
+
 ### Other libraries:
 
 ### Tools:
@@ -282,8 +286,9 @@ OCaml 5.2.0
    review by Damien Doligez, Sébastien Hinderer, Jacques-Henri Jourdan, Luc
    Maranget, Guillaume Munch-Maccagnoni, Gabriel Scherer)
 
-- #11911, #12381: Restore statmemprof functionality in part
-   (API changes in Gc.Memprof). (Nick Barnes)
+- #11911, #12381: Restore statmemprof functionality in part (API
+   changes in Gc.Memprof). (Nick Barnes, review by Jacques-Henri
+   Jourdan and Guillaume Munch-Maccagnoni).
 
 - #12430: Simplify dynamic bytecode loading in Meta.reify_bytecode
   (Stephen Dolan, review by Sébastien Hinderer, Vincent Laviron and Xavier
@@ -342,9 +347,10 @@ OCaml 5.2.0
    Ojeda Bar)
 
 - #11911, #12382, #12383: Restore statmemprof functionality in part
-  (backtrace buffers, per-thread and per-domain data structures).
-  (Nick Barnes, review by Gabriel Scherer, Fabrice Buoro, Sadiq
-   Jaffer, and Guillaume Munch-Maccagnoni).
+  (backtrace buffers, per-thread and per-domain data structures,
+  GC/allocation interface). (Nick Barnes, review by Gabriel Scherer,
+  Fabrice Buoro, Sadiq Jaffer, Guillaume Munch-Maccagnoni, and
+  Jacques-Henri Jourdan).
 
 - #12735: Store both ends of the stack chain in continuations
   (Leo White, review by Miod Vallat and KC Sivaramakrishnan)

otherlibs/runtime_events/runtime_events.ml

@@ -44,9 +44,12 @@ type runtime_phase =
 | EV_MAJOR
 | EV_MAJOR_SWEEP
 | EV_MAJOR_MARK_ROOTS
+| EV_MAJOR_MEMPROF_ROOTS
 | EV_MAJOR_MARK
 | EV_MINOR
 | EV_MINOR_LOCAL_ROOTS
+| EV_MINOR_MEMPROF_ROOTS
+| EV_MINOR_MEMPROF_CLEAN
 | EV_MINOR_FINALIZED
 | EV_EXPLICIT_GC_MAJOR_SLICE
 | EV_FINALISE_UPDATE_FIRST
@@ -69,6 +72,7 @@ type runtime_phase =
 | EV_STW_HANDLER
 | EV_STW_LEADER
 | EV_MAJOR_FINISH_SWEEPING
+| EV_MAJOR_MEMPROF_CLEAN
 | EV_MINOR_FINALIZERS_ADMIN
 | EV_MINOR_REMEMBERED_SET
 | EV_MINOR_REMEMBERED_SET_PROMOTE
@@ -129,9 +133,12 @@ let runtime_phase_name phase =
   | EV_MAJOR -> "major"
     | EV_MAJOR_SWEEP -> "major_sweep"
   | EV_MAJOR_MARK_ROOTS -> "major_mark_roots"
+  | EV_MAJOR_MEMPROF_ROOTS -> "major_memprof_roots"
   | EV_MAJOR_MARK -> "major_mark"
   | EV_MINOR -> "minor"
   | EV_MINOR_LOCAL_ROOTS -> "minor_local_roots"
+  | EV_MINOR_MEMPROF_ROOTS -> "minor_memprof_roots"
+  | EV_MINOR_MEMPROF_CLEAN -> "minor_memprof_clean"
   | EV_MINOR_FINALIZED -> "minor_finalized"
   | EV_EXPLICIT_GC_MAJOR_SLICE -> "explicit_gc_major_slice"
   | EV_FINALISE_UPDATE_FIRST -> "finalise_update_first"
@@ -153,6 +160,7 @@ let runtime_phase_name phase =
   | EV_STW_HANDLER -> "stw_handler"
   | EV_STW_LEADER -> "stw_leader"
   | EV_MAJOR_FINISH_SWEEPING -> "major_finish_sweeping"
+  | EV_MAJOR_MEMPROF_CLEAN -> "major_memprof_clean"
   | EV_MINOR_FINALIZERS_ADMIN -> "minor_finalizers_admin"
   | EV_MINOR_REMEMBERED_SET -> "minor_remembered_set"
   | EV_MINOR_REMEMBERED_SET_PROMOTE -> "minor_remembered_set_promote"

otherlibs/runtime_events/runtime_events.mli

@@ -99,9 +99,12 @@ type runtime_phase =
 | EV_MAJOR
 | EV_MAJOR_SWEEP
 | EV_MAJOR_MARK_ROOTS
+| EV_MAJOR_MEMPROF_ROOTS
 | EV_MAJOR_MARK
 | EV_MINOR
 | EV_MINOR_LOCAL_ROOTS
+| EV_MINOR_MEMPROF_ROOTS
+| EV_MINOR_MEMPROF_CLEAN
 | EV_MINOR_FINALIZED
 | EV_EXPLICIT_GC_MAJOR_SLICE
 | EV_FINALISE_UPDATE_FIRST
@@ -124,6 +127,7 @@ type runtime_phase =
 | EV_STW_HANDLER
 | EV_STW_LEADER
 | EV_MAJOR_FINISH_SWEEPING
+| EV_MAJOR_MEMPROF_CLEAN
 | EV_MINOR_FINALIZERS_ADMIN
 | EV_MINOR_REMEMBERED_SET
 | EV_MINOR_REMEMBERED_SET_PROMOTE

runtime/caml/memory.h

@@ -200,6 +200,9 @@ enum caml_alloc_small_flags {
 #define Alloc_small_enter_GC(dom_st, wosize)    \
   Alloc_small_enter_GC_flags(CAML_DO_TRACK | CAML_FROM_C, dom_st, wosize)
 
+#define Alloc_small_enter_GC_no_track(dom_st, wosize)    \
+  Alloc_small_enter_GC_flags(CAML_DONT_TRACK | CAML_FROM_C, dom_st, wosize)
+
 #define Alloc_small_with_reserved(result, wosize, tag, GC, reserved) do{    \
                                                 CAMLassert ((wosize) >= 1); \
                                           CAMLassert ((tag_t) (tag) < 256); \

runtime/caml/memprof.h

@@ -22,25 +22,131 @@
 #include "mlvalues.h"
 #include "roots.h"
 
-/* Suspend or unsuspend profiling */
+/*** Sample allocations ***/
+
+/* [Gc.Memprof.allocation_source] */
+
+enum { CAML_MEMPROF_SRC_NORMAL = 0,
+       CAML_MEMPROF_SRC_MARSHAL = 1, /* interning */
+       CAML_MEMPROF_SRC_CUSTOM = 2 /* custom memory */ };
+
+/* Respond to the allocation of any block. Does not call callbacks.
+ * `block` is the allocated block, to be tracked by memprof if
+ * sampled. `allocated_words` is the number of words allocated, to be
+ * passed to the allocation callback. `sampled_words` is the number of
+ * words to use when computing the number of samples (this will
+ * normally be one more than `allocated words` due to the header word,
+ * but may not be for out-of-heap memory). `source` is one of the
+ * `CAML_MEMPROF_SRC_* constants above. */
+
+void caml_memprof_sample_block(value block, size_t allocated_words,
+                               size_t sampled_words, int source);
+
+/* Sample a minor heap "Comballoc" (combined allocation). Called when
+ * the memprof trigger is hit (before the allocation is actually
+ * performed, which may require a GC). `allocs` and `alloc_lens`
+ * describe the combined allocation. Runs allocation callbacks. */
+
+extern void caml_memprof_sample_young(uintnat wosize, int from_caml,
+                                      int allocs, unsigned char* alloc_lens);
+
+/* Suspend or unsuspend sampling (for the current thread). */
+
 extern void caml_memprof_update_suspended(_Bool);
 
-/* Freshly set sampling point on minor heap */
-extern void caml_memprof_renew_minor_sample(caml_domain_state *state);
 
-/* Multi-domain support. */
+/*** GC interface ***/
+
+/* Apply `f(fdata, r, &r)` to each GC root `r` within memprof data
+ * structures for the domain `state`.
+ *
+ * `fflags` is used to decide whether to only scan roots which may
+ * point to minor heaps (the `SCANNING_ONLY_YOUNG_VALUES` flag).
+ *
+ * If `weak` is false then only scan strong roots. If `weak`
+ * is true then also scan weak roots.
+ *
+ * If `global` is false then only scan roots for `state`. If `global`
+ * is true then also scan roots shared between all domains. */
+
+extern void caml_memprof_scan_roots(scanning_action f,
+                                    scanning_action_flags fflags,
+                                    void* fdata,
+                                    caml_domain_state *state,
+                                    _Bool weak,
+                                    _Bool global);
+
+/* Update memprof data structures for the domain `state`, to reflect
+ * survival and promotion, after a minor GC is completed.
+ *
+ * If `global` is false then only update structures for `state`. If
+ * `global` is true then also update structures shared between all
+ * domains. */
+
+extern void caml_memprof_after_minor_gc(caml_domain_state *state, _Bool global);
+
+/* Update memprof data structures for the domain `state`, to reflect
+ * survival, after a minor GC is completed.
+ *
+ * If `global` is false then only update structures for `state`. If
+ * `global` is true then also update structures shared between all
+ * domains. */
+
+extern void caml_memprof_after_major_gc(caml_domain_state *state, _Bool global);
+
+/* Freshly computes state->memprof_young_trigger. *Does not* set the
+ * young limit. */
+
+extern void caml_memprof_set_trigger(caml_domain_state *state);
+
+/*** Callbacks ***/
+
+/* Run any pending callbacks for the current domain (or adopted from a
+ * terminated domain). */
+
+extern value caml_memprof_run_callbacks_exn(void);
+
+
+/*** Multi-domain support. ***/
+
+/* Notify memprof of the creation of a new domain `domain`. If there
+ * was an existing domain (from which to inherit profiling behaviour),
+ * it is passed in `parent`. Called before the new domain allocates
+ * anything, and before the parent domain continues. Also creates
+ * memprof thread state for the initial thread of the domain. */
 
 extern void caml_memprof_new_domain(caml_domain_state *parent,
                                     caml_domain_state *domain);
+
+/* Notify memprof that the domain `domain` is terminating. Called
+ * after the last allocation by the domain. */
+
 extern void caml_memprof_delete_domain(caml_domain_state *domain);
 
-/* Multi-thread support */
+
+/*** Multi-thread support ***/
+
+/* Opaque type of memprof state for a single thread. */
 
 typedef struct memprof_thread_s *memprof_thread_t;
 
-CAMLextern memprof_thread_t caml_memprof_main_thread(caml_domain_state *domain);
+/* Notify memprof that a new thread is being created. Returns a
+ * pointer to memprof state for the new thread. */
+
 CAMLextern memprof_thread_t caml_memprof_new_thread(caml_domain_state *domain);
+
+/* Obtain the memprof state for the initial thread of a domain. Called
+ * when there is only one such thread. */
+
+CAMLextern memprof_thread_t caml_memprof_main_thread(caml_domain_state *domain);
+
+/* Notify memprof that the current domain is switching to the given
+ * thread. */
+
 CAMLextern void caml_memprof_enter_thread(memprof_thread_t);
+
+/* Notify memprof that the given thread is being deleted. */
+
 CAMLextern void caml_memprof_delete_thread(memprof_thread_t);
 
 #endif

runtime/caml/runtime_events.h

@@ -80,9 +80,12 @@ typedef enum {
     EV_MAJOR,
     EV_MAJOR_SWEEP,
     EV_MAJOR_MARK_ROOTS,
+    EV_MAJOR_MEMPROF_ROOTS,
     EV_MAJOR_MARK,
     EV_MINOR,
     EV_MINOR_LOCAL_ROOTS,
+    EV_MINOR_MEMPROF_ROOTS,
+    EV_MINOR_MEMPROF_CLEAN,
     EV_MINOR_FINALIZED,
     EV_EXPLICIT_GC_MAJOR_SLICE,
     EV_FINALISE_UPDATE_FIRST,
@@ -105,6 +108,7 @@ typedef enum {
     EV_STW_HANDLER,
     EV_STW_LEADER,
     EV_MAJOR_FINISH_SWEEPING,
+    EV_MAJOR_MEMPROF_CLEAN,
     EV_MINOR_FINALIZERS_ADMIN,
     EV_MINOR_REMEMBERED_SET,
     EV_MINOR_REMEMBERED_SET_PROMOTE,

runtime/custom.c

@@ -112,7 +112,10 @@ CAMLexport value caml_alloc_custom_mem(const struct custom_operations * ops,
                                        uintnat bsz,
                                        mlsize_t mem)
 {
-  return alloc_custom_gen (ops, bsz, mem, 0, get_max_minor());
+  value v = alloc_custom_gen (ops, bsz, mem, 0, get_max_minor());
+  size_t mem_words = (mem + sizeof(value) - 1) / sizeof(value);
+  caml_memprof_sample_block(v, mem_words, mem_words, CAML_MEMPROF_SRC_CUSTOM);
+  return v;
 }
 
 struct custom_operations_list {

runtime/domain.c

@@ -469,6 +469,7 @@ static void free_minor_heap(void) {
   domain_state->young_end     = NULL;
   domain_state->young_ptr     = NULL;
   domain_state->young_trigger = NULL;
+  domain_state->memprof_young_trigger = NULL;
   atomic_store_release(&domain_state->young_limit,
                    (uintnat) domain_state->young_start);
 }
@@ -511,7 +512,7 @@ static int allocate_minor_heap(asize_t wsize) {
    * major slice is scheduled. */
   domain_state->young_trigger = domain_state->young_start
          + (domain_state->young_end - domain_state->young_start) / 2;
-  caml_memprof_renew_minor_sample(domain_state);
+  caml_memprof_set_trigger(domain_state);
   caml_reset_young_limit(domain_state);
 
   check_minor_heap();
@@ -620,14 +621,16 @@ static void domain_create(uintnat initial_minor_heap_wsize,
   atomic_store_explicit(&s->interrupt_word, &domain_state->young_limit,
                         memory_order_release);
 
+  domain_state->id = d->id;
+
   /* Tell memprof system about the new domain before either (a) new
    * domain can allocate anything or (b) parent domain can go away. */
+  CAMLassert(domain_state->memprof == NULL);
   caml_memprof_new_domain(parent, domain_state);
   if (!domain_state->memprof) {
     goto init_memprof_failure;
   }
 
-  domain_state->id = d->id;
   CAMLassert(!s->interrupt_pending);
 
   domain_state->extra_heap_resources = 0.0;
@@ -728,7 +731,6 @@ static void domain_create(uintnat initial_minor_heap_wsize,
   domain_state->trap_barrier_block = -1;
 #endif
 
-  caml_reset_young_limit(domain_state);
   add_next_to_stw_domains();
   goto domain_init_complete;
 

runtime/intern.c

@@ -396,7 +396,9 @@ static void intern_alloc_storage(struct caml_intern_state* s, mlsize_t whsize,
   wosize = Wosize_whsize(whsize);
 
   if (wosize <= Max_young_wosize && wosize != 0) {
-    v = caml_alloc_small (wosize, String_tag);
+    /* don't track bulk allocation in minor heap with statmemprof;
+     * individual block allocations are tracked instead */
+    Alloc_small(v, wosize, String_tag, Alloc_small_enter_GC_no_track);
     s->intern_dest = (header_t *) Hp_val(v);
   } else {
     CAMLassert (s->intern_dest == NULL);
@@ -426,6 +428,8 @@ static value intern_alloc_obj(struct caml_intern_state* s, caml_domain_state* d,
                 (value*)s->intern_dest < d->young_end);
     p = s->intern_dest;
     *s->intern_dest = Make_header (wosize, tag, 0);
+    caml_memprof_sample_block(Val_hp(p), wosize, 1 + wosize,
+                              CAML_MEMPROF_SRC_MARSHAL);
     s->intern_dest += 1 + wosize;
   } else {
     p = caml_shared_try_alloc(d->shared_heap, wosize, tag,
@@ -436,6 +440,9 @@ static value intern_alloc_obj(struct caml_intern_state* s, caml_domain_state* d,
       caml_raise_out_of_memory();
     }
     Hd_hp(p) = Make_header (wosize, tag, caml_global_heap_state.MARKED);
+    caml_memprof_sample_block(Val_hp(p), wosize,
+                              Whsize_wosize(wosize),
+                              CAML_MEMPROF_SRC_MARSHAL);
   }
   return Val_hp(p);
 }

runtime/major_gc.c

@@ -31,6 +31,7 @@
 #include "caml/globroots.h"
 #include "caml/gc_stats.h"
 #include "caml/memory.h"
+#include "caml/memprof.h"
 #include "caml/mlvalues.h"
 #include "caml/platform.h"
 #include "caml/roots.h"
@@ -1359,6 +1360,16 @@ static void stw_cycle_all_domains(caml_domain_state* domain, void* args,
      because there's one in the minor gc and after. */
   struct cycle_callback_params params = *((struct cycle_callback_params*)args);
 
+  /* TODO: Not clear this memprof work is really part of the "cycle"
+   * operation. It's more like ephemeron-cleaning really. An earlier
+   * version had a separate callback for this, but resulted in
+   * failures because using caml_try_run_on_all_domains() on it would
+   * mysteriously put all domains back into mark/sweep.
+   */
+  CAML_EV_BEGIN(EV_MAJOR_MEMPROF_CLEAN);
+  caml_memprof_after_major_gc(domain, domain == participating[0]);
+  CAML_EV_END(EV_MAJOR_MEMPROF_CLEAN);
+
   CAML_EV_BEGIN(EV_MAJOR_GC_CYCLE_DOMAINS);
 
   CAMLassert(domain == Caml_state);
@@ -1524,6 +1535,11 @@ static void stw_cycle_all_domains(caml_domain_state* domain, void* args,
   }
   CAML_EV_END(EV_MAJOR_MARK_ROOTS);
 
+  CAML_EV_BEGIN(EV_MAJOR_MEMPROF_ROOTS);
+  caml_memprof_scan_roots(caml_darken, darken_scanning_flags, domain,
+                          domain, false, participating[0] == Caml_state);
+  CAML_EV_END(EV_MAJOR_MEMPROF_ROOTS);
+
   if (domain->mark_stack->count == 0 &&
       !caml_addrmap_iter_ok(&domain->mark_stack->compressed_stack,
                             domain->mark_stack->compressed_stack_iter)