Source file `memprof.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
(* Copyright (c) 2020-2025, Guillaume Munch-Maccagnoni & INRIA
   SPDX-License-Identifier: LGPL-3.0-only WITH LGPL-3.0-linking-exception
*)

#include "config.h"

include Stdlib.Gc.Memprof

let stop = Memprof_server.stop_1

#if MULTICORE = 0

let start = Memprof_server.start_1

#else

(* For OCaml 5, we reimplement discarding by hand. *)
type t = Token.t

let discard = Token.set

let relativize t f x =
  if not (Token.is_set t) then f x

let relativize_opt t f x =
  if Token.is_set t then None else f x

let start ~sampling_rate ?callstack_size tracker =
  let t = Token.create () in
  let relative_tracker =
    let { alloc_minor ;
          alloc_major ;
          promote ;
          dealloc_minor ;
          dealloc_major } = tracker in
    let alloc_minor x = relativize_opt t alloc_minor x in
    let alloc_major x = relativize_opt t alloc_major x in
    let promote x = relativize_opt t promote x in
    let dealloc_minor x = relativize t dealloc_minor x in
    let dealloc_major x = relativize t dealloc_major x in
    { alloc_minor ;
      alloc_major ;
      promote ;
      dealloc_minor ;
      dealloc_major }
  in
  ignore (Memprof_server.start_1 ~sampling_rate ?callstack_size relative_tracker) ;
  (* We pretend that the config is an actual memprof config. In OCaml
     5.3, this can only be passed to Gc.Memprof.discard. *)
  t

#if HAS_RESTART = 1
let is_sampling = Memprof_server.is_started_1
#endif

#endif