/usr/lib/ocaml/spacetime.ml is in ocaml-nox 4.05.0-10ubuntu1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 | (**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 2015--2016 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
external spacetime_enabled : unit -> bool
= "caml_spacetime_enabled" [@@noalloc]
let enabled = spacetime_enabled ()
let if_spacetime_enabled f =
if enabled then f () else ()
module Series = struct
type t = {
channel : out_channel;
mutable closed : bool;
}
external write_magic_number : out_channel -> unit
= "caml_spacetime_only_works_for_native_code"
"caml_spacetime_write_magic_number"
external register_channel_for_spacetime : out_channel -> unit
= "caml_register_channel_for_spacetime"
let create ~path =
if spacetime_enabled () then begin
let channel = open_out path in
register_channel_for_spacetime channel;
let t =
{ channel = channel;
closed = false;
}
in
write_magic_number t.channel;
t
end else begin
{ channel = stdout; (* arbitrary value *)
closed = true;
}
end
external save_event : ?time:float -> out_channel -> event_name:string -> unit
= "caml_spacetime_only_works_for_native_code"
"caml_spacetime_save_event"
let save_event ?time t ~event_name =
if_spacetime_enabled (fun () ->
save_event ?time t.channel ~event_name)
external save_trie : ?time:float -> out_channel -> unit
= "caml_spacetime_only_works_for_native_code"
"caml_spacetime_save_trie"
let save_and_close ?time t =
if_spacetime_enabled (fun () ->
if t.closed then failwith "Series is closed";
save_trie ?time t.channel;
close_out t.channel;
t.closed <- true)
end
module Snapshot = struct
external take : ?time:float -> out_channel -> unit
= "caml_spacetime_only_works_for_native_code"
"caml_spacetime_take_snapshot"
let take ?time { Series.closed; channel } =
if_spacetime_enabled (fun () ->
if closed then failwith "Series is closed";
Gc.minor ();
take ?time channel)
end
external save_event_for_automatic_snapshots : event_name:string -> unit
= "caml_spacetime_only_works_for_native_code"
"caml_spacetime_save_event_for_automatic_snapshots"
let save_event_for_automatic_snapshots ~event_name =
if_spacetime_enabled (fun () ->
save_event_for_automatic_snapshots ~event_name)
|