Source file `landmark_threads.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
57
58
59
60
61
include Landmark

let current_id = ref Thread.(id (self ()))

let check () =
  !current_id = Thread.(id (self ()))

let error operation =
  failwith (Printf.sprintf "%s: this operation can only be called by the thread that started the profiling" operation)

let increment ?times counter =
  if check () then
    increment ?times counter

let sample sampler value =
  if check () then
    sample sampler value

let enter lm =
  if check () then
    enter lm

let exit lm =
  if check () then
    exit lm

let wrap lm f x =
  if check () then
    wrap lm f x
  else f x

let unsafe_wrap lm f x =
  if check () then
    wrap lm f x
  else
    f x

let export ?label () =
  if check () then
    export ?label ()
  else
    error "export"

let reset () =
  if check () then
    reset ()
  else
    error "reset"

let export_and_reset ?label () =
  if check () then
    export_and_reset ?label ()
  else
    error "export_and_reset"

let start_profiling ?profiling_options () =
  current_id := Thread.(id (self ()));
  start_profiling ?profiling_options ()

let stop_profiling () =
  stop_profiling ()