├── src
    ├── mtime.mllib
    ├── mtime_top.mllib
    ├── mtime_top_init.ml
    ├── mtime_top.ml
    ├── mtime_clock.mli
    ├── mtime.ml
    └── mtime.mli
├── src-clock
    ├── mtime_clock.mllib
    ├── mtime_clock.mli
    ├── libmtime_clock_stubs.clib
    ├── mtime_clock.ml
    ├── runtime.js
    └── mtime_clock_stubs.c
├── .gitignore
├── .ocp-indent
├── .merlin
├── BRZO
├── _tags
├── pkg
    ├── pkg.ml
    └── META
├── doc
    └── index.mld
├── LICENSE.md
├── test
    ├── min_clock.ml
    ├── test.ml
    └── tests.ml
├── opam
├── myocamlbuild.ml
├── README.md
├── B0.ml
└── CHANGES.md


/src/mtime.mllib:
--------------------------------------------------------------------------------
1 | Mtime
2 | 


--------------------------------------------------------------------------------
/src/mtime_top.mllib:
--------------------------------------------------------------------------------
1 | Mtime_top


--------------------------------------------------------------------------------
/src-clock/mtime_clock.mllib:
--------------------------------------------------------------------------------
1 | Mtime_clock
2 | 


--------------------------------------------------------------------------------
/src-clock/mtime_clock.mli:
--------------------------------------------------------------------------------
1 | ../src/mtime_clock.mli


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | _b0
2 | _build
3 | tmp
4 | *.install
5 | 


--------------------------------------------------------------------------------
/.ocp-indent:
--------------------------------------------------------------------------------
1 | strict_with=always,match_clause=4,strict_else=never


--------------------------------------------------------------------------------
/src-clock/libmtime_clock_stubs.clib:
--------------------------------------------------------------------------------
1 | mtime_clock_stubs.o
2 | 


--------------------------------------------------------------------------------
/.merlin:
--------------------------------------------------------------------------------
1 | PKG b0.kit
2 | S src
3 | S src-clock
4 | S test
5 | B _b0/**
6 | 


--------------------------------------------------------------------------------
/BRZO:
--------------------------------------------------------------------------------
1 | (srcs-x myocamlbuild.ml pkg test src/mtime_top.ml src/mtime_top_init.ml)


--------------------------------------------------------------------------------
/_tags:
--------------------------------------------------------------------------------
 1 | true : bin_annot, safe_string
 2 | 
 3 | <_b0> : -traverse
 4 | 
 5 | <src> : include
 6 | <src/mtime_top*> : package(compiler-libs.toplevel)
 7 | 
 8 | <src-clock/mtime_clock.{cma,cmxa}> : record_mtime_clock_os_stubs
 9 | <src-clock/mtime_clock.cmxs> : link_mtime_clock_os_stubs
10 | 
11 | <test/*> : use_mtime, use_mtime_clock_os


--------------------------------------------------------------------------------
/pkg/pkg.ml:
--------------------------------------------------------------------------------
 1 | #!/usr/bin/env ocaml
 2 | #use "topfind"
 3 | #require "topkg"
 4 | open Topkg
 5 | 
 6 | let () =
 7 |   Pkg.describe "mtime" @@ fun c ->
 8 |   Ok [ Pkg.mllib "src/mtime.mllib";
 9 |        Pkg.mllib ~api:[] "src/mtime_top.mllib" ~dst_dir:"top/";
10 |        Pkg.lib "src/mtime_top_init.ml";
11 |        Pkg.mllib "src-clock/mtime_clock.mllib" ~dst_dir:"clock/os/";
12 |        Pkg.clib "src-clock/libmtime_clock_stubs.clib" ~lib_dst_dir:"clock/os/";
13 |        Pkg.lib "src-clock/runtime.js" ~dst:"clock/os/";
14 |        Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld";
15 |        Pkg.doc "test/min_clock.ml"; ]
16 | 


--------------------------------------------------------------------------------
/doc/index.mld:
--------------------------------------------------------------------------------
 1 | {0 Mtime {%html: <span class="version">%%VERSION%%</span>%}}
 2 | 
 3 | Mtime has platform independent support for monotonic wall-clock time.
 4 | This time increases monotonically and is not subject to operating
 5 | system calendar time adjustments. The library has types to represent
 6 | nanosecond precision timestamps and time spans.
 7 | 
 8 | {!Mtime_clock} provides acces to {{!Mtime_clock.platform_support}a
 9 | monotonic system clock} and its resolution (if available).
10 | 
11 | {1:mtime Library [mtime]}
12 | 
13 | {!modules: Mtime}
14 | 
15 | {1:mtime_clock Library [mtime.clock.os]}
16 | 
17 | {!modules: Mtime_clock}
18 | 
19 | Also use this library for compiling to JavaScript.
20 | 


--------------------------------------------------------------------------------
/LICENSE.md:
--------------------------------------------------------------------------------
 1 | Copyright (c) 2015 The mtime programmers
 2 | 
 3 | Permission to use, copy, modify, and/or distribute this software for any
 4 | purpose with or without fee is hereby granted, provided that the above
 5 | copyright notice and this permission notice appear in all copies.
 6 | 
 7 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 8 | WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 9 | MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
10 | ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
11 | WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
12 | ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
13 | OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
14 | 


--------------------------------------------------------------------------------
/test/min_clock.ml:
--------------------------------------------------------------------------------
 1 | (*
 2 |    Compile with:
 3 | 
 4 |    ocamlfind ocamlopt \
 5 |      -package mtime.clock.os -linkpkg -o min_clock.native min_clock.ml
 6 | 
 7 |    ocamlfind ocamlc \
 8 |      -package mtime.clock.os -linkpkg -o min_clock.byte min_clock.ml
 9 | 
10 |     js_of_ocaml \
11 |       $(ocamlfind query -format "%+(jsoo_runtime)" -r mtime.clock.os) \
12 |       min_clock.byte
13 | *)
14 | 
15 | let main () =
16 |   Format.printf "Elapsed: %a@." Mtime.Span.pp (Mtime_clock.elapsed ());
17 |   Format.printf "Timestamp: %a@." Mtime.pp (Mtime_clock.now ());
18 |   Format.printf "Clock period: %s@."
19 |     (match Mtime_clock.period () with
20 |     | None -> "unknown" | Some s -> Format.asprintf "%a" Mtime.Span.pp s);
21 |   ()
22 | 
23 | let () = if !Sys.interactive then () else main ()
24 | 


--------------------------------------------------------------------------------
/pkg/META:
--------------------------------------------------------------------------------
 1 | description = "Monotonic wall-clock time for OCaml"
 2 | version = "%%VERSION_NUM%%"
 3 | requires = ""
 4 | archive(byte) = "mtime.cma"
 5 | archive(native) = "mtime.cmxa"
 6 | plugin(byte) = "mtime.cma"
 7 | plugin(native) = "mtime.cmxs"
 8 | 
 9 | package "top" (
10 |   description = "Mtime toplevel support"
11 |   version = "%%VERSION_NUM%%"
12 |   requires = "mtime"
13 |   directory = "top"
14 |   archive(byte) = "mtime_top.cma"
15 |   archive(native) = "mtime_top.cmxa"
16 |   plugin(byte) = "mtime_top.cma"
17 |   plugin(native) = "mtime_top.cmxs"
18 | )
19 | 
20 | package "clock" (
21 |   description = "Monotonic time clock interface"
22 |   version = "%%VERSION_NUM%%"
23 |   requires = ""
24 |   directory = "clock"
25 | 
26 |   package "os" (
27 |     description = "Mtime_clock for your platform (including JavaScript)"
28 |     version = "%%VERSION_NUM%%"
29 |     requires = "mtime"
30 |     directory = "os"
31 |     archive(byte) = "mtime_clock.cma"
32 |     archive(native) = "mtime_clock.cmxa"
33 |     plugin(byte) = "mtime_clock.cma"
34 |     plugin(native) = "mtime_clock.cmxs"
35 |     jsoo_runtime = "runtime.js"
36 |     exists_if = "mtime_clock.cma")
37 | )
38 | 


--------------------------------------------------------------------------------
/test/test.ml:
--------------------------------------------------------------------------------
 1 | (*---------------------------------------------------------------------------
 2 |    Copyright (c) 2015 The mtime programmers. All rights reserved.
 3 |    Distributed under the ISC license, see terms at the end of the file.
 4 |   ---------------------------------------------------------------------------*)
 5 | 
 6 | let () = Tests.run ()
 7 | 
 8 | (*---------------------------------------------------------------------------
 9 |    Copyright (c) 2015 The mtime programmers
10 | 
11 |    Permission to use, copy, modify, and/or distribute this software for any
12 |    purpose with or without fee is hereby granted, provided that the above
13 |    copyright notice and this permission notice appear in all copies.
14 | 
15 |    THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
16 |    WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
17 |    MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
18 |    ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
19 |    WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
20 |    ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
21 |    OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
22 |   ---------------------------------------------------------------------------*)
23 | 


--------------------------------------------------------------------------------
/opam:
--------------------------------------------------------------------------------
 1 | opam-version: "2.0"
 2 | name: "mtime"
 3 | synopsis: "Monotonic wall-clock time for OCaml"
 4 | description: """\
 5 | Mtime has platform independent support for monotonic wall-clock time
 6 | in pure OCaml. This time increases monotonically and is not subject to
 7 | operating system calendar time adjustments. The library has types to
 8 | represent nanosecond precision timestamps and time spans.
 9 | 
10 | The additional Mtime_clock library provide access to a system
11 | monotonic clock.
12 | 
13 | Mtime has a no dependency. Mtime_clock depends on your system library
14 | or JavaScript runtime system. Mtime and its libraries are distributed
15 | under the ISC license.
16 | 
17 | Home page: http://erratique.ch/software/mtime"""
18 | maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
19 | authors: "The mtime programmers"
20 | license: "ISC"
21 | tags: ["time" "monotonic" "system" "org:erratique"]
22 | homepage: "https://erratique.ch/software/mtime"
23 | doc: "https://erratique.ch/software/mtime/doc/"
24 | bug-reports: "https://github.com/dbuenzli/mtime/issues"
25 | depends: [
26 |   "ocaml" {>= "4.08.0"}
27 |   "ocamlfind" {build}
28 |   "ocamlbuild" {build & != "0.9.0"}
29 |   "topkg" {build & >= "1.0.3"}
30 | ]
31 | build: ["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]
32 | dev-repo: "git+https://erratique.ch/repos/mtime.git"
33 | 


--------------------------------------------------------------------------------
/src/mtime_top_init.ml:
--------------------------------------------------------------------------------
 1 | (*---------------------------------------------------------------------------
 2 |    Copyright (c) 2015 The mtime programmers. All rights reserved.
 3 |    Distributed under the ISC license, see terms at the end of the file.
 4 |   ---------------------------------------------------------------------------*)
 5 | 
 6 | #install_printer Mtime.pp;;
 7 | #install_printer Mtime.Span.pp;;
 8 | 
 9 | (*---------------------------------------------------------------------------
10 |    Copyright (c) 2015 The mtime programmers
11 | 
12 |    Permission to use, copy, modify, and/or distribute this software for any
13 |    purpose with or without fee is hereby granted, provided that the above
14 |    copyright notice and this permission notice appear in all copies.
15 | 
16 |    THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
17 |    WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
18 |    MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
19 |    ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
20 |    WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
21 |    ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
22 |    OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
23 |   ---------------------------------------------------------------------------*)
24 | 


--------------------------------------------------------------------------------
/src/mtime_top.ml:
--------------------------------------------------------------------------------
 1 | (*---------------------------------------------------------------------------
 2 |    Copyright (c) 2015 The mtime programmers. All rights reserved.
 3 |    Distributed under the ISC license, see terms at the end of the file.
 4 |   ---------------------------------------------------------------------------*)
 5 | 
 6 | let () = ignore (Toploop.use_file Format.err_formatter "mtime_top_init.ml")
 7 | 
 8 | (*---------------------------------------------------------------------------
 9 |    Copyright (c) 2015 The mtime programmers
10 | 
11 |    Permission to use, copy, modify, and/or distribute this software for any
12 |    purpose with or without fee is hereby granted, provided that the above
13 |    copyright notice and this permission notice appear in all copies.
14 | 
15 |    THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
16 |    WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
17 |    MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
18 |    ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
19 |    WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
20 |    ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
21 |    OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
22 |   ---------------------------------------------------------------------------*)
23 | 


--------------------------------------------------------------------------------
/myocamlbuild.ml:
--------------------------------------------------------------------------------
 1 | open Ocamlbuild_plugin
 2 | open Command
 3 | 
 4 | let os = try Sys.getenv "MTIME_OS" with
 5 | | Not_found -> Ocamlbuild_pack.My_unix.run_and_read "uname -s"
 6 | 
 7 | let system_support_lib = match os with
 8 | | "Linux\n" -> [A "-cclib"; A "-lrt"]
 9 | | _ -> []
10 | 
11 | let lib s =
12 |   match !Ocamlbuild_plugin.Options.ext_lib with
13 |   | "" -> s ^ ".a"
14 |   | x -> s ^ "." ^ x
15 | 
16 | let () =
17 |   dispatch begin function
18 |   | After_rules ->
19 | 
20 |       (* mtime *)
21 | 
22 |       ocaml_lib ~tag_name:"use_mtime" ~dir:"src" "src/mtime";
23 | 
24 |       (* mtime-clock-os *)
25 | 
26 |       flag_and_dep ["link"; "ocaml"; "link_mtime_clock_os_stubs"]
27 |         (P (lib "src-clock/libmtime_clock_stubs"));
28 | 
29 |       dep ["record_mtime_clock_os_stubs"]
30 |         [lib "src-clock/libmtime_clock_stubs"];
31 | 
32 |       flag ["library"; "ocaml"; "byte"; "record_mtime_clock_os_stubs"]
33 |         (S ([A "-dllib"; A "-lmtime_clock_stubs"] @ system_support_lib));
34 |       flag ["library"; "ocaml"; "record_mtime_clock_os_stubs"] (* byt + nat *)
35 |         (S ([A "-cclib"; A "-lmtime_clock_stubs"] @ system_support_lib));
36 | 
37 |       ocaml_lib ~tag_name:"use_mtime_clock_os" ~dir:"src-clock"
38 |         "src-clock/mtime_clock";
39 | 
40 |       flag ["link"; "ocaml"; "use_mtime_clock_os"]
41 |         (S [A "-ccopt"; A "-Lsrc-clock"]);
42 |   | _ -> ()
43 |   end
44 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | Mtime — Monotonic wall-clock time for OCaml
 2 | ===========================================
 3 | %%VERSION%%
 4 | 
 5 | Mtime has platform independent support for monotonic wall-clock time
 6 | in pure OCaml. This time increases monotonically and is not subject to
 7 | operating system calendar time adjustments. The library has types to
 8 | represent nanosecond precision timestamps and time spans.
 9 | 
10 | The additional Mtime_clock library provide access to a system
11 | monotonic clock.
12 | 
13 | Mtime has a no dependency. Mtime_clock depends on your system library
14 | or JavaScript runtime system. Mtime and its libraries are distributed
15 | under the ISC license.
16 | 
17 | Home page: <http://erratique.ch/software/mtime>  
18 | 
19 | # Installation
20 | 
21 | Mtime can be installed with `opam`:
22 | 
23 |     opam install mtime
24 | 
25 | If you don't use `opam` consult the [`opam`](opam) file for build
26 | instructions.
27 | 
28 | # Documentation
29 | 
30 | The documentation can be consulted [online] or via `odig doc mtime`.
31 | 
32 | Questions are welcome but better asked on the [OCaml forum] than on
33 | the issue tracker.
34 | 
35 | [online]: http://erratique.ch/software/mtime/doc/
36 | [OCaml forum]: https://discuss.ocaml.org/
37 | 
38 | # Sample programs
39 | 
40 | See [test/min_clock.ml](test/min_clock.ml).
41 | 
42 | If you installed mtime with `opam` sample programs are located in
43 | the directory `opam var mtime:doc`.
44 | 


--------------------------------------------------------------------------------
/src-clock/mtime_clock.ml:
--------------------------------------------------------------------------------
 1 | (*---------------------------------------------------------------------------
 2 |    Copyright (c) 2017 The mtime programmers. All rights reserved.
 3 |    Distributed under the ISC license, see terms at the end of the file.
 4 |   ---------------------------------------------------------------------------*)
 5 | 
 6 | (* Raw interface *)
 7 | 
 8 | external elapsed_ns : unit -> int64 = "ocaml_mtime_clock_elapsed_ns"
 9 | external now_ns : unit -> int64 = "ocaml_mtime_clock_now_ns"
10 | external period_ns : unit -> int64 option = "ocaml_mtime_clock_period_ns"
11 | 
12 | let () = ignore (elapsed_ns ()) (* Initalize elapsed_ns's origin. *)
13 | 
14 | (* Monotonic clock *)
15 | 
16 | let elapsed () = Mtime.Span.of_uint64_ns (elapsed_ns ())
17 | let now () = Mtime.of_uint64_ns (now_ns ())
18 | let period () = Mtime.Span.unsafe_of_uint64_ns_option (period_ns ())
19 | 
20 | (* Counters *)
21 | 
22 | type counter = int64
23 | let counter = elapsed_ns
24 | let count c = Mtime.Span.of_uint64_ns (Int64.sub (elapsed_ns ()) c)
25 | 
26 | (*---------------------------------------------------------------------------
27 |    Copyright (c) 2017 The mtime programmers
28 | 
29 |    Permission to use, copy, modify, and/or distribute this software for any
30 |    purpose with or without fee is hereby granted, provided that the above
31 |    copyright notice and this permission notice appear in all copies.
32 | 
33 |    THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
34 |    WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
35 |    MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
36 |    ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
37 |    WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
38 |    ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
39 |    OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
40 |   ---------------------------------------------------------------------------*)
41 | 


--------------------------------------------------------------------------------
/B0.ml:
--------------------------------------------------------------------------------
 1 | open B0_kit.V000
 2 | open Result.Syntax
 3 | 
 4 | (* OCaml library names *)
 5 | 
 6 | let compiler_libs_toplevel = B0_ocaml.libname "compiler-libs.toplevel"
 7 | 
 8 | let mtime = B0_ocaml.libname "mtime"
 9 | let mtime_top = B0_ocaml.libname "mtime.top"
10 | let mtime_clock = B0_ocaml.libname "mtime.clock"
11 | let mtime_clock_os = B0_ocaml.libname "mtime.clock.os"
12 | 
13 | (* Libraries *)
14 | 
15 | let mtime_lib =
16 |   let srcs = Fpath.[`File (v "src/mtime.mli"); `File (v "src/mtime.ml")] in
17 |   let requires = [] in
18 |   B0_ocaml.lib mtime ~doc:"The mtime library" ~srcs ~requires
19 | 
20 | let mtime_top =
21 |   let srcs = Fpath.[`File (v "src/mtime_top.ml")] in
22 |   let requires = [compiler_libs_toplevel] in
23 |   B0_ocaml.lib mtime_top ~doc:"The mtime.top library" ~srcs ~requires
24 | 
25 | let mtime_clock =
26 |   let srcs = Fpath.[`File (v "src/mtime_clock.mli")] in
27 |   let requires = [mtime] in
28 |   let doc = "The mtime.clock interface library" in
29 |   B0_ocaml.lib mtime_clock ~doc ~srcs ~requires
30 | 
31 | let mtime_clock_os_lib =
32 |   let srcs = Fpath.[`Dir (v "src-clock") ] in
33 |   let requires = [mtime] in
34 |   let doc = "The mtime.clock library (including JavaScript support)" in
35 |   B0_ocaml.lib mtime_clock_os ~doc ~srcs ~requires
36 | 
37 | (* Tests *)
38 | 
39 | let test =
40 |   let srcs = Fpath.[`File (v "test/test.ml"); `File (v "test/tests.ml")] in
41 |   let meta = B0_meta.(empty |> tag test) in
42 |   let requires = [ mtime; mtime_clock_os ] in
43 |   B0_ocaml.exe "test" ~doc:"Test suite" ~srcs ~meta ~requires
44 | 
45 | let min_clock =
46 |   let srcs = Fpath.[`File (v "test/min_clock.ml") ] in
47 |   let meta = B0_meta.(empty |> tag test) in
48 |   let requires = [mtime; mtime_clock_os] in
49 |   let doc = "Minimal clock example" in
50 |   B0_ocaml.exe "min-clock" ~doc ~srcs ~meta ~requires
51 | 
52 | (* FIXME b0 this forces the whole build to bytecode which is not
53 |    what we want.
54 | let min_clock_jsoo =
55 |   let srcs = Fpath.[`File (v "test/min_clock.ml") ] in
56 |   let meta = B0_meta.(empty |> tag test) in
57 |   let meta = B0_jsoo.meta ~requires:[mtime; mtime_clock_os] ~meta () in
58 |   let doc = "Minimal clock example" in
59 |   B0_jsoo.web "min-clock-jsoo" ~doc ~srcs ~meta
60 | *)
61 | 
62 | (* Packs *)
63 | 
64 | let default =
65 |   let meta =
66 |     let open B0_meta in
67 |     empty
68 |     |> tag B0_opam.tag
69 |     |> add authors ["The mtime programmers"]
70 |     |> add maintainers ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
71 |     |> add homepage "https://erratique.ch/software/mtime"
72 |     |> add online_doc "https://erratique.ch/software/mtime/doc/"
73 |     |> add licenses ["ISC"]
74 |     |> add repo "git+https://erratique.ch/repos/mtime.git"
75 |     |> add issues "https://github.com/dbuenzli/mtime/issues"
76 |     |> add description_tags
77 |       ["time"; "monotonic"; "system"; "org:erratique"]
78 |     |> add B0_opam.Meta.depends
79 |       [ "ocaml", {|>= "4.08.0"|};
80 |         "ocamlfind", {|build|};
81 |         "ocamlbuild", {|build & != "0.9.0"|};
82 |         "topkg", {|build & >= "1.0.3"|};
83 |       ]
84 |     |> add B0_opam.Meta.build
85 |       {|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]]|}
86 |   in
87 |   B0_pack.v "default" ~doc:"mtime package" ~meta ~locked:true @@
88 |   B0_unit.list ()
89 | 


--------------------------------------------------------------------------------
/src-clock/runtime.js:
--------------------------------------------------------------------------------
 1 | /*---------------------------------------------------------------------------
 2 |    Copyright (c) 2022 The mtime programmers. All rights reserved.
 3 |    Distributed under the ISC license, see license at the end of the file.
 4 |   ---------------------------------------------------------------------------*/
 5 | 
 6 | //Provides: ocaml_mtime_clock_period_ns
 7 | function ocaml_mtime_clock_period_ns (_unit) {
 8 |   return 0;
 9 | }
10 | 
11 | //Provides: mtime_clock_now
12 | //Requires: caml_int64_of_float, caml_int64_mul
13 | //Requires: caml_raise_sys_error
14 | function find_performance_obj () {
15 |   var test = function (o)
16 |   { return (o && o.performance && typeof o.performance.now == "function");};
17 | 
18 |   if (test (globalThis)) { return globalThis.performance; };
19 |   if (test (globalThis.perf_hooks)){ return globalThis.perf_hooks.performance;};
20 |   if (typeof require == "function") {
21 |     var ph = require ("perf_hooks");
22 |     if (test (ph)) { return ph.performance; }
23 |   }
24 |   var obj = { now: function ()
25 |               { caml_raise_sys_error ("performance.now () is not available");}}
26 |   return obj;
27 | }
28 | var performance_obj = find_performance_obj ();
29 | function mtime_clock_now () {
30 |   /* Conversion of DOMHighResTimeStamp to uint64 nanosecond timestamps.
31 | 
32 |      The spec https://www.w3.org/TR/hr-time-3 says DOMHighResTimeStamp
33 |      are double milliseconds that *should* be accurate to 5 microseconds.
34 |      We simply assume we have microsecond precision and multiply the
35 |      stamps given by performance.now () by 1e3 to get double microseconds.
36 | 
37 |      We then use Int64.of_float on these double microseconds to get an
38 |      uint64 in microseconds. This works in practice for the following
39 |      reasons. Let us assume we have the largest integer microsecond
40 |      timestamp representable exactly in double, i.e. 2^53 :
41 | 
42 |      1) Assuming the zero of performance.now is when the tab is created,
43 |         our 2^53 timestamp only occurs after:
44 | 
45 |         2^53 / 1_000_000 / (24 * 3600 * 365.25) ≅ 285.4 Julian years
46 | 
47 |      2) 2^53 < Int64.max_int = 2^63 - 1, so seing the result of
48 |         Int64.of_float as unsigned for this timestamp is correct and in
49 |         the defined domain of the conversion function (the truncated float
50 |         must lie in [Int64.min_int;Int64.max_int] for defined behaviour).
51 | 
52 |         So the Int64.of_float conversion is unlikely to be problematic and
53 |         we simply bring the resulting uint64 microsecond to an uint64
54 |         nanosecond by multiplying by 1000L, which for 2^53 microseconds
55 |         remains smaller than Int64.max_int, yielding a correct uint64
56 |         nanosecond timestamp for a reasonable time range. */
57 | 
58 |   var now_us = performance_obj.now () * 1e3;
59 |   var now_ns = caml_int64_mul (caml_int64_of_float (now_us),
60 |                                caml_int64_of_float (1000));
61 |   return now_ns;
62 | }
63 | 
64 | //Provides: ocaml_mtime_clock_now_ns
65 | //Requires: mtime_clock_now
66 | function ocaml_mtime_clock_now_ns (_unit) {
67 |   return mtime_clock_now ();
68 | }
69 | 
70 | //Provides: ocaml_mtime_clock_elapsed_ns
71 | //Requires: caml_int64_sub, mtime_clock_now
72 | var mtime_clock_start;
73 | function ocaml_mtime_clock_elapsed_ns (_unix) {
74 |   if (!mtime_clock_start) mtime_clock_start = mtime_clock_now ();
75 |   var now = mtime_clock_now ();
76 |   return caml_int64_sub (now, mtime_clock_start);
77 | }
78 | 
79 | /*---------------------------------------------------------------------------
80 |    Copyright (c) 2022 The mtime programmers
81 | 
82 |    Permission to use, copy, modify, and/or distribute this software for any
83 |    purpose with or without fee is hereby granted, provided that the above
84 |    copyright notice and this permission notice appear in all copies.
85 | 
86 |    THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
87 |    WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
88 |    MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
89 |    ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
90 |    WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
91 |    ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
92 |    OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
93 |   ---------------------------------------------------------------------------*/
94 | 


--------------------------------------------------------------------------------
/CHANGES.md:
--------------------------------------------------------------------------------
  1 | v2.0.0 2022-12-02 Zagreb
  2 | ------------------------
  3 | 
  4 | * Use the new `js_of_ocaml` ocamlfind `META` standard to link JavaScript
  5 |   stubs (#28).
  6 | * `Mtime_clock` use `CLOCK_BOOTTIME` rather than `CLOCK_MONOTONIC`
  7 |   on Linux and `mach_continuous_time` rather than `mach_absolute_time`
  8 |   on macOS. This means that on these platforms sleep time is taken 
  9 |   into account (#10). Thanks to Bikal Lem for the patch.
 10 | * Add `Mtime.{to,of}_float_ns`.
 11 | * Remove deprecated values `Mtime.s_to_*` and `Mtime.Span.to_*` floating
 12 |   points functions. Note that the implementation of `Mtime.Span.to_*`
 13 |   functions was broken if your span exceeded `Int64.max_int`. Thanks
 14 |   to Thomas Leonard for the report (#46).
 15 | * Change implementation of `Mtime.Span.pp` and remove
 16 |   `Mtime.Span.pp_float_s`. The implementation no longer uses floating
 17 |   point arithmetic and always over approximates the result, no
 18 |   duration is printed shorter than it is. The output is no longer
 19 |   US-ASCII but UTF-8 encoded since U+03BC is used for µs.
 20 | * Stop installing the clock interface in `mtime.clock`, this package
 21 |   is now empty (#42).
 22 | 
 23 | v1.4.0 2022-02-17 La Forclaz (VS)
 24 | ---------------------------------
 25 | 
 26 | * Change the `js_of_ocaml` strategy for `Mtime_clock`'s JavaScript
 27 |   implementation. Primitives of `mtime.clock.os` are now implemented
 28 |   in pure JavaScript and linked by `js_of_ocaml`.  This means that the
 29 |   `mtime.clock.jsoo` library no longer exists, simply link against
 30 |   `mtime.clock.os` instead. Thanks to Hugo Heuzard for suggesting and
 31 |   implementing this.
 32 | 
 33 | * Add `Mtime.{min,max}_stamp`.
 34 | * Add durations `Mtime.Span.{ns,us,ms,s,min,hour,day,year}` and 
 35 |   the `Mtime.Span.(*)` operator (#28).
 36 | * Deprecate `Mtime.s_to_*` and `Mtime.*_to_s` floating point constants (#28).
 37 | * Require OCaml >= 4.08.
 38 | * Allow compiling with MSVC compiler. Thanks to Jonah Beckford for the patch.
 39 | 
 40 | v1.3.0 2021-10-20 Zagreb
 41 | ------------------------
 42 | 
 43 | * Add Windows support. Thanks to Andreas Hauptmann for the patch 
 44 |   and Corentin Leruth for the integration.
 45 | 
 46 | v1.2.0 2019-07-19 Zagreb
 47 | ------------------------
 48 | 
 49 | * Add support for node.js. Thanks to Fabian (@copy) for the patch.
 50 | * Support for js_of_ocaml 3.4.0.
 51 | * Add MTIME_OS environment variable for specifying the OS at build time.
 52 | 
 53 | v1.1.0 2017-06-24 London
 54 | ------------------------
 55 | 
 56 | * Add `Mtime.Span.{add,zero,one,min_span,max_span}`.
 57 | 
 58 | v1.0.0 2017-05-09 La Forclaz (VS)
 59 | ---------------------------------
 60 | 
 61 | This is a major breaking release with a new API. Thanks to David
 62 | Sheets for contributions and discussions. The API was changed to
 63 | mirror and follow the conventions and design of `Ptime`. The `Mtime`
 64 | module now only provides platform independent datatypes for supporting
 65 | monotonic clock readings. Platform dependent access to monotonic
 66 | clocks is provided by the `Mtime_clock` modules. The `Mtime.t` type
 67 | was added for monotonic timestamps.
 68 | 
 69 | * Rename packages `mtime.{jsoo,os}` to `mtime.{clock.jsoo,clock.os}`
 70 |   which implement the new `Mtime_clock` interface. The `mtime` package
 71 |   has the platform independent support.
 72 | * Remove `Mtime.available`, `Mtime_clock` functions now raise `Sys_error`
 73 |   on unsupported platforms or errors.
 74 | * Add a raw interface to `Mtime_clock` which statisfies MirageOS's monotonic
 75 |   clock signature.
 76 | * Move `Mtime.{elapsed,counter,count}` to
 77 |   `Mtime_clock.{elapsed,counter,count}`.
 78 | * Add `Mtime.t` a type to represent system-relative monotonic
 79 |   timestamps and related functions. Thanks to David Sheets for the
 80 |   patch and his patience.
 81 | * Add the `Mtime.Span` module for functions on monotonic time
 82 |   spans. Most of the previous platform independent support is now
 83 |   provided by this module. See below.
 84 | * Move `Mtime.to_ns_uint64` to `Mtime.Span.to_uint64_ns`.
 85 | * Move other `Mtime.to_*` to `Mtime.Span.to_*`.
 86 | * Move `Mtime.pp_span[_s]` to `Mtime.Span.pp[_float__s]`.
 87 | * Add `Mtime.Span.{compare,equal}`. Thanks to David Sheets for the patch.
 88 | * Add `Mtime.Span.of_uint64_ns`. Thanks to David Sheets for the patch.
 89 | 
 90 | v0.8.4 2017-02-05 La Forclaz (VS)
 91 | ---------------------------------
 92 | 
 93 | * Fix package for -custom linking. Thanks to @orbitz for the report.
 94 | * Build depend on topkg.
 95 | * Relicense from BSD3 to ISC.
 96 | 
 97 | v0.8.3 2015-12-22 Cambridge (UK)
 98 | --------------------------------
 99 | 
100 | * Fix Linux bytecode builds. Thanks to Edwin Török for the report.
101 | * Really make js_of_ocaml an optional dependency.
102 | 
103 | 
104 | v0.8.2 2015-05-17 La Forclaz (VS)
105 | ---------------------------------
106 | 
107 | * Simpler toploop support (internal change).
108 | * Improve Linux build support by recording link flags against librt in
109 |   the cma and cmxa (this seems to be needed in certain distributions).
110 |   Thanks to David Scott for the report and the fix.
111 | 
112 | 
113 | v0.8.1 2015-03-23 La Forclaz (VS)
114 | ---------------------------------
115 | 
116 | * Fix broken arithmetic on 32-bit platform with POSIX clocks. Thanks to
117 |   Stephen Dolan for the report and the fix.
118 | 
119 | 
120 | v0.8.0 2015-03-19 La Forclaz (VS)
121 | ---------------------------------
122 | 
123 | First release.
124 | 


--------------------------------------------------------------------------------
/src/mtime_clock.mli:
--------------------------------------------------------------------------------
  1 | (*---------------------------------------------------------------------------
  2 |    Copyright (c) 2017 The mtime programmers. All rights reserved.
  3 |    Distributed under the ISC license, see terms at the end of the file.
  4 |   ---------------------------------------------------------------------------*)
  5 | 
  6 | (** Monotonic time clock.
  7 | 
  8 |     [Mtime_clock] provides access to a system monotonic clock. This
  9 |     time increases monotonically and is not subject to operating
 10 |     system calendar time adjustments.
 11 | 
 12 |     Only use {!Mtime_clock.now} if you need inter-process time
 13 |     correlation, otherwise prefer {!Mtime_clock.elapsed} and
 14 |     {{!Mtime_clock.counters}counters}.
 15 | 
 16 |     Consult important information about {{!err}error handling}
 17 |     and {{!platform_support}platform support}. *)
 18 | 
 19 | (** {1:clock Monotonic clock} *)
 20 | 
 21 | val elapsed : unit -> Mtime.span
 22 | (** [elapsed ()] is the monotonic time span elapsed since the
 23 |     beginning of the program.
 24 | 
 25 |     Raises {!Sys_error}, see {{!err}error handling} *)
 26 | 
 27 | val now : unit -> Mtime.t
 28 | (** [now ()] is the current system-relative monotonic timestamp. Its
 29 |     absolute value is meaningless.
 30 | 
 31 |     Raises {!Sys_error}, see {{!err}error handling} *)
 32 | 
 33 | val period : unit -> Mtime.span option
 34 | (** [period ()] is the clock's period as a monotonic time span (if
 35 |     available). *)
 36 | 
 37 | (** {1:counters Time counters} *)
 38 | 
 39 | type counter
 40 | (** The type for monotonic wall-clock time counters. *)
 41 | 
 42 | val counter : unit -> counter
 43 | (** [counter ()] is a counter counting from now on.
 44 | 
 45 |     Raises {!Sys_error}, see {{!err}error handling} *)
 46 | 
 47 | val count : counter -> Mtime.span
 48 | (** [count c] is the monotonic time span elapsed since [c] was created. *)
 49 | 
 50 | (** {1:raw Monotonic clock raw interface} *)
 51 | 
 52 | val elapsed_ns : unit -> int64
 53 | (** [elapsed_ns ()] is the {e unsigned} 64-bit integer nanosecond monotonic
 54 |      time span elapsed since the beginning of the program.
 55 | 
 56 |     Raises {!Sys_error}, see {{!err}error handling} *)
 57 | 
 58 | val now_ns : unit -> int64
 59 | (** [now_ns ()] is an {e unsigned} 64-bit integer nanosecond
 60 |      system-relative monotonic timestamp. The absolute value is
 61 |      meaningless.
 62 | 
 63 |     Raises {!Sys_error}, see {{!err}error handling} *)
 64 | 
 65 | val period_ns : unit -> int64 option
 66 | (** [period_ns ()] is the clock's period as an {e unsigned} 64-bit
 67 |     integer nanosecond monotonic time span (if available). *)
 68 | 
 69 | (** {1:err Error handling}
 70 | 
 71 |     The functions {!elapsed}, {!now}, {!val-counter}, {!elapsed_ns} and
 72 |     {!now_ns} raise [Sys_error] whenever they can't determine the
 73 |     current time or that it doesn't fit in [Mtime]'s range. Usually
 74 |     this exception should only be catched at the toplevel of your
 75 |     program to log it and abort the program. It indicates a serious
 76 |     error condition in the system.
 77 | 
 78 |     All the other functions, whose functionality is less essential,
 79 |     simply silently return [None] if they can't determine the
 80 |     information either because it is unavailable or because an error
 81 |     occured.
 82 | 
 83 |     {1:platform_support Platform support}
 84 | 
 85 |     {ul
 86 |     {- Linux uses {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/clock_gettime.html}[clock_gettime]}
 87 |        with {{:https://www.man7.org/linux/man-pages/man3/clock_settime.3.html}
 88 |        CLOCK_BOOTTIME}. This means that sleep time is taken into account.}
 89 |     {- Platforms with a POSIX clock use
 90 |        {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/clock_gettime.html}[clock_gettime]}
 91 |        with CLOCK_MONOTONIC.}
 92 |     {- Darwin uses
 93 |        {{:https://developer.apple.com/documentation/kernel/1646199-mach_continuous_time}[mach_continous_time]}.
 94 |        This means that sleep time is taken into account.}
 95 |     {- Windows uses
 96 |        {{:https://msdn.microsoft.com/en-us/library/windows/desktop/aa373083%28v=vs.85%29.aspx}Performance counters}. }
 97 |     {- JavaScript uses
 98 |        {{:http://www.w3.org/TR/hr-time/}[performance.now]} (consult
 99 |        {{:http://caniuse.com/#feat=high-resolution-time}availability})
100 |        which returns a
101 |        {{:http://www.w3.org/TR/hr-time/#sec-DOMHighResTimeStamp}double
102 |        floating point value} in milliseconds with
103 |        resolution up to the microsecond.}
104 |     {- JavaScript running on Node.js uses the built-in
105 |        {{:https://nodejs.org/api/perf_hooks.html#perf_hooks_performance_now}[perf_hooks]}
106 |        module, which provides an interface compatible to the [performance]
107 |        module in browsers.}}
108 | *)
109 | 
110 | 
111 | (*---------------------------------------------------------------------------
112 |    Copyright (c) 2017 The mtime programmers
113 | 
114 |    Permission to use, copy, modify, and/or distribute this software for any
115 |    purpose with or without fee is hereby granted, provided that the above
116 |    copyright notice and this permission notice appear in all copies.
117 | 
118 |    THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
119 |    WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
120 |    MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
121 |    ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
122 |    WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
123 |    ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
124 |    OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
125 |   ---------------------------------------------------------------------------*)
126 | 


--------------------------------------------------------------------------------
/src/mtime.ml:
--------------------------------------------------------------------------------
  1 | (*---------------------------------------------------------------------------
  2 |    Copyright (c) 2015 The mtime programmers. All rights reserved.
  3 |    Distributed under the ISC license, see terms at the end of the file.
  4 |   ---------------------------------------------------------------------------*)
  5 | 
  6 | (* Time spans
  7 | 
  8 |    Time spans are in nanoseconds and we represent them by an unsigned
  9 |    64-bit integer. This allows to represent spans for:
 10 |    (2^64-1) / 1_000_000_000 / (24 * 3600 * 365.25) ≅ 584.5 Julian years *)
 11 | 
 12 | type span = int64 (* unsigned nanoseconds *)
 13 | 
 14 | module Span = struct
 15 |   type t = span
 16 |   let zero = 0L
 17 |   let one = 1L
 18 |   let min_span = zero
 19 |   let max_span = -1L
 20 | 
 21 |   (* Predicates *)
 22 | 
 23 |   let equal = Int64.equal
 24 |   let compare = Int64.unsigned_compare
 25 | 
 26 |   (* Arithmetic *)
 27 | 
 28 |   let add = Int64.add
 29 |   let abs_diff s0 s1 =
 30 |     if compare s0 s1 < 0 then Int64.sub s1 s0 else Int64.sub s0 s1
 31 | 
 32 |   (* Durations *)
 33 | 
 34 |   let ( * ) n s = Int64.mul (Int64.of_int n) s
 35 |   let ns   =                      1L
 36 |   let us   =                  1_000L
 37 |   let ms   =              1_000_000L
 38 |   let s    =          1_000_000_000L
 39 |   let min  =         60_000_000_000L
 40 |   let hour =       3600_000_000_000L
 41 |   let day  =      86400_000_000_000L
 42 |   let year = 31_557_600_000_000_000L
 43 | 
 44 |   (* Converting *)
 45 | 
 46 |   let to_uint64_ns s = s
 47 |   let of_uint64_ns ns = ns
 48 | 
 49 |   let max_float_int = 9007199254740992. (* 2^53. *)
 50 |   let int64_min_int_float = Int64.to_float Int64.min_int
 51 |   let int64_max_int_float = Int64.to_float Int64.max_int
 52 | 
 53 |   let of_float_ns sf =
 54 |     if sf < 0. || sf >= max_float_int || not (Float.is_finite sf)
 55 |     then None else Some (Int64.of_float sf)
 56 | 
 57 |   let to_float_ns s =
 58 |     if Int64.compare 0L s <= 0 then Int64.to_float s else
 59 |     int64_max_int_float +. (-. int64_min_int_float +. Int64.to_float s)
 60 | 
 61 |   let unsafe_of_uint64_ns_option nsopt = nsopt
 62 | 
 63 |   (* Formatting *)
 64 | 
 65 |   let pf = Format.fprintf
 66 | 
 67 |   let rec pp_si_span unit_str unit_str_len si_unit si_higher_unit ppf span =
 68 |     let geq x y = Int64.unsigned_compare x y >= 0 in
 69 |     let m = Int64.unsigned_div span si_unit in
 70 |     let n = Int64.unsigned_rem span si_unit in
 71 |     let pp_unit ppf () = Format.pp_print_as ppf unit_str_len unit_str in
 72 |     match m with
 73 |     | m when geq m 100L -> (* No fractional digit *)
 74 |         let m_up = if Int64.equal n 0L then m else Int64.succ m in
 75 |         let span' = Int64.mul m_up si_unit in
 76 |         if geq span' si_higher_unit then pp ppf span' else
 77 |         (pf ppf "%Ld" m_up; pp_unit ppf ())
 78 |     | m when geq m 10L -> (* One fractional digit w.o. trailing zero *)
 79 |         let f_factor = Int64.unsigned_div si_unit 10L in
 80 |         let f_m = Int64.unsigned_div n f_factor in
 81 |         let f_n = Int64.unsigned_rem n f_factor in
 82 |         let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in
 83 |         begin match f_m_up with
 84 |         | 0L -> pf ppf "%Ld" m; pp_unit ppf ()
 85 |         | f when geq f 10L ->
 86 |             pp ppf Int64.(add (mul m si_unit) (mul f f_factor))
 87 |         | f -> pf ppf "%Ld.%Ld" m f; pp_unit ppf ()
 88 |         end
 89 |     | m -> (* Two or zero fractional digits w.o. trailing zero *)
 90 |         let f_factor = Int64.unsigned_div si_unit 100L in
 91 |         let f_m = Int64.unsigned_div n f_factor in
 92 |         let f_n = Int64.unsigned_rem n f_factor in
 93 |         let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in
 94 |         match f_m_up with
 95 |         | 0L -> pf ppf "%Ld" m; pp_unit ppf ()
 96 |         | f when geq f 100L ->
 97 |             pp ppf Int64.(add (mul m si_unit) (mul f f_factor))
 98 |         | f when Int64.equal (Int64.rem f 10L) 0L ->
 99 |             pf ppf "%Ld.%Ld" m (Int64.div f 10L); pp_unit ppf ()
100 |         | f ->
101 |             pf ppf "%Ld.%02Ld" m f; pp_unit ppf ()
102 | 
103 |   and pp_non_si unit_str unit unit_lo_str unit_lo unit_lo_size ppf span =
104 |     let geq x y = Int64.unsigned_compare x y >= 0 in
105 |     let m = Int64.unsigned_div span unit in
106 |     let n = Int64.unsigned_rem span unit in
107 |     if Int64.equal n 0L then pf ppf "%Ld%s" m unit_str else
108 |     let f_m = Int64.unsigned_div n unit_lo in
109 |     let f_n = Int64.unsigned_rem n unit_lo in
110 |     let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in
111 |     match f_m_up with
112 |     | f when geq f unit_lo_size ->
113 |         pp ppf Int64.(add (mul m unit) (mul f unit_lo))
114 |     | f ->
115 |         pf ppf "%Ld%s%Ld%s" m unit_str f unit_lo_str
116 | 
117 |   and pp ppf span =
118 |     let geq x y = Int64.unsigned_compare x y >= 0 in
119 |     let lt x y = Int64.unsigned_compare x y = -1 in
120 |     match span with
121 |     | sp when lt sp us -> pf ppf "%Ldns" sp
122 |     | sp when lt sp ms -> pp_si_span "\xCE\xBCs" 2 us ms ppf sp
123 |     | sp when lt sp s -> pp_si_span "ms" 2 ms s ppf sp
124 |     | sp when lt sp min -> pp_si_span "s" 1 s min ppf sp
125 |     | sp when lt sp hour -> pp_non_si "min" min "s" s 60L ppf sp
126 |     | sp when lt sp day -> pp_non_si "h" hour "min" min 60L ppf sp
127 |     | sp when lt sp year -> pp_non_si "d" day "h" hour 24L ppf sp    | sp ->
128 |         let m = Int64.unsigned_div sp year in
129 |         let n = Int64.unsigned_rem sp year in
130 |         if Int64.equal n 0L then pf ppf "%Lda" m else
131 |         let f_m = Int64.unsigned_div n day in
132 |         let f_n = Int64.unsigned_rem n day in
133 |         let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in
134 |         match f_m_up with
135 |         | f when geq f 366L -> pf ppf "%Lda" (Int64.succ m)
136 |         | f -> pf ppf "%Lda%Ldd" m f
137 | 
138 |   let dump ppf s = Format.fprintf ppf "%Lu" s
139 | end
140 | 
141 | (* Monotonic timestamps *)
142 | 
143 | type t = int64
144 | 
145 | let to_uint64_ns s = s
146 | let of_uint64_ns ns = ns
147 | let min_stamp = 0L
148 | let max_stamp = -1L
149 | 
150 | (* Predicates *)
151 | 
152 | let equal = Int64.equal
153 | let compare = Int64.unsigned_compare
154 | let is_earlier t ~than = compare t than < 0
155 | let is_later t ~than = compare t than > 0
156 | 
157 | (* Arithmetic *)
158 | 
159 | let span t0 t1 = if compare t0 t1 < 0 then Int64.sub t1 t0 else Int64.sub t0 t1
160 | 
161 | let add_span t s =
162 |   let sum = Int64.add t s in
163 |   if compare t sum <= 0 then Some sum else None
164 | 
165 | let sub_span t s =
166 |   if compare t s < 0 then None else Some (Int64.sub t s)
167 | 
168 | (* Formatters *)
169 | 
170 | let pp ppf ns = Format.fprintf ppf "%Luns" ns
171 | let dump ppf ns = Format.fprintf ppf "%Lu" ns
172 | 
173 | (*---------------------------------------------------------------------------
174 |    Copyright (c) 2015 The mtime programmers
175 | 
176 |    Permission to use, copy, modify, and/or distribute this software for any
177 |    purpose with or without fee is hereby granted, provided that the above
178 |    copyright notice and this permission notice appear in all copies.
179 | 
180 |    THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
181 |    WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
182 |    MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
183 |    ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
184 |    WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
185 |    ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
186 |    OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
187 |   ---------------------------------------------------------------------------*)
188 | 


--------------------------------------------------------------------------------
/src-clock/mtime_clock_stubs.c:
--------------------------------------------------------------------------------
  1 | /*---------------------------------------------------------------------------
  2 |    Copyright (c) 2015 The mtime programmers. All rights reserved.
  3 |    Distributed under the ISC license, see license at the end of the file.
  4 |   ---------------------------------------------------------------------------*/
  5 | 
  6 | #include <caml/mlvalues.h>
  7 | #include <caml/alloc.h>
  8 | #include <caml/memory.h>
  9 | #include <caml/fail.h>
 10 | 
 11 | #include <stdint.h>
 12 | 
 13 | #define Val_none Val_int(0)
 14 | #define OCAML_MTIME_RAISE_SYS_ERROR(ERR)                               \
 15 |   do { caml_raise_sys_error (caml_copy_string("Mtime_clock: " ERR)); } \
 16 |   while (0)
 17 | 
 18 | /* Detect platform */
 19 | 
 20 | #if defined(__APPLE__) && defined(__MACH__)
 21 |   #define OCAML_MTIME_DARWIN
 22 | 
 23 | #elif defined(__unix__) || defined(__unix)
 24 |  #include <unistd.h>
 25 |  #if defined(__linux__)
 26 |    #define OCAML_MTIME_LINUX
 27 |  #endif
 28 |  #if defined(_POSIX_VERSION)
 29 |    #define OCAML_MTIME_POSIX
 30 |  #endif
 31 | #elif defined(_WIN32)
 32 | #define OCAML_MTIME_WINDOWS
 33 | #endif
 34 | 
 35 | /* Darwin */
 36 | 
 37 | #if defined(OCAML_MTIME_DARWIN)
 38 | 
 39 | #include <mach/mach_time.h>
 40 | 
 41 | static mach_timebase_info_data_t scale = {0};
 42 | 
 43 | void ocaml_mtime_clock_init_scale (void)
 44 | {
 45 |   if (mach_timebase_info (&scale) != KERN_SUCCESS)
 46 |     OCAML_MTIME_RAISE_SYS_ERROR ("mach_timebase_info () failed");
 47 | 
 48 |   if (scale.denom == 0)
 49 |     OCAML_MTIME_RAISE_SYS_ERROR ("mach_timebase_info_data.denom is 0");
 50 | }
 51 | 
 52 | CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit)
 53 | {
 54 |   static uint64_t start = 0L;
 55 |   if (start == 0L) { start = mach_continuous_time (); }
 56 |   if (scale.denom == 0) { ocaml_mtime_clock_init_scale (); }
 57 |   uint64_t now = mach_continuous_time ();
 58 |   return caml_copy_int64 (((now - start) * scale.numer) / scale.denom);
 59 | }
 60 | 
 61 | CAMLprim value ocaml_mtime_clock_now_ns (value unit)
 62 | {
 63 |   if (scale.denom == 0) { ocaml_mtime_clock_init_scale (); }
 64 |   uint64_t now = mach_continuous_time ();
 65 |   return caml_copy_int64 ((now * scale.numer) / scale.denom);
 66 | }
 67 | 
 68 | CAMLprim value ocaml_mtime_clock_period_ns (value unit)
 69 | { return Val_none; }
 70 | 
 71 | /* POSIX */
 72 | 
 73 | #elif defined(OCAML_MTIME_POSIX)
 74 | 
 75 | #include <time.h>
 76 | 
 77 | CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit)
 78 | {
 79 |   static struct timespec start = {0};
 80 |   struct timespec now;
 81 |   clockid_t clockid;
 82 | 
 83 | #if defined(OCAML_MTIME_LINUX)
 84 |   clockid = CLOCK_BOOTTIME;
 85 | #else
 86 |   clockid = CLOCK_MONOTONIC;
 87 | #endif
 88 | 
 89 |   if (start.tv_sec == 0)
 90 |   {
 91 |     if (clock_gettime (clockid, &start))
 92 |       OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
 93 |   }
 94 | 
 95 |   if (clock_gettime (clockid, &now))
 96 |     OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
 97 | 
 98 |   return caml_copy_int64 ((uint64_t)(now.tv_sec - start.tv_sec) *
 99 |                           (uint64_t)1000000000 +
100 |                           (uint64_t)(now.tv_nsec - start.tv_nsec));
101 | }
102 | 
103 | CAMLprim value ocaml_mtime_clock_now_ns (value unit)
104 | {
105 |   struct timespec now;
106 | 
107 |   if (clock_gettime (CLOCK_MONOTONIC, &now))
108 |     OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
109 | 
110 |   return caml_copy_int64 ((uint64_t)(now.tv_sec) *
111 |                           (uint64_t)1000000000 +
112 |                           (uint64_t)(now.tv_nsec));
113 | }
114 | 
115 | CAMLprim value ocaml_mtime_clock_period_ns (value unit)
116 | {
117 |   CAMLparam1 (unit);
118 |   CAMLlocal1 (some);
119 |   struct timespec res;
120 | 
121 |   if (clock_getres (CLOCK_MONOTONIC, &res)) { CAMLreturn (Val_none); }
122 | 
123 |   /* We only handle valid timespec structs as per POSIX def (§2.8.5 in 2013) */
124 |   if (res.tv_nsec < 0 || res.tv_nsec > 999999999) CAMLreturn (Val_none);
125 | 
126 |   /* Negative periods are dubious */
127 |   if (res.tv_sec < 0) CAMLreturn (Val_none);
128 | 
129 |   some = caml_alloc (1, 0);
130 |   Store_field (some, 0,
131 |                caml_copy_int64 ((uint64_t)(res.tv_sec) *
132 |                                 (uint64_t)1000000000 +
133 |                                 (uint64_t)(res.tv_nsec)));
134 |   CAMLreturn (some);
135 | }
136 | 
137 | #elif defined(OCAML_MTIME_WINDOWS)
138 | #define WIN32_LEAN_AND_MEAN
139 | #include <windows.h>
140 | 
141 | static double performance_frequency;
142 | static void set_performance_frequency(void)
143 | {
144 |   LARGE_INTEGER t_freq;
145 |   if (!QueryPerformanceFrequency(&t_freq)) {
146 |     OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
147 |   }
148 |   performance_frequency = (1000000000.0 / t_freq.QuadPart);
149 | }
150 | 
151 | CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit)
152 | {
153 |   (void) unit;
154 |   static LARGE_INTEGER start;
155 |   if (performance_frequency == 0.0) {
156 |     set_performance_frequency();
157 |   }
158 |   if ( start.QuadPart == 0 )
159 |   {
160 |     if (!QueryPerformanceCounter(&start)) {
161 |       OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
162 |     }
163 |   }
164 |   static LARGE_INTEGER now;
165 |   if ( !QueryPerformanceCounter(&now)) {
166 |     OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
167 |   }
168 |   uint64_t ret = (now.QuadPart - start.QuadPart) * performance_frequency;
169 |   return caml_copy_int64(ret);
170 | }
171 | 
172 | CAMLprim value ocaml_mtime_clock_now_ns (value unit)
173 | {
174 |   (void) unit;
175 |   if (performance_frequency == 0.0) {
176 |     set_performance_frequency();
177 |   }
178 |   static LARGE_INTEGER now;
179 |   if ( !QueryPerformanceCounter(&now)) {
180 |     OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
181 |   }
182 |   uint64_t ret = now.QuadPart * performance_frequency;
183 |   return caml_copy_int64(ret);
184 | }
185 | 
186 | CAMLprim value ocaml_mtime_clock_period_ns (value unit)
187 | {
188 |   (void) unit;
189 |   if (performance_frequency == 0.0) {
190 |     set_performance_frequency();
191 |   }
192 |   if ( performance_frequency <= 0.0 ) {
193 |     return Val_none;
194 |   }
195 |   value ret;
196 |   value p = caml_copy_int64(performance_frequency);
197 |   Begin_roots1(p);
198 |   ret = caml_alloc_small(1,0);
199 |   Field(ret,0) = p;
200 |   End_roots();
201 |   return ret;
202 | }
203 | 
204 | 
205 | /* Unsupported */
206 | 
207 | #else
208 | 
209 | #warning OCaml Mtime_clock module: unsupported platform
210 | 
211 | CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit)
212 | { OCAML_MTIME_RAISE_SYS_ERROR ("unsupported platform"); }
213 | 
214 | CAMLprim value ocaml_mtime_clock_now_ns (value unit)
215 | { OCAML_MTIME_RAISE_SYS_ERROR ("unsupported platform"); }
216 | 
217 | CAMLprim value ocaml_mtime_clock_period_ns (value unit)
218 | { OCAML_MTIME_RAISE_SYS_ERROR ("unsupported platform"); }
219 | 
220 | #endif
221 | 
222 | /*---------------------------------------------------------------------------
223 |    Copyright (c) 2015 The mtime programmers
224 | 
225 |    Permission to use, copy, modify, and/or distribute this software for any
226 |    purpose with or without fee is hereby granted, provided that the above
227 |    copyright notice and this permission notice appear in all copies.
228 | 
229 |    THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
230 |    WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
231 |    MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
232 |    ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
233 |    WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
234 |    ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
235 |    OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
236 |   ---------------------------------------------------------------------------*/
237 | 


--------------------------------------------------------------------------------
/src/mtime.mli:
--------------------------------------------------------------------------------
  1 | (*---------------------------------------------------------------------------
  2 |    Copyright (c) 2015 The mtime programmers. All rights reserved.
  3 |    Distributed under the ISC license, see terms at the end of the file.
  4 |   ---------------------------------------------------------------------------*)
  5 | 
  6 | (** Monotonic time values.
  7 | 
  8 |     [Mtime] has platform independent support for monotonic wall-clock
  9 |     time. This time increases monotonically and is not subject to
 10 |     operating system calendar time adjustments.
 11 | 
 12 |     {{!spans}Time spans} represent non-negative monotonic time spans
 13 |     between two monotonic clock readings. {{!timestamps}Timestamps}
 14 |     represent system-relative monotonic {e timestamps}, their absolute
 15 |     value is meaningless but they can be compared across the processes
 16 |     of an operating system run.
 17 | 
 18 |     {!Mtime_clock} provides access to a system monotonic clock. *)
 19 | 
 20 | (** {1:spans Monotonic time spans} *)
 21 | 
 22 | type span
 23 | (** The type for non-negative monotonic time spans. They represent the
 24 |     difference between two monotonic clock readings. If the platform's
 25 |     clock has nanosecond resolution the representation guarantees that
 26 |     the function {!Mtime_clock.elapsed} can measure up to
 27 |     approximatively 584 Julian year spans before silently rolling over
 28 |     (unlikely since this is in a single program run). *)
 29 | 
 30 | (** Monotonic time spans. *)
 31 | module Span : sig
 32 | 
 33 |   (** {1:spans Monotonic time spans} *)
 34 | 
 35 |   type t = span
 36 |   (** See {!Mtime.type-span}. *)
 37 | 
 38 |   val zero : span
 39 |   (** [zero] is a span of 0ns. *)
 40 | 
 41 |   val one : span
 42 |   (** [one] is a span of 1ns. *)
 43 | 
 44 |   val min_span : span
 45 |   (** [min_span] is {!zero}. *)
 46 | 
 47 |   val max_span : span
 48 |   (** [max_span] is 2{^64}-1ns. *)
 49 | 
 50 |   (** {1:preds Predicates} *)
 51 | 
 52 |   val equal : span -> span -> bool
 53 |   (** [equal span span'] is [true] iff [span] and [span'] are equal. *)
 54 | 
 55 |   val compare : span -> span -> int
 56 |   (** [compare span span'] orders spans by increasing duration. *)
 57 | 
 58 |   (** {1:arith Arithmetic} *)
 59 | 
 60 |   val add : span -> span -> span
 61 |   (** [add span span'] is [span + span'].
 62 | 
 63 |       {b Warning.} Rolls over on overflow. *)
 64 | 
 65 |   val abs_diff : span -> span -> span
 66 |   (** [abs_diff span span'] is the absolute difference between
 67 |       [span] and [span']. *)
 68 | 
 69 |   (** {1:const Durations} *)
 70 | 
 71 |   val ( * ) : int -> span -> span
 72 |   (** [n * dur] is [n] times duration [dur].
 73 | 
 74 |       {b Warning.} Does not check for overflow or that [n] is
 75 |       positive. *)
 76 | 
 77 |   val ns : span
 78 |   (** [ns] is a nanosecond duration, 1·10{^-9}s.
 79 |       @since 1.4.0 *)
 80 | 
 81 |   val us : span
 82 |   (** [us] is a microsecond duration, 1·10{^-6}s.
 83 |       @since 1.4.0 *)
 84 | 
 85 |   val ms : span
 86 |   (** [ms] is a millisecond duration, 1·10{^-3}s.
 87 |       @since 1.4.0 *)
 88 | 
 89 |   val s : span
 90 |   (** [s] is a second duration, 1s.
 91 |       @since 1.4.0 *)
 92 | 
 93 |   val min : span
 94 |   (** [min] is a minute duration, 60s.
 95 |       @since 1.4.0 *)
 96 | 
 97 |   val hour : span
 98 |   (** [hour] is an hour duration, 3600s.
 99 |       @since 1.4.0 *)
100 | 
101 |   val day : span
102 |   (** [day] is a day duration, 86'400s.
103 |       @since 1.4.0 *)
104 | 
105 |   val year : span
106 |   (** [year] is a Julian year duration (365.25 days), 31'557'600s. *)
107 | 
108 |   (** {1:convert Converting} *)
109 | 
110 |   val to_uint64_ns : span -> int64
111 |   (** [to_uint64_ns span] is [span] as an {e unsigned} 64-bit integer
112 |       nanosecond span. *)
113 | 
114 |   val of_uint64_ns : int64 -> span
115 |   (** [of_uint64_ns u] is the {e unsigned} 64-bit integer nanosecond
116 |       span [u] as a span. *)
117 | 
118 |   val of_float_ns : float -> span option
119 |   (** [of_float_ns f] is the positive floating point nanosecond span [f] as
120 |       a span. This is [None] if [f] is negative, non finite, or
121 |       larger or equal than 2{^53} (~104 days, the largest exact floating point
122 |       integer).
123 |       @since 2.0.0 *)
124 | 
125 |   val to_float_ns : span -> float
126 |   (** [to_float_ns s] is [span] as a nanosecond floating point span.
127 |       Note that if [s] is larger than 2{^53} (~104 days, the largest
128 |       exact floating point integer) the result is an approximation and
129 |       will not round trip with {!of_float_ns}.
130 |       @since 2.0.0 *)
131 | 
132 |   (** {1:fmt Formatters} *)
133 | 
134 |   val pp : Format.formatter -> span -> unit
135 |   (** [pp] formats spans according to their magnitude using SI
136 |       prefixes on seconds and accepted non-SI units. Years are counted
137 |       in Julian years (365.25 SI-accepted days) as
138 |       {{:http://www.iau.org/publications/proceedings_rules/units/}defined}
139 |       by the International Astronomical Union.
140 | 
141 |       Rounds towards positive infinity, i.e. over approximates, no
142 |       duration is formatted shorter than it is.
143 | 
144 |       The output is UTF-8 encoded, it uses U+03BC for [µs]
145 |       (10{^-6}[s]). *)
146 | 
147 |   val dump : Format.formatter -> t -> unit
148 |   (** [dump ppf span] formats an unspecified raw representation of [span]
149 |       on [ppf]. *)
150 | 
151 |   (**/**)
152 | 
153 |   val unsafe_of_uint64_ns_option : int64 option -> t option
154 | end
155 | 
156 | (** {1:timestamps Monotonic timestamps}
157 | 
158 |     {b Note.} Only use timestamps if you need inter-process time
159 |     correlation, otherwise prefer {!Mtime_clock.elapsed} and
160 |     {{!Mtime_clock.counters}counters}. *)
161 | 
162 | type t
163 | (** The type for monotonic timestamps relative to an indeterminate
164 |     system-wide event (e.g. last startup). Their absolute value has no
165 |     meaning but can be used for inter-process time correlation. *)
166 | 
167 | val to_uint64_ns : t -> int64
168 | (** [to_uint64_ns t] is [t] as an {e unsigned} 64-bit integer
169 |      nanosecond timestamp. The absolute value is meaningless. *)
170 | 
171 | val of_uint64_ns : int64 -> t
172 | (** [to_uint64_ns t] is [t] is an {e unsigned} 64-bit integer
173 |     nanosecond timestamp as a timestamp.
174 | 
175 |     {b Warning.} Timestamps returned by this function should only be
176 |     used with other timestamp values that are know to come from the
177 |     same operating system run. *)
178 | 
179 | val min_stamp : t
180 | (** [min_stamp] is the earliest timestamp. *)
181 | 
182 | val max_stamp : t
183 | (** [max_stamp] is the latest timestamp. *)
184 | 
185 | (** {2:preds Predicates} *)
186 | 
187 | val equal : t -> t -> bool
188 | (** [equal t t'] is [true] iff [t] and [t'] are equal. *)
189 | 
190 | val compare : t -> t -> int
191 | (** [compare t t'] orders timestamps by increasing time. *)
192 | 
193 | val is_earlier : t -> than:t -> bool
194 | (** [is_earlier t ~than] is [true] iff [t] occurred before [than]. *)
195 | 
196 | val is_later : t -> than:t -> bool
197 | (** [is_later t ~than] is [true] iff [t] occurred after [than]. *)
198 | 
199 | (** {2:arith Arithmetic} *)
200 | 
201 | val span : t -> t -> span
202 | (** [span t t'] is the span between [t] and [t'] regardless of the
203 |      order between [t] and [t']. *)
204 | 
205 | val add_span : t -> span -> t option
206 | (** [add_span t s] is the timestamp [s] units later than [t] or [None] if
207 |     the result overflows. *)
208 | 
209 | val sub_span : t -> span -> t option
210 | (** [sub_span t s] is the timestamp [s] units earlier than [t] or
211 |     [None] if the result underflows. *)
212 | 
213 | (** {2:fmt Formatting} *)
214 | 
215 | val pp : Format.formatter -> t -> unit
216 | (** [pp] formats [t] as an {e unsigned} 64-bit integer
217 |     nanosecond timestamp. Note that the absolute value is
218 |     meaningless. *)
219 | 
220 | val dump : Format.formatter -> t -> unit
221 | (** [dump ppf t] formats an unspecified raw representation of [t] on
222 |     [ppf]. *)
223 | 
224 | (*---------------------------------------------------------------------------
225 |    Copyright (c) 2015 The mtime programmers
226 | 
227 |    Permission to use, copy, modify, and/or distribute this software for any
228 |    purpose with or without fee is hereby granted, provided that the above
229 |    copyright notice and this permission notice appear in all copies.
230 | 
231 |    THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
232 |    WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
233 |    MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
234 |    ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
235 |    WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
236 |    ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
237 |    OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
238 |   ---------------------------------------------------------------------------*)
239 | 


--------------------------------------------------------------------------------
/test/tests.ml:
--------------------------------------------------------------------------------
  1 | (*---------------------------------------------------------------------------
  2 |    Copyright (c) 2015 The mtime programmers. All rights reserved.
  3 |    Distributed under the ISC license, see terms at the end of the file.
  4 |   ---------------------------------------------------------------------------*)
  5 | 
  6 | let log f = Format.printf (f ^^ "@.")
  7 | 
  8 | let test_available () =
  9 |   try ignore (Mtime_clock.elapsed ()) with
 10 |   | Sys_error e -> log "[ERROR] no monotonic time available: %s" e; exit 1
 11 | 
 12 | let count = ref 0
 13 | let fail = ref 0
 14 | let test f v =
 15 |   incr count;
 16 |   try f v with
 17 |   | Failure _ | Assert_failure _ as exn ->
 18 |       let bt = Printexc.get_backtrace () in
 19 |       incr fail; log "[ERROR] %s@.%s" (Printexc.to_string exn) bt
 20 | 
 21 | let log_result () =
 22 |   if !fail = 0 then log "[OK] All %d tests passed !" !count else
 23 |   log "[FAIL] %d failure(s) out of %d" !fail !count;
 24 |   ()
 25 | 
 26 | let test_pp_span () =
 27 |   log "Testing Mtime.pp_span";
 28 |   (* The floating point stuff here comes from the previous incarnations
 29 |      of the formatter. Let's keep that it exercices a bit the of_float_ns. *)
 30 |   let pp s =
 31 |     let s = Option.get (Mtime.Span.of_float_ns (s *. 1e+9)) in
 32 |     Format.asprintf "%a" Mtime.Span.pp s
 33 |   in
 34 |   let eq_str s s' = if s <> s' then failwith (Printf.sprintf "%S <> %S" s s') in
 35 |   (* sub ns scale *)
 36 |   eq_str (pp 1.0e-10) "0ns";
 37 |   eq_str (pp 4.0e-10) "0ns";
 38 |   eq_str (pp 6.0e-10) "0ns";
 39 |   eq_str (pp 9.0e-10) "0ns";
 40 |   (* ns scale *)
 41 |   eq_str (pp 2.0e-9) "2ns";
 42 |   eq_str (pp 2.136767676e-9) "2ns";
 43 |   eq_str (pp 2.6e-9) "2ns";
 44 |   eq_str (pp 2.836767676e-9) "2ns";
 45 |   (* us scale *)
 46 |   eq_str (pp 2.0e-6) "2μs";
 47 |   eq_str (pp 2.555e-6) "2.56μs";
 48 |   eq_str (pp 2.5556e-6) "2.56μs";
 49 |   eq_str (pp 99.9994e-6) "100μs";
 50 |   eq_str (pp 99.9996e-6) "100μs";
 51 |   eq_str (pp 100.1555e-6) "101μs";
 52 |   eq_str (pp 100.5555e-6) "101μs";
 53 |   eq_str (pp 100.6555e-6) "101μs";
 54 |   eq_str (pp 999.4e-6) "1ms";
 55 |   eq_str (pp 999.6e-6) "1ms";
 56 |   (* ms scale *)
 57 |   eq_str (pp 1e-3) "1ms";
 58 |   eq_str (pp 1.555e-3) "1.56ms";
 59 |   eq_str (pp 1.5556e-3) "1.56ms";
 60 |   eq_str (pp 99.9994e-3) "100ms";
 61 |   eq_str (pp 99.9996e-3) "100ms";
 62 |   eq_str (pp 100.1555e-3) "101ms";
 63 |   eq_str (pp 100.5555e-3) "101ms";
 64 |   eq_str (pp 100.6555e-3) "101ms";
 65 |   eq_str (pp 999.4e-3) "1s";
 66 |   eq_str (pp 999.6e-3) "1s";
 67 |   (* s scale *)
 68 |   eq_str (pp 1.) "1s";
 69 |   eq_str (pp 1.555) "1.56s";
 70 |   eq_str (pp 1.5554) "1.56s";
 71 |   eq_str (pp 1.5556) "1.56s";
 72 |   eq_str (pp 59.) "59s";
 73 |   eq_str (pp 59.9994) "1min";
 74 |   eq_str (pp 59.9996) "1min";
 75 |   (* min scale *)
 76 |   eq_str (pp 60.) "1min";
 77 |   eq_str (pp 62.) "1min2s";
 78 |   eq_str (pp 62.4) "1min3s";
 79 |   eq_str (pp 3599.) "59min59s";
 80 |   (* hour scale *)
 81 |   eq_str (pp 3600.0) "1h";
 82 |   eq_str (pp 3629.0) "1h1min";
 83 |   eq_str (pp 3660.0) "1h1min";
 84 |   eq_str (pp 7164.0) "2h";
 85 |   eq_str (pp 7200.0) "2h";
 86 |   eq_str (pp 86399.) "1d";
 87 |   (* day scale *)
 88 |   eq_str (pp 86400.) "1d";
 89 |   eq_str (pp (86400. +. (23. *. 3600.))) "1d23h";
 90 |   eq_str (pp (86400. +. (24. *. 3600.))) "2d";
 91 |   (* These tests come from the b0 test suite *);
 92 |   let span s =
 93 |     Format.asprintf "%a"
 94 |       Mtime.Span.pp (Mtime.Span.of_uint64_ns (Int64.of_string s));
 95 |   in
 96 |   assert (span "0u0" = "0ns");
 97 |   assert (span "0u999" = "999ns");
 98 |   assert (span "0u1_000" = "1μs");
 99 |   assert (span "0u1_001" = "1.01μs");
100 |   assert (span "0u1_009" = "1.01μs");
101 |   assert (span "0u1_010" = "1.01μs");
102 |   assert (span "0u1_011" = "1.02μs");
103 |   assert (span "0u1_090" = "1.09μs");
104 |   assert (span "0u1_091" = "1.1μs");
105 |   assert (span "0u1_100" = "1.1μs");
106 |   assert (span "0u1_101" = "1.11μs");
107 |   assert (span "0u1_109" = "1.11μs");
108 |   assert (span "0u1_110" = "1.11μs");
109 |   assert (span "0u1_111" = "1.12μs");
110 |   assert (span "0u1_990" = "1.99μs");
111 |   assert (span "0u1_991" = "2μs");
112 |   assert (span "0u1_999" = "2μs");
113 |   assert (span "0u2_000" = "2μs");
114 |   assert (span "0u2_001" = "2.01μs");
115 |   assert (span "0u9_990" = "9.99μs");
116 |   assert (span "0u9_991" = "10μs");
117 |   assert (span "0u9_999" = "10μs");
118 |   assert (span "0u10_000" = "10μs");
119 |   assert (span "0u10_001" = "10.1μs");
120 |   assert (span "0u10_099" = "10.1μs");
121 |   assert (span "0u10_100" = "10.1μs");
122 |   assert (span "0u10_101" = "10.2μs");
123 |   assert (span "0u10_900" = "10.9μs");
124 |   assert (span "0u10_901" = "11μs");
125 |   assert (span "0u10_999" = "11μs");
126 |   assert (span "0u11_000" = "11μs");
127 |   assert (span "0u11_001" = "11.1μs");
128 |   assert (span "0u11_099" = "11.1μs");
129 |   assert (span "0u11_100" = "11.1μs");
130 |   assert (span "0u11_101" = "11.2μs");
131 |   assert (span "0u99_900" = "99.9μs");
132 |   assert (span "0u99_901" = "100μs");
133 |   assert (span "0u99_999" = "100μs");
134 |   assert (span "0u100_000" = "100μs");
135 |   assert (span "0u100_001" = "101μs");
136 |   assert (span "0u100_999" = "101μs");
137 |   assert (span "0u101_000" = "101μs");
138 |   assert (span "0u101_001" = "102μs");
139 |   assert (span "0u101_999" = "102μs");
140 |   assert (span "0u102_000" = "102μs");
141 |   assert (span "0u999_000" = "999μs");
142 |   assert (span "0u999_001" = "1ms");
143 |   assert (span "0u999_001" = "1ms");
144 |   assert (span "0u999_999" = "1ms");
145 |   assert (span "0u1_000_000" = "1ms");
146 |   assert (span "0u1_000_001" = "1.01ms");
147 |   assert (span "0u1_009_999" = "1.01ms");
148 |   assert (span "0u1_010_000" = "1.01ms");
149 |   assert (span "0u1_010_001" = "1.02ms");
150 |   assert (span "0u9_990_000" = "9.99ms");
151 |   assert (span "0u9_990_001" = "10ms");
152 |   assert (span "0u9_999_999" = "10ms");
153 |   assert (span "0u10_000_000" = "10ms");
154 |   assert (span "0u10_000_001" = "10.1ms");
155 |   assert (span "0u10_000_001" = "10.1ms");
156 |   assert (span "0u10_099_999" = "10.1ms");
157 |   assert (span "0u10_100_000" = "10.1ms");
158 |   assert (span "0u10_100_001" = "10.2ms");
159 |   assert (span "0u99_900_000" = "99.9ms");
160 |   assert (span "0u99_900_001" = "100ms");
161 |   assert (span "0u99_999_999" = "100ms");
162 |   assert (span "0u100_000_000" = "100ms");
163 |   assert (span "0u100_000_001" = "101ms");
164 |   assert (span "0u100_999_999" = "101ms");
165 |   assert (span "0u101_000_000" = "101ms");
166 |   assert (span "0u101_000_001" = "102ms");
167 |   assert (span "0u999_000_000" = "999ms");
168 |   assert (span "0u999_000_001" = "1s");
169 |   assert (span "0u999_999_999" = "1s");
170 |   assert (span "0u1_000_000_000" = "1s");
171 |   assert (span "0u1_000_000_001" = "1.01s");
172 |   assert (span "0u1_009_999_999" = "1.01s");
173 |   assert (span "0u1_010_000_000" = "1.01s");
174 |   assert (span "0u1_010_000_001" = "1.02s");
175 |   assert (span "0u1_990_000_000" = "1.99s");
176 |   assert (span "0u1_990_000_001" = "2s");
177 |   assert (span "0u1_999_999_999" = "2s");
178 |   assert (span "0u2_000_000_000" = "2s");
179 |   assert (span "0u2_000_000_001" = "2.01s");
180 |   assert (span "0u9_990_000_000" = "9.99s");
181 |   assert (span "0u9_999_999_999" = "10s");
182 |   assert (span "0u10_000_000_000" = "10s");
183 |   assert (span "0u10_000_000_001" = "10.1s");
184 |   assert (span "0u10_099_999_999" = "10.1s");
185 |   assert (span "0u10_100_000_000" = "10.1s");
186 |   assert (span "0u10_100_000_001" = "10.2s");
187 |   assert (span "0u59_900_000_000" = "59.9s");
188 |   assert (span "0u59_900_000_001" = "1min");
189 |   assert (span "0u59_999_999_999" = "1min");
190 |   assert (span "0u60_000_000_000" = "1min");
191 |   assert (span "0u60_000_000_001" = "1min1s");
192 |   assert (span "0u60_999_999_999" = "1min1s");
193 |   assert (span "0u61_000_000_000" = "1min1s");
194 |   assert (span "0u61_000_000_001" = "1min2s");
195 |   assert (span "0u119_000_000_000" = "1min59s");
196 |   assert (span "0u119_000_000_001" = "2min");
197 |   assert (span "0u119_999_999_999" = "2min");
198 |   assert (span "0u120_000_000_000" = "2min");
199 |   assert (span "0u120_000_000_001" = "2min1s");
200 |   assert (span "0u3599_000_000_000" = "59min59s");
201 |   assert (span "0u3599_000_000_001" = "1h");
202 |   assert (span "0u3599_999_999_999" = "1h");
203 |   assert (span "0u3600_000_000_000" = "1h");
204 |   assert (span "0u3600_000_000_001" = "1h1min");
205 |   assert (span "0u3659_000_000_000" = "1h1min");
206 |   assert (span "0u3659_000_000_001" = "1h1min");
207 |   assert (span "0u3659_999_999_999" = "1h1min");
208 |   assert (span "0u3660_000_000_000" = "1h1min");
209 |   assert (span "0u3660_000_000_001" = "1h2min");
210 |   assert (span "0u3660_000_000_001" = "1h2min");
211 |   assert (span "0u3660_000_000_001" = "1h2min");
212 |   assert (span "0u3720_000_000_000" = "1h2min");
213 |   assert (span "0u3720_000_000_001" = "1h3min");
214 |   assert (span "0u7140_000_000_000" = "1h59min");
215 |   assert (span "0u7140_000_000_001" = "2h");
216 |   assert (span "0u7199_999_999_999" = "2h");
217 |   assert (span "0u7200_000_000_000" = "2h");
218 |   assert (span "0u7200_000_000_001" = "2h1min");
219 |   assert (span "0u86340_000_000_000" = "23h59min");
220 |   assert (span "0u86340_000_000_001" = "1d");
221 |   assert (span "0u86400_000_000_000" = "1d");
222 |   assert (span "0u86400_000_000_001" = "1d1h");
223 |   assert (span "0u89999_999_999_999" = "1d1h");
224 |   assert (span "0u90000_000_000_000" = "1d1h");
225 |   assert (span "0u90000_000_000_001" = "1d2h");
226 |   assert (span "0u169200_000_000_000" = "1d23h");
227 |   assert (span "0u169200_000_000_001" = "2d");
228 |   assert (span "0u169200_000_000_001" = "2d");
229 |   assert (span "0u172799_999_999_999" = "2d");
230 |   assert (span "0u172800_000_000_000" = "2d");
231 |   assert (span "0u172800_000_000_001" = "2d1h");
232 |   assert (span "0u31536000_000_000_000" = "365d");
233 |   assert (span "0u31554000_000_000_000" = "365d5h");
234 |   assert (
235 |     (* Technically this should round to a year but it does get rendered.
236 |        I don't think it matters, it's not inacurate per se. *)
237 |     span "0u31554000_000_000_001" = "365d6h");
238 |   assert (span "0u31557600_000_000_000" = "1a");
239 |   assert (span "0u31557600_000_000_001" = "1a1d");
240 |   assert (span "0u63028800_000_000_000" = "1a365d");
241 |   assert (span "0u63093600_000_000_000" = "1a365d");
242 |   assert (span "0u63093600_000_000_001" = "2a");
243 |   assert (span "0u63115200_000_000_000" = "2a");
244 |   assert (span "0u63115200_000_000_001" = "2a1d");
245 |   ()
246 | 
247 | let test_counters () =
248 |   log "Test counters";
249 |   let count max =
250 |     let c = Mtime_clock.counter () in
251 |     for i = 1 to max do () done;
252 |     Mtime_clock.count c
253 |   in
254 |   let do_count max =
255 |     let span = count max in
256 |     let span_ns = Mtime.Span.to_uint64_ns span in
257 |     let span_s = 0. (* Mtime.Span.to_s span *) in
258 |     log " * Count to % 8d: % 10Luns %.10fs %a"
259 |       max span_ns span_s Mtime.Span.pp span
260 |   in
261 |   do_count 1000000;
262 |   do_count 100000;
263 |   do_count 10000;
264 |   do_count 1000;
265 |   do_count 100;
266 |   do_count 10;
267 |   do_count 1;
268 |   ()
269 | 
270 | let test_elapsed () =
271 |   log "Test Mtime_clock.elapsed ns - s - pp - dump";
272 |   let span = Mtime_clock.elapsed () in
273 |   log " * Elapsed: %Luns - %gs - %a - %a"
274 |     (Mtime.Span.to_uint64_ns span) (Mtime.Span.to_float_ns span *. 1e-9)
275 |     Mtime.Span.pp span Mtime.Span.dump span;
276 |   ()
277 | 
278 | let test_now () =
279 |   log "Test Mtime_clock.now ns - s - pp - dump ";
280 |   let t = Mtime_clock.now () in
281 |   let span = Mtime.(span t (of_uint64_ns 0_L)) in
282 |   log " * System: %Luns - %gs - %a - %a"
283 |     (Mtime.to_uint64_ns t) (Mtime.Span.to_float_ns span *. 1e-9)
284 |     Mtime.pp t Mtime.dump t;
285 |   ()
286 | 
287 | let test_span_compare () =
288 |   log "Test Mtime.Span.compare";
289 |   let zero_mtime = Mtime.Span.of_uint64_ns 0_L in
290 |   let large_mtime = Mtime.Span.of_uint64_ns Int64.max_int in
291 |   let larger_mtime = Mtime.Span.of_uint64_ns Int64.min_int in
292 |   let max_mtime = Mtime.Span.of_uint64_ns (-1_L) in
293 |   let (<) x y = Mtime.Span.compare x y < 0 in
294 |   assert (zero_mtime < large_mtime);
295 |   assert (zero_mtime < larger_mtime);
296 |   assert (zero_mtime < max_mtime);
297 |   assert (large_mtime < larger_mtime);
298 |   assert (large_mtime < max_mtime);
299 |   assert (larger_mtime < max_mtime);
300 |   let (<) x y = Mtime.Span.compare y x > 0 in
301 |   assert (zero_mtime < large_mtime);
302 |   assert (zero_mtime < large_mtime);
303 |   assert (zero_mtime < larger_mtime);
304 |   assert (zero_mtime < max_mtime);
305 |   assert (large_mtime < larger_mtime);
306 |   assert (large_mtime < max_mtime);
307 |   assert (larger_mtime < max_mtime);
308 |   ()
309 | 
310 | let test_span_constants () =
311 |   log "Test Mtime.Span.{zero,one,max_span,min_span}";
312 |   let (<) x y = Mtime.Span.compare x y < 0 in
313 |   assert (Mtime.Span.zero < Mtime.Span.one);
314 |   assert (Mtime.Span.zero < Mtime.Span.max_span);
315 |   assert (Mtime.Span.min_span < Mtime.Span.one);
316 |   assert (Mtime.Span.min_span < Mtime.Span.max_span);
317 |   assert (Mtime.Span.one < Mtime.Span.max_span);
318 |   ()
319 | 
320 | let test_span_arith () =
321 |   log "Test Mtime.Span.{abs_diff,add}";
322 |   assert (Mtime.Span.(equal (add zero one) one));
323 |   assert (Mtime.Span.(equal (add one zero) one));
324 |   assert (Mtime.Span.(equal (add (abs_diff max_span one) one) max_span));
325 |   ()
326 | 
327 | let test_float_ns () =
328 |   log "Test Mtime.{to,of}_float_ns";
329 |   assert (Mtime.Span.to_float_ns Mtime.Span.max_span = (2. ** 64.) -. 1.);
330 |   assert (Mtime.Span.to_float_ns Mtime.Span.min_span = 0.);
331 |   assert (Mtime.Span.of_float_ns (2. ** 53. -. 1.) =
332 |           Some (Mtime.Span.of_uint64_ns (Int64.(sub (shift_left 1L 53) one))));
333 |   assert (Mtime.Span.of_float_ns (2. ** 53.) = None);
334 |   assert (Mtime.Span.of_float_ns 0. = Some Mtime.Span.zero);
335 |   assert (Mtime.Span.of_float_ns (-.0.) = Some Mtime.Span.zero);
336 |   assert (Mtime.Span.of_float_ns infinity = None);
337 |   assert (Mtime.Span.of_float_ns nan = None);
338 |   assert (Mtime.Span.of_float_ns (-3.) = None);
339 |   assert (Mtime.Span.of_float_ns 1. = Some Mtime.Span.one);
340 |   ()
341 | 
342 | let run () =
343 |   test test_available ();
344 |   test test_pp_span ();
345 |   test test_counters ();
346 |   test test_elapsed ();
347 |   test test_now ();
348 |   test test_span_compare ();
349 |   test test_span_constants ();
350 |   test_span_arith ();
351 |   test_float_ns ();
352 |   log_result ();
353 |   exit !fail
354 | 
355 | (*---------------------------------------------------------------------------
356 |    Copyright (c) 2015 The mtime programmers
357 | 
358 |    Permission to use, copy, modify, and/or distribute this software for any
359 |    purpose with or without fee is hereby granted, provided that the above
360 |    copyright notice and this permission notice appear in all copies.
361 | 
362 |    THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
363 |    WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
364 |    MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
365 |    ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
366 |    WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
367 |    ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
368 |    OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
369 |   ---------------------------------------------------------------------------*)
370 | 


--------------------------------------------------------------------------------