From 6a3af5c9267830444946ae7a5d0d5a2923bf555b Mon Sep 17 00:00:00 2001 From: Stephen Dolan Date: Tue, 17 Nov 2020 11:17:52 +0000 Subject: [PATCH] Add Gc.Memprof.allocation_source --- runtime/memprof.c | 23 +++++++++++-------- stdlib/gc.ml | 3 ++- stdlib/gc.mli | 5 ++-- .../tests/statmemprof/arrays_in_major.ml | 2 +- .../tests/statmemprof/arrays_in_minor.ml | 2 +- testsuite/tests/statmemprof/custom.ml | 2 +- testsuite/tests/statmemprof/intern.ml | 2 +- testsuite/tests/statmemprof/lists_in_minor.ml | 2 +- 8 files changed, 23 insertions(+), 18 deletions(-) diff --git a/runtime/memprof.c b/runtime/memprof.c index 9da8681c4..256ba825c 100644 --- a/runtime/memprof.c +++ b/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(); diff --git a/stdlib/gc.ml b/stdlib/gc.ml index 75c13a378..b4fc555b7 100644 --- a/stdlib/gc.ml +++ b/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 = { diff --git a/stdlib/gc.mli b/stdlib/gc.mli index fccb211e6..04a48de60 100644 --- a/stdlib/gc.mli +++ b/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. *) diff --git a/testsuite/tests/statmemprof/arrays_in_major.ml b/testsuite/tests/statmemprof/arrays_in_major.ml index c66d7504b..78907a18e 100644 --- a/testsuite/tests/statmemprof/arrays_in_major.ml +++ b/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 ); diff --git a/testsuite/tests/statmemprof/arrays_in_minor.ml b/testsuite/tests/statmemprof/arrays_in_minor.ml index 5e71f4285..432f8b1d0 100644 --- a/testsuite/tests/statmemprof/arrays_in_minor.ml +++ b/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 ); diff --git a/testsuite/tests/statmemprof/custom.ml b/testsuite/tests/statmemprof/custom.ml index 72597653d..f0ddfa7ee 100644 --- a/testsuite/tests/statmemprof/custom.ml +++ b/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 diff --git a/testsuite/tests/statmemprof/intern.ml b/testsuite/tests/statmemprof/intern.ml index 05a5795ac..bce6f89c5 100644 --- a/testsuite/tests/statmemprof/intern.ml +++ b/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 diff --git a/testsuite/tests/statmemprof/lists_in_minor.ml b/testsuite/tests/statmemprof/lists_in_minor.ml index 597408824..ebd434857 100644 --- a/testsuite/tests/statmemprof/lists_in_minor.ml +++ b/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); };