Add Gc.Memprof.allocation_source

runtime/memprof.c

@@ -57,6 +57,9 @@ static intnat callstack_size;
 
 static value tracker;
 
+/* Gc.Memprof.allocation_source */
+enum { SRC_NORMAL = 0, SRC_MARSHAL = 1, SRC_CUSTOM = 2 };
+
 struct tracked {
   /* Memory block being sampled. This is a weak GC root. */
   value block;
@@ -79,8 +82,8 @@ struct tracked {
   /* Whether this block has been initially allocated in the minor heap. */
   unsigned int alloc_young : 1;
 
-  /* Whether this block comes from unmarshalling. */
-  unsigned int unmarshalled : 1;
+  /* The source of the allocation: normal allocations, marshal or custom_mem. */
+  unsigned int source : 2;
 
   /* Whether this block has been promoted. Implies [alloc_young]. */
   unsigned int promoted : 1;
@@ -405,7 +408,7 @@ static int realloc_entries(struct entry_array* ea, uintnat grow)
 #define Invalid_index (~(uintnat)0)
 
 Caml_inline uintnat new_tracked(uintnat n_samples, uintnat wosize,
-                                int is_unmarshalled, int is_young,
+                                int source, int is_young,
                                 value block, value user_data)
 {
   struct tracked *t;
@@ -419,7 +422,7 @@ Caml_inline uintnat new_tracked(uintnat n_samples, uintnat wosize,
   t->user_data = user_data;
   t->running = NULL;
   t->alloc_young = is_young;
-  t->unmarshalled = is_unmarshalled;
+  t->source = source;
   t->promoted = 0;
   t->deallocated = 0;
   t->cb_promote_called = t->cb_dealloc_called = 0;
@@ -513,7 +516,7 @@ static value run_alloc_callback_exn(uintnat t_idx)
   sample_info = caml_alloc_small(4, 0);
   Field(sample_info, 0) = Val_long(t->n_samples);
   Field(sample_info, 1) = Val_long(t->wosize);
-  Field(sample_info, 2) = Val_long(t->unmarshalled);
+  Field(sample_info, 2) = Val_long(t->source);
   Field(sample_info, 3) = t->user_data;
   return run_callback_exn(&local->entries, t_idx,
      t->alloc_young ? Alloc_minor(tracker) : Alloc_major(tracker), sample_info);
@@ -761,7 +764,7 @@ void caml_memprof_track_alloc_shr(value block)
   callstack = capture_callstack_postponed();
   if (callstack == 0) return;
 
-  new_tracked(n_samples, Wosize_val(block), 0, 0, block, callstack);
+  new_tracked(n_samples, Wosize_val(block), SRC_NORMAL, 0, block, callstack);
   check_action_pending();
 }
 
@@ -779,7 +782,7 @@ void caml_memprof_track_custom(value block, mlsize_t bytes)
   callstack = capture_callstack_postponed();
   if (callstack == 0) return;
 
-  new_tracked(n_samples, Wsize_bsize(bytes), 0, Is_young(block),
+  new_tracked(n_samples, Wsize_bsize(bytes), SRC_CUSTOM, Is_young(block),
               block, callstack);
   check_action_pending();
 }
@@ -846,7 +849,7 @@ void caml_memprof_track_young(uintnat wosize, int from_caml,
     if (callstack == 0) return;
 
     new_tracked(n_samples, wosize,
-                0, 1, Val_hp(Caml_state->young_ptr), callstack);
+                SRC_NORMAL, 1, Val_hp(Caml_state->young_ptr), callstack);
     check_action_pending();
     return;
   }
@@ -886,7 +889,7 @@ void caml_memprof_track_young(uintnat wosize, int from_caml,
 
       callstack = capture_callstack(alloc_idx);
       t_idx = new_tracked(n_samples, alloc_wosz,
-                          0, 1, Placeholder_offs(alloc_ofs), callstack);
+                          SRC_NORMAL, 1, Placeholder_offs(alloc_ofs), callstack);
       if (t_idx == Invalid_index) continue;
       res = run_alloc_callback_exn(t_idx);
       /* Has [caml_memprof_stop] been called during the callback? */
@@ -1006,7 +1009,7 @@ void caml_memprof_track_interned(header_t* block, header_t* blockend)
     if (callstack == 0) callstack = capture_callstack_postponed();
     if (callstack == 0) break;  /* OOM */
     new_tracked(rand_binom(next_p - next_sample_p) + 1,
-                Wosize_hp(p), 1, is_young, Val_hp(p), callstack);
+                Wosize_hp(p), SRC_MARSHAL, is_young, Val_hp(p), callstack);
     p = next_p;
   }
   check_action_pending();

stdlib/gc.ml

@@ -125,10 +125,11 @@ let delete_alarm a = a := false
 
 module Memprof =
   struct
+    type allocation_source = Normal | Marshal | Custom
     type allocation =
       { n_samples : int;
         size : int;
-        unmarshalled : bool;
+        source : allocation_source;
         callstack : Printexc.raw_backtrace }
 
     type ('minor, 'major) tracker = {

stdlib/gc.mli

@@ -463,6 +463,7 @@ external eventlog_resume : unit -> unit = "caml_eventlog_resume"
    notice. *)
 module Memprof :
   sig
+    type allocation_source = Normal | Marshal | Custom
     type allocation = private
       { n_samples : int;
         (** The number of samples in this block (>= 1). *)
@@ -470,8 +471,8 @@ module Memprof :
         size : int;
         (** The size of the block, in words, excluding the header. *)
 
-        unmarshalled : bool;
-        (** Whether the block comes from unmarshalling. *)
+        source : allocation_source;
+        (** The type of the allocation. *)
 
         callstack : Printexc.raw_backtrace
         (** The callstack for the allocation. *)

testsuite/tests/statmemprof/arrays_in_major.ml

@@ -112,7 +112,7 @@ let check_distrib lo hi cnt rate =
       alloc_major = (fun info ->
         assert (info.size >= lo && info.size <= hi);
         assert (info.n_samples > 0);
-        assert (not info.unmarshalled);
+        assert (info.source = Normal);
         smp := !smp + info.n_samples;
         None
       );

testsuite/tests/statmemprof/arrays_in_minor.ml

@@ -126,7 +126,7 @@ let check_distrib lo hi cnt rate =
       alloc_minor = (fun info ->
         assert (info.size >= lo && info.size <= hi);
         assert (info.n_samples > 0);
-        assert (not info.unmarshalled);
+        assert (info.source = Normal);
         smp := !smp + info.n_samples;
         None
       );

testsuite/tests/statmemprof/custom.ml

@@ -15,7 +15,7 @@ let test sampling_rate =
   let tracker =
     { null_tracker with
       alloc_minor = (fun info ->
-        if info.size < size_words then None
+        if info.source <> Custom then None
         else begin
           alloc := !alloc + info.n_samples;
           Some info.n_samples

testsuite/tests/statmemprof/intern.ml

@@ -134,7 +134,7 @@ let check_distrib lo hi cnt rate =
   let alloc info =
     (* We also allocate the list constructor in the minor heap,
        so we filter that out. *)
-    if info.unmarshalled then begin
+    if info.source = Marshal then begin
       assert (info.size = 1 || info.size = 2);
       assert (info.n_samples > 0);
       smp := !smp + info.n_samples

testsuite/tests/statmemprof/lists_in_minor.ml

@@ -22,7 +22,7 @@ let check_distrib len cnt rate =
       alloc_minor = (fun info ->
         assert (info.size = 2);
         assert (info.n_samples > 0);
-        assert (not info.unmarshalled);
+        assert (info.source = Normal);
         smp := !smp + info.n_samples;
         None);
     };