This commit is contained in:
parent
aa2ff7b2f0
commit
2f3113f55d
11742 changed files with 1223940 additions and 0 deletions
4
unikernel/duniverse/mtime/.gitignore
vendored
Normal file
4
unikernel/duniverse/mtime/.gitignore
vendored
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
_b0
|
||||
_build
|
||||
tmp
|
||||
*.install
|
||||
5
unikernel/duniverse/mtime/.merlin
Normal file
5
unikernel/duniverse/mtime/.merlin
Normal file
|
|
@ -0,0 +1,5 @@
|
|||
PKG b0.kit
|
||||
S src
|
||||
S src-clock
|
||||
S test
|
||||
B _b0/**
|
||||
1
unikernel/duniverse/mtime/.ocp-indent
Normal file
1
unikernel/duniverse/mtime/.ocp-indent
Normal file
|
|
@ -0,0 +1 @@
|
|||
strict_with=always,match_clause=4,strict_else=never
|
||||
79
unikernel/duniverse/mtime/B0.ml
Normal file
79
unikernel/duniverse/mtime/B0.ml
Normal file
|
|
@ -0,0 +1,79 @@
|
|||
open B0_kit.V000
|
||||
open Result.Syntax
|
||||
|
||||
(* OCaml library names *)
|
||||
|
||||
let b0_std = B0_ocaml.libname "b0.std"
|
||||
let compiler_libs_toplevel = B0_ocaml.libname "compiler-libs.toplevel"
|
||||
|
||||
let mtime = B0_ocaml.libname "mtime"
|
||||
let mtime_clock = B0_ocaml.libname "mtime.clock"
|
||||
let mtime_clock_os = B0_ocaml.libname "mtime.clock.os"
|
||||
let mtime_top = B0_ocaml.libname "mtime.top"
|
||||
|
||||
(* Libraries *)
|
||||
|
||||
let mtime_lib =
|
||||
let srcs = [`Dir ~/"src"; `X ~/"src/mtime_top_init.ml"] in
|
||||
B0_ocaml.lib mtime ~srcs
|
||||
|
||||
let mtime_clock_lib =
|
||||
let srcs = [`Dir ~/"src/clock"] in
|
||||
B0_ocaml.lib mtime_clock ~srcs ~requires:[mtime] ~exports:[mtime]
|
||||
|
||||
let mtime_clock_os_lib =
|
||||
B0_ocaml.deprecated_lib ~exports:[mtime_clock] mtime_clock_os
|
||||
|
||||
let mtime_top =
|
||||
let srcs = [`Dir ~/"src/top"] in
|
||||
B0_ocaml.lib mtime_top ~srcs ~requires:[mtime; compiler_libs_toplevel]
|
||||
|
||||
(* Tests *)
|
||||
|
||||
let test_mtime =
|
||||
let requires = [b0_std; mtime] in
|
||||
B0_ocaml.test ~/"test/test_mtime.ml" ~requires ~doc:"Mtime tests"
|
||||
|
||||
let test_mtime_clock =
|
||||
let requires = [b0_std; mtime; mtime_clock] in
|
||||
B0_ocaml.test ~/"test/test_mtime_clock.ml" ~requires ~doc:"Mtime_clock tests"
|
||||
|
||||
let min_clock =
|
||||
let doc = "Minimal clock example" in
|
||||
let requires = [mtime; mtime_clock] in
|
||||
B0_ocaml.test ~/"test/min_clock.ml" ~run:false ~requires ~doc
|
||||
|
||||
let min_clock_jsoo =
|
||||
let doc = "Minimal clock example in JavaScript" in
|
||||
let srcs = Fpath.[`File (v "test/min_clock.ml") ] in
|
||||
let meta = B0_meta.(empty |> tag test) in
|
||||
let requires = [mtime; mtime_clock] in
|
||||
B0_jsoo.html_page "min-clock-jsoo" ~srcs ~requires ~meta ~doc
|
||||
|
||||
(* Packs *)
|
||||
|
||||
let default =
|
||||
let meta =
|
||||
B0_meta.empty
|
||||
|> ~~ B0_meta.authors ["The mtime programmers"]
|
||||
|> ~~ B0_meta.maintainers ["Daniel Bünzli <daniel.buenzl i@erratique.ch>"]
|
||||
|> ~~ B0_meta.homepage "https://erratique.ch/software/mtime"
|
||||
|> ~~ B0_meta.online_doc "https://erratique.ch/software/mtime/doc/"
|
||||
|> ~~ B0_meta.licenses ["ISC"]
|
||||
|> ~~ B0_meta.repo "git+https://erratique.ch/repos/mtime.git"
|
||||
|> ~~ B0_meta.issues "https://github.com/dbuenzli/mtime/issues"
|
||||
|> ~~ B0_meta.description_tags
|
||||
["time"; "monotonic"; "system"; "org:erratique"]
|
||||
|> B0_meta.add B0_opam.depends
|
||||
[ "ocaml", {|>= "4.08.0"|};
|
||||
"ocamlfind", {|build|};
|
||||
"ocamlbuild", {|build & != "0.9.0"|};
|
||||
"topkg", {|build & >= "1.0.3"|};
|
||||
]
|
||||
|> B0_meta.add B0_opam.build
|
||||
{|[["ocaml" "pkg/pkg.ml" "build" "--dev-pkg" "%{dev}%"]]|}
|
||||
|> B0_meta.tag B0_opam.tag
|
||||
|> B0_meta.tag B0_release.tag
|
||||
in
|
||||
B0_pack.make "default" ~doc:"mtime package" ~meta ~locked:true @@
|
||||
B0_unit.list ()
|
||||
1
unikernel/duniverse/mtime/BRZO
Normal file
1
unikernel/duniverse/mtime/BRZO
Normal file
|
|
@ -0,0 +1 @@
|
|||
(srcs-x myocamlbuild.ml pkg test src/mtime_top.ml src/mtime_top_init.ml)
|
||||
134
unikernel/duniverse/mtime/CHANGES.md
Normal file
134
unikernel/duniverse/mtime/CHANGES.md
Normal file
|
|
@ -0,0 +1,134 @@
|
|||
v2.1.0 2024-09-10 Zagreb
|
||||
------------------------
|
||||
|
||||
- Add `Mtime.Span.{is_shorter,is_longer}` to make duration
|
||||
comparisons more obivous. Thanks to Pau Ruiz Safont for
|
||||
the suggestion and the patch.
|
||||
- Regularize naming structure. The `mtime.clock.os` library
|
||||
is deprecated. Use `mtime.clock` instead.
|
||||
- Make the library `mtime.clock` export `mtime`.
|
||||
|
||||
|
||||
v2.0.0 2022-12-02 Zagreb
|
||||
------------------------
|
||||
|
||||
* Use the new `js_of_ocaml` ocamlfind `META` standard to link JavaScript
|
||||
stubs (#28).
|
||||
* `Mtime_clock` use `CLOCK_BOOTTIME` rather than `CLOCK_MONOTONIC`
|
||||
on Linux and `mach_continuous_time` rather than `mach_absolute_time`
|
||||
on macOS. This means that on these platforms sleep time is taken
|
||||
into account (#10). Thanks to Bikal Lem for the patch.
|
||||
* Add `Mtime.{to,of}_float_ns`.
|
||||
* Remove deprecated values `Mtime.s_to_*` and `Mtime.Span.to_*` floating
|
||||
points functions. Note that the implementation of `Mtime.Span.to_*`
|
||||
functions was broken if your span exceeded `Int64.max_int`. Thanks
|
||||
to Thomas Leonard for the report (#46).
|
||||
* Change implementation of `Mtime.Span.pp` and remove
|
||||
`Mtime.Span.pp_float_s`. The implementation no longer uses floating
|
||||
point arithmetic and always over approximates the result, no
|
||||
duration is printed shorter than it is. The output is no longer
|
||||
US-ASCII but UTF-8 encoded since U+03BC is used for µs.
|
||||
* Stop installing the clock interface in `mtime.clock`, this package
|
||||
is now empty (#42).
|
||||
|
||||
v1.4.0 2022-02-17 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* Change the `js_of_ocaml` strategy for `Mtime_clock`'s JavaScript
|
||||
implementation. Primitives of `mtime.clock.os` are now implemented
|
||||
in pure JavaScript and linked by `js_of_ocaml`. This means that the
|
||||
`mtime.clock.jsoo` library no longer exists, simply link against
|
||||
`mtime.clock.os` instead. Thanks to Hugo Heuzard for suggesting and
|
||||
implementing this.
|
||||
|
||||
* Add `Mtime.{min,max}_stamp`.
|
||||
* Add durations `Mtime.Span.{ns,us,ms,s,min,hour,day,year}` and
|
||||
the `Mtime.Span.(*)` operator (#28).
|
||||
* Deprecate `Mtime.s_to_*` and `Mtime.*_to_s` floating point constants (#28).
|
||||
* Require OCaml >= 4.08.
|
||||
* Allow compiling with MSVC compiler. Thanks to Jonah Beckford for the patch.
|
||||
|
||||
v1.3.0 2021-10-20 Zagreb
|
||||
------------------------
|
||||
|
||||
* Add Windows support. Thanks to Andreas Hauptmann for the patch
|
||||
and Corentin Leruth for the integration.
|
||||
|
||||
v1.2.0 2019-07-19 Zagreb
|
||||
------------------------
|
||||
|
||||
* Add support for node.js. Thanks to Fabian (@copy) for the patch.
|
||||
* Support for js_of_ocaml 3.4.0.
|
||||
* Add MTIME_OS environment variable for specifying the OS at build time.
|
||||
|
||||
v1.1.0 2017-06-24 London
|
||||
------------------------
|
||||
|
||||
* Add `Mtime.Span.{add,zero,one,min_span,max_span}`.
|
||||
|
||||
v1.0.0 2017-05-09 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
This is a major breaking release with a new API. Thanks to David
|
||||
Sheets for contributions and discussions. The API was changed to
|
||||
mirror and follow the conventions and design of `Ptime`. The `Mtime`
|
||||
module now only provides platform independent datatypes for supporting
|
||||
monotonic clock readings. Platform dependent access to monotonic
|
||||
clocks is provided by the `Mtime_clock` modules. The `Mtime.t` type
|
||||
was added for monotonic timestamps.
|
||||
|
||||
* Rename packages `mtime.{jsoo,os}` to `mtime.{clock.jsoo,clock.os}`
|
||||
which implement the new `Mtime_clock` interface. The `mtime` package
|
||||
has the platform independent support.
|
||||
* Remove `Mtime.available`, `Mtime_clock` functions now raise `Sys_error`
|
||||
on unsupported platforms or errors.
|
||||
* Add a raw interface to `Mtime_clock` which statisfies MirageOS's monotonic
|
||||
clock signature.
|
||||
* Move `Mtime.{elapsed,counter,count}` to
|
||||
`Mtime_clock.{elapsed,counter,count}`.
|
||||
* Add `Mtime.t` a type to represent system-relative monotonic
|
||||
timestamps and related functions. Thanks to David Sheets for the
|
||||
patch and his patience.
|
||||
* Add the `Mtime.Span` module for functions on monotonic time
|
||||
spans. Most of the previous platform independent support is now
|
||||
provided by this module. See below.
|
||||
* Move `Mtime.to_ns_uint64` to `Mtime.Span.to_uint64_ns`.
|
||||
* Move other `Mtime.to_*` to `Mtime.Span.to_*`.
|
||||
* Move `Mtime.pp_span[_s]` to `Mtime.Span.pp[_float__s]`.
|
||||
* Add `Mtime.Span.{compare,equal}`. Thanks to David Sheets for the patch.
|
||||
* Add `Mtime.Span.of_uint64_ns`. Thanks to David Sheets for the patch.
|
||||
|
||||
v0.8.4 2017-02-05 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* Fix package for -custom linking. Thanks to @orbitz for the report.
|
||||
* Build depend on topkg.
|
||||
* Relicense from BSD3 to ISC.
|
||||
|
||||
v0.8.3 2015-12-22 Cambridge (UK)
|
||||
--------------------------------
|
||||
|
||||
* Fix Linux bytecode builds. Thanks to Edwin Török for the report.
|
||||
* Really make js_of_ocaml an optional dependency.
|
||||
|
||||
|
||||
v0.8.2 2015-05-17 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* Simpler toploop support (internal change).
|
||||
* Improve Linux build support by recording link flags against librt in
|
||||
the cma and cmxa (this seems to be needed in certain distributions).
|
||||
Thanks to David Scott for the report and the fix.
|
||||
|
||||
|
||||
v0.8.1 2015-03-23 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
* Fix broken arithmetic on 32-bit platform with POSIX clocks. Thanks to
|
||||
Stephen Dolan for the report and the fix.
|
||||
|
||||
|
||||
v0.8.0 2015-03-19 La Forclaz (VS)
|
||||
---------------------------------
|
||||
|
||||
First release.
|
||||
13
unikernel/duniverse/mtime/LICENSE.md
Normal file
13
unikernel/duniverse/mtime/LICENSE.md
Normal file
|
|
@ -0,0 +1,13 @@
|
|||
Copyright (c) 2015 The mtime programmers
|
||||
|
||||
Permission to use, copy, modify, and/or distribute this software for any
|
||||
purpose with or without fee is hereby granted, provided that the above
|
||||
copyright notice and this permission notice appear in all copies.
|
||||
|
||||
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
|
||||
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
|
||||
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
|
||||
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
|
||||
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
|
||||
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
|
||||
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
|
||||
42
unikernel/duniverse/mtime/README.md
Normal file
42
unikernel/duniverse/mtime/README.md
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
Mtime — Monotonic wall-clock time for OCaml
|
||||
===========================================
|
||||
|
||||
Mtime has platform independent support for monotonic wall-clock time
|
||||
in pure OCaml. This time increases monotonically and is not subject to
|
||||
operating system calendar time adjustments. The library has types to
|
||||
represent nanosecond precision timestamps and time spans.
|
||||
|
||||
The additional Mtime_clock library provide access to a system
|
||||
monotonic clock.
|
||||
|
||||
Mtime has a no dependency. Mtime_clock depends on your system library
|
||||
or JavaScript runtime system. Mtime and its libraries are distributed
|
||||
under the ISC license.
|
||||
|
||||
Home page: <http://erratique.ch/software/mtime>
|
||||
|
||||
# Installation
|
||||
|
||||
Mtime can be installed with `opam`:
|
||||
|
||||
opam install mtime
|
||||
|
||||
If you don't use `opam` consult the [`opam`](opam) file for build
|
||||
instructions.
|
||||
|
||||
# Documentation
|
||||
|
||||
The documentation can be consulted [online] or via `odig doc mtime`.
|
||||
|
||||
Questions are welcome but better asked on the [OCaml forum] than on
|
||||
the issue tracker.
|
||||
|
||||
[online]: http://erratique.ch/software/mtime/doc/
|
||||
[OCaml forum]: https://discuss.ocaml.org/
|
||||
|
||||
# Sample programs
|
||||
|
||||
See [test/min_clock.ml](test/min_clock.ml).
|
||||
|
||||
If you installed mtime with `opam` sample programs are located in
|
||||
the directory `opam var mtime:doc`.
|
||||
7
unikernel/duniverse/mtime/_tags
Normal file
7
unikernel/duniverse/mtime/_tags
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
true : bin_annot, safe_string
|
||||
<_b0> : -traverse
|
||||
|
||||
<src> : include
|
||||
<src/top/mtime_top*> : package(compiler-libs.toplevel)
|
||||
<src/clock/mtime_clock.{cma,cmxa}> : record_mtime_clock_stubs
|
||||
<src/clock/mtime_clock.cmxs> : link_mtime_clock_stubs
|
||||
20
unikernel/duniverse/mtime/doc/index.mld
Normal file
20
unikernel/duniverse/mtime/doc/index.mld
Normal file
|
|
@ -0,0 +1,20 @@
|
|||
{0 Mtime {%html: <span class="version">v2.1.0+dune</span>%}}
|
||||
|
||||
Mtime has platform independent support for monotonic wall-clock time.
|
||||
This time increases monotonically and is not subject to operating
|
||||
system calendar time adjustments. The library has types to represent
|
||||
nanosecond precision timestamps and time spans.
|
||||
|
||||
{!Mtime_clock} provides acces to {{!Mtime_clock.platform_support}a
|
||||
monotonic system clock} and its resolution (if available).
|
||||
|
||||
{1:mtime Library [mtime]}
|
||||
|
||||
{!modules: Mtime}
|
||||
|
||||
{1:mtime_clock Library [mtime.clock]}
|
||||
|
||||
{!modules: Mtime_clock}
|
||||
|
||||
This library also works with JavaScript, see the
|
||||
{{!Mtime_clock.platform_support}platform support}.
|
||||
3
unikernel/duniverse/mtime/dune-project
Normal file
3
unikernel/duniverse/mtime/dune-project
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
(lang dune 2.0)
|
||||
(name mtime)
|
||||
(version v2.1.0+dune)
|
||||
30
unikernel/duniverse/mtime/mtime.opam
Normal file
30
unikernel/duniverse/mtime/mtime.opam
Normal file
|
|
@ -0,0 +1,30 @@
|
|||
version: "2.1.0+dune"
|
||||
opam-version: "2.0"
|
||||
name: "mtime"
|
||||
synopsis: "Monotonic wall-clock time for OCaml"
|
||||
description: """\
|
||||
Mtime has platform independent support for monotonic wall-clock time
|
||||
in pure OCaml. This time increases monotonically and is not subject to
|
||||
operating system calendar time adjustments. The library has types to
|
||||
represent nanosecond precision timestamps and time spans.
|
||||
|
||||
The additional Mtime_clock library provide access to a system
|
||||
monotonic clock.
|
||||
|
||||
Mtime has a no dependency. Mtime_clock depends on your system library
|
||||
or JavaScript runtime system. Mtime and its libraries are distributed
|
||||
under the ISC license.
|
||||
|
||||
Home page: http://erratique.ch/software/mtime"""
|
||||
maintainer: "Daniel Bünzli <daniel.buenzl i@erratique.ch>"
|
||||
authors: "The mtime programmers"
|
||||
license: "ISC"
|
||||
homepage: "https://github.com/dune-universe/mtime"
|
||||
bug-reports: "https://github.com/dbuenzli/mtime/issues"
|
||||
depends: [
|
||||
"dune"
|
||||
"ocaml" {>= "4.08.0"}
|
||||
]
|
||||
build: [ "dune" "build" "-p" name "-j" jobs "@install" "@runtest" {with-test} ]
|
||||
tags: [ "time" "posix" "system" "org:erratique" ]
|
||||
dev-repo: "git+https://github.com/dune-universe/mtime.git"
|
||||
43
unikernel/duniverse/mtime/myocamlbuild.ml
Normal file
43
unikernel/duniverse/mtime/myocamlbuild.ml
Normal file
|
|
@ -0,0 +1,43 @@
|
|||
open Ocamlbuild_plugin
|
||||
open Command
|
||||
|
||||
let os = try Sys.getenv "MTIME_OS" with
|
||||
| Not_found -> Ocamlbuild_pack.My_unix.run_and_read "uname -s"
|
||||
|
||||
let system_support_lib = match os with
|
||||
| "Linux\n" -> [A "-cclib"; A "-lrt"]
|
||||
| _ -> []
|
||||
|
||||
let lib s =
|
||||
match !Ocamlbuild_plugin.Options.ext_lib with
|
||||
| "" -> s ^ ".a"
|
||||
| x -> s ^ "." ^ x
|
||||
|
||||
let () =
|
||||
dispatch begin function
|
||||
| After_rules ->
|
||||
|
||||
(* mtime *)
|
||||
|
||||
ocaml_lib ~tag_name:"use_mtime" ~dir:"src" "src/mtime";
|
||||
|
||||
(* mtime-clock *)
|
||||
|
||||
flag_and_dep ["link"; "ocaml"; "link_mtime_clock_stubs"]
|
||||
(P (lib "src/clock/libmtime_clock_stubs"));
|
||||
|
||||
dep ["record_mtime_clock_stubs"]
|
||||
[lib "src/clock/libmtime_clock_stubs"];
|
||||
|
||||
flag ["library"; "ocaml"; "byte"; "record_mtime_clock_stubs"]
|
||||
(S ([A "-dllib"; A "-lmtime_clock_stubs"] @ system_support_lib));
|
||||
flag ["library"; "ocaml"; "record_mtime_clock_stubs"] (* byt + nat *)
|
||||
(S ([A "-cclib"; A "-lmtime_clock_stubs"] @ system_support_lib));
|
||||
|
||||
ocaml_lib ~tag_name:"use_mtime_clock" ~dir:"src/clock"
|
||||
"src/clock/mtime_clock";
|
||||
|
||||
flag ["link"; "ocaml"; "use_mtime_clock"]
|
||||
(S [A "-ccopt"; A "-Lsrc/clock"]);
|
||||
| _ -> ()
|
||||
end
|
||||
42
unikernel/duniverse/mtime/pkg/META
Normal file
42
unikernel/duniverse/mtime/pkg/META
Normal file
|
|
@ -0,0 +1,42 @@
|
|||
description = "Monotonic wall-clock time for OCaml"
|
||||
version = "2.1.0+dune"
|
||||
requires = ""
|
||||
archive(byte) = "mtime.cma"
|
||||
archive(native) = "mtime.cmxa"
|
||||
plugin(byte) = "mtime.cma"
|
||||
plugin(native) = "mtime.cmxs"
|
||||
exists_if = "mtime.cma mtime.cmxa"
|
||||
|
||||
package "clock" (
|
||||
directory = "clock"
|
||||
description = "The mtime.clock library"
|
||||
version = "2.1.0+dune"
|
||||
requires = "mtime"
|
||||
exports = "mtime"
|
||||
archive(byte) = "mtime_clock.cma"
|
||||
archive(native) = "mtime_clock.cmxa"
|
||||
plugin(byte) = "mtime_clock.cma"
|
||||
plugin(native) = "mtime_clock.cmxs"
|
||||
jsoo_runtime = "runtime.js"
|
||||
exists_if = "mtime_clock.cma mtime_clock.cmxa"
|
||||
|
||||
package "os" (
|
||||
description = "The mtime.clock.os library (deprecated)"
|
||||
version = "2.1.0+dune"
|
||||
requires = "mtime.clock"
|
||||
exports = "mtime.clock"
|
||||
warning = "Deprecated, use the mtime.clock library."
|
||||
)
|
||||
)
|
||||
|
||||
package "top" (
|
||||
directory = "top"
|
||||
description = "The mtime.top library"
|
||||
version = "2.1.0+dune"
|
||||
requires = "mtime"
|
||||
archive(byte) = "mtime_top.cma"
|
||||
archive(native) = "mtime_top.cmxa"
|
||||
plugin(byte) = "mtime_top.cma"
|
||||
plugin(native) = "mtime_top.cmxs"
|
||||
exists_if = "mtime_top.cma mtime_top.cmxa"
|
||||
)
|
||||
15
unikernel/duniverse/mtime/pkg/pkg.ml
Executable file
15
unikernel/duniverse/mtime/pkg/pkg.ml
Executable file
|
|
@ -0,0 +1,15 @@
|
|||
#!/usr/bin/env ocaml
|
||||
#use "topfind"
|
||||
#require "topkg"
|
||||
open Topkg
|
||||
|
||||
let () =
|
||||
Pkg.describe "mtime" @@ fun c ->
|
||||
Ok [ Pkg.mllib "src/mtime.mllib";
|
||||
Pkg.mllib "src/clock/mtime_clock.mllib" ~dst_dir:"clock/";
|
||||
Pkg.clib "src/clock/libmtime_clock_stubs.clib" ~lib_dst_dir:"clock/";
|
||||
Pkg.lib "src/clock/runtime.js" ~dst:"clock/";
|
||||
Pkg.mllib ~api:[] "src/top/mtime_top.mllib" ~dst_dir:"top/";
|
||||
Pkg.lib "src/mtime_top_init.ml";
|
||||
Pkg.doc "doc/index.mld" ~dst:"odoc-pages/index.mld";
|
||||
Pkg.doc "test/min_clock.ml"; ]
|
||||
10
unikernel/duniverse/mtime/src/clock/dune
Normal file
10
unikernel/duniverse/mtime/src/clock/dune
Normal file
|
|
@ -0,0 +1,10 @@
|
|||
(library
|
||||
(name mtime_clock)
|
||||
(public_name mtime.clock)
|
||||
(libraries mtime)
|
||||
(foreign_stubs (language c) (names mtime_clock_stubs))
|
||||
(js_of_ocaml (javascript_files runtime.js)))
|
||||
|
||||
(deprecated_library_name
|
||||
(old_public_name mtime.clock.os)
|
||||
(new_public_name mtime.clock))
|
||||
|
|
@ -0,0 +1 @@
|
|||
mtime_clock_stubs.o
|
||||
24
unikernel/duniverse/mtime/src/clock/mtime_clock.ml
Normal file
24
unikernel/duniverse/mtime/src/clock/mtime_clock.ml
Normal file
|
|
@ -0,0 +1,24 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2017 The mtime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Raw interface *)
|
||||
|
||||
external elapsed_ns : unit -> int64 = "ocaml_mtime_clock_elapsed_ns"
|
||||
external now_ns : unit -> int64 = "ocaml_mtime_clock_now_ns"
|
||||
external period_ns : unit -> int64 option = "ocaml_mtime_clock_period_ns"
|
||||
|
||||
let () = ignore (elapsed_ns ()) (* Initalize elapsed_ns's origin. *)
|
||||
|
||||
(* Monotonic clock *)
|
||||
|
||||
let elapsed () = Mtime.Span.of_uint64_ns (elapsed_ns ())
|
||||
let now () = Mtime.of_uint64_ns (now_ns ())
|
||||
let period () = Mtime.Span.unsafe_of_uint64_ns_option (period_ns ())
|
||||
|
||||
(* Counters *)
|
||||
|
||||
type counter = int64
|
||||
let counter = elapsed_ns
|
||||
let count c = Mtime.Span.of_uint64_ns (Int64.sub (elapsed_ns ()) c)
|
||||
108
unikernel/duniverse/mtime/src/clock/mtime_clock.mli
Normal file
108
unikernel/duniverse/mtime/src/clock/mtime_clock.mli
Normal file
|
|
@ -0,0 +1,108 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2017 The mtime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(** Monotonic time clock.
|
||||
|
||||
[Mtime_clock] provides access to a system monotonic clock. This
|
||||
time increases monotonically and is not subject to operating
|
||||
system calendar time adjustments.
|
||||
|
||||
Only use {!Mtime_clock.now} if you need inter-process time
|
||||
correlation, otherwise prefer {!Mtime_clock.elapsed} and
|
||||
{{!Mtime_clock.counters}counters}.
|
||||
|
||||
Consult important information about {{!err}error handling}
|
||||
and {{!platform_support}platform support}. *)
|
||||
|
||||
(** {1:clock Monotonic clock} *)
|
||||
|
||||
val elapsed : unit -> Mtime.span
|
||||
(** [elapsed ()] is the monotonic time span elapsed since the
|
||||
beginning of the program.
|
||||
|
||||
Raises {!Sys_error}, see {{!err}error handling} *)
|
||||
|
||||
val now : unit -> Mtime.t
|
||||
(** [now ()] is the current system-relative monotonic timestamp. Its
|
||||
absolute value is meaningless.
|
||||
|
||||
Raises {!Sys_error}, see {{!err}error handling} *)
|
||||
|
||||
val period : unit -> Mtime.span option
|
||||
(** [period ()] is the clock's period as a monotonic time span (if
|
||||
available). *)
|
||||
|
||||
(** {1:counters Time counters} *)
|
||||
|
||||
type counter
|
||||
(** The type for monotonic wall-clock time counters. *)
|
||||
|
||||
val counter : unit -> counter
|
||||
(** [counter ()] is a counter counting from now on.
|
||||
|
||||
Raises {!Sys_error}, see {{!err}error handling} *)
|
||||
|
||||
val count : counter -> Mtime.span
|
||||
(** [count c] is the monotonic time span elapsed since [c] was created. *)
|
||||
|
||||
(** {1:raw Monotonic clock raw interface} *)
|
||||
|
||||
val elapsed_ns : unit -> int64
|
||||
(** [elapsed_ns ()] is the {e unsigned} 64-bit integer nanosecond monotonic
|
||||
time span elapsed since the beginning of the program.
|
||||
|
||||
Raises {!Sys_error}, see {{!err}error handling} *)
|
||||
|
||||
val now_ns : unit -> int64
|
||||
(** [now_ns ()] is an {e unsigned} 64-bit integer nanosecond
|
||||
system-relative monotonic timestamp. The absolute value is
|
||||
meaningless.
|
||||
|
||||
Raises {!Sys_error}, see {{!err}error handling} *)
|
||||
|
||||
val period_ns : unit -> int64 option
|
||||
(** [period_ns ()] is the clock's period as an {e unsigned} 64-bit
|
||||
integer nanosecond monotonic time span (if available). *)
|
||||
|
||||
(** {1:err Error handling}
|
||||
|
||||
The functions {!elapsed}, {!now}, {!val-counter}, {!elapsed_ns} and
|
||||
{!now_ns} raise [Sys_error] whenever they can't determine the
|
||||
current time or that it doesn't fit in [Mtime]'s range. Usually
|
||||
this exception should only be catched at the toplevel of your
|
||||
program to log it and abort the program. It indicates a serious
|
||||
error condition in the system.
|
||||
|
||||
All the other functions, whose functionality is less essential,
|
||||
simply silently return [None] if they can't determine the
|
||||
information either because it is unavailable or because an error
|
||||
occured.
|
||||
|
||||
{1:platform_support Platform support}
|
||||
|
||||
{ul
|
||||
{- Linux uses {{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/clock_gettime.html}[clock_gettime]}
|
||||
with {{:https://www.man7.org/linux/man-pages/man3/clock_settime.3.html}
|
||||
CLOCK_BOOTTIME}. This means that sleep time is taken into account.}
|
||||
{- Platforms with a POSIX clock use
|
||||
{{:http://pubs.opengroup.org/onlinepubs/9699919799/functions/clock_gettime.html}[clock_gettime]}
|
||||
with CLOCK_MONOTONIC.}
|
||||
{- Darwin uses
|
||||
{{:https://developer.apple.com/documentation/kernel/1646199-mach_continuous_time}[mach_continous_time]}.
|
||||
This means that sleep time is taken into account.}
|
||||
{- Windows uses
|
||||
{{:https://msdn.microsoft.com/en-us/library/windows/desktop/aa373083%28v=vs.85%29.aspx}Performance counters}. }
|
||||
{- JavaScript uses
|
||||
{{:http://www.w3.org/TR/hr-time/}[performance.now]} (consult
|
||||
{{:http://caniuse.com/#feat=high-resolution-time}availability})
|
||||
which returns a
|
||||
{{:http://www.w3.org/TR/hr-time/#sec-DOMHighResTimeStamp}double
|
||||
floating point value} in milliseconds with
|
||||
resolution up to the microsecond.}
|
||||
{- JavaScript running on Node.js uses the built-in
|
||||
{{:https://nodejs.org/api/perf_hooks.html#perf_hooks_performance_now}[perf_hooks]}
|
||||
module, which provides an interface compatible to the [performance]
|
||||
module in browsers.}}
|
||||
*)
|
||||
1
unikernel/duniverse/mtime/src/clock/mtime_clock.mllib
Normal file
1
unikernel/duniverse/mtime/src/clock/mtime_clock.mllib
Normal file
|
|
@ -0,0 +1 @@
|
|||
Mtime_clock
|
||||
220
unikernel/duniverse/mtime/src/clock/mtime_clock_stubs.c
Normal file
220
unikernel/duniverse/mtime/src/clock/mtime_clock_stubs.c
Normal file
|
|
@ -0,0 +1,220 @@
|
|||
/*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The mtime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*/
|
||||
|
||||
#include <caml/mlvalues.h>
|
||||
#include <caml/alloc.h>
|
||||
#include <caml/memory.h>
|
||||
#include <caml/fail.h>
|
||||
|
||||
#include <stdint.h>
|
||||
|
||||
#define Val_none Val_int(0)
|
||||
#define OCAML_MTIME_RAISE_SYS_ERROR(ERR) \
|
||||
do { caml_raise_sys_error (caml_copy_string("Mtime_clock: " ERR)); } \
|
||||
while (0)
|
||||
|
||||
/* Detect platform */
|
||||
|
||||
#if defined(__APPLE__) && defined(__MACH__)
|
||||
#define OCAML_MTIME_DARWIN
|
||||
|
||||
#elif defined(__unix__) || defined(__unix)
|
||||
#include <unistd.h>
|
||||
#if defined(__linux__)
|
||||
#define OCAML_MTIME_LINUX
|
||||
#endif
|
||||
#if defined(_POSIX_VERSION)
|
||||
#define OCAML_MTIME_POSIX
|
||||
#endif
|
||||
#elif defined(_WIN32)
|
||||
#define OCAML_MTIME_WINDOWS
|
||||
#endif
|
||||
|
||||
/* Darwin */
|
||||
|
||||
#if defined(OCAML_MTIME_DARWIN)
|
||||
|
||||
#include <mach/mach_time.h>
|
||||
|
||||
static mach_timebase_info_data_t scale = {0};
|
||||
|
||||
void ocaml_mtime_clock_init_scale (void)
|
||||
{
|
||||
if (mach_timebase_info (&scale) != KERN_SUCCESS)
|
||||
OCAML_MTIME_RAISE_SYS_ERROR ("mach_timebase_info () failed");
|
||||
|
||||
if (scale.denom == 0)
|
||||
OCAML_MTIME_RAISE_SYS_ERROR ("mach_timebase_info_data.denom is 0");
|
||||
}
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit)
|
||||
{
|
||||
static uint64_t start = 0L;
|
||||
if (start == 0L) { start = mach_continuous_time (); }
|
||||
if (scale.denom == 0) { ocaml_mtime_clock_init_scale (); }
|
||||
uint64_t now = mach_continuous_time ();
|
||||
return caml_copy_int64 (((now - start) * scale.numer) / scale.denom);
|
||||
}
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_now_ns (value unit)
|
||||
{
|
||||
if (scale.denom == 0) { ocaml_mtime_clock_init_scale (); }
|
||||
uint64_t now = mach_continuous_time ();
|
||||
return caml_copy_int64 ((now * scale.numer) / scale.denom);
|
||||
}
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_period_ns (value unit)
|
||||
{ return Val_none; }
|
||||
|
||||
/* POSIX */
|
||||
|
||||
#elif defined(OCAML_MTIME_POSIX)
|
||||
|
||||
#include <time.h>
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit)
|
||||
{
|
||||
static struct timespec start = {0};
|
||||
struct timespec now;
|
||||
clockid_t clockid;
|
||||
|
||||
#if defined(OCAML_MTIME_LINUX)
|
||||
clockid = CLOCK_BOOTTIME;
|
||||
#else
|
||||
clockid = CLOCK_MONOTONIC;
|
||||
#endif
|
||||
|
||||
if (start.tv_sec == 0)
|
||||
{
|
||||
if (clock_gettime (clockid, &start))
|
||||
OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
|
||||
}
|
||||
|
||||
if (clock_gettime (clockid, &now))
|
||||
OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
|
||||
|
||||
return caml_copy_int64 ((uint64_t)(now.tv_sec - start.tv_sec) *
|
||||
(uint64_t)1000000000 +
|
||||
(uint64_t)(now.tv_nsec - start.tv_nsec));
|
||||
}
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_now_ns (value unit)
|
||||
{
|
||||
struct timespec now;
|
||||
|
||||
if (clock_gettime (CLOCK_MONOTONIC, &now))
|
||||
OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
|
||||
|
||||
return caml_copy_int64 ((uint64_t)(now.tv_sec) *
|
||||
(uint64_t)1000000000 +
|
||||
(uint64_t)(now.tv_nsec));
|
||||
}
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_period_ns (value unit)
|
||||
{
|
||||
CAMLparam1 (unit);
|
||||
CAMLlocal1 (some);
|
||||
struct timespec res;
|
||||
|
||||
if (clock_getres (CLOCK_MONOTONIC, &res)) { CAMLreturn (Val_none); }
|
||||
|
||||
/* We only handle valid timespec structs as per POSIX def (§2.8.5 in 2013) */
|
||||
if (res.tv_nsec < 0 || res.tv_nsec > 999999999) CAMLreturn (Val_none);
|
||||
|
||||
/* Negative periods are dubious */
|
||||
if (res.tv_sec < 0) CAMLreturn (Val_none);
|
||||
|
||||
some = caml_alloc (1, 0);
|
||||
Store_field (some, 0,
|
||||
caml_copy_int64 ((uint64_t)(res.tv_sec) *
|
||||
(uint64_t)1000000000 +
|
||||
(uint64_t)(res.tv_nsec)));
|
||||
CAMLreturn (some);
|
||||
}
|
||||
|
||||
#elif defined(OCAML_MTIME_WINDOWS)
|
||||
#define WIN32_LEAN_AND_MEAN
|
||||
#include <windows.h>
|
||||
|
||||
static double performance_frequency;
|
||||
static void set_performance_frequency(void)
|
||||
{
|
||||
LARGE_INTEGER t_freq;
|
||||
if (!QueryPerformanceFrequency(&t_freq)) {
|
||||
OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
|
||||
}
|
||||
performance_frequency = (1000000000.0 / t_freq.QuadPart);
|
||||
}
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit)
|
||||
{
|
||||
(void) unit;
|
||||
static LARGE_INTEGER start;
|
||||
if (performance_frequency == 0.0) {
|
||||
set_performance_frequency();
|
||||
}
|
||||
if ( start.QuadPart == 0 )
|
||||
{
|
||||
if (!QueryPerformanceCounter(&start)) {
|
||||
OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
|
||||
}
|
||||
}
|
||||
static LARGE_INTEGER now;
|
||||
if ( !QueryPerformanceCounter(&now)) {
|
||||
OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
|
||||
}
|
||||
uint64_t ret = (now.QuadPart - start.QuadPart) * performance_frequency;
|
||||
return caml_copy_int64(ret);
|
||||
}
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_now_ns (value unit)
|
||||
{
|
||||
(void) unit;
|
||||
if (performance_frequency == 0.0) {
|
||||
set_performance_frequency();
|
||||
}
|
||||
static LARGE_INTEGER now;
|
||||
if ( !QueryPerformanceCounter(&now)) {
|
||||
OCAML_MTIME_RAISE_SYS_ERROR ("clock_gettime () failed");
|
||||
}
|
||||
uint64_t ret = now.QuadPart * performance_frequency;
|
||||
return caml_copy_int64(ret);
|
||||
}
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_period_ns (value unit)
|
||||
{
|
||||
(void) unit;
|
||||
if (performance_frequency == 0.0) {
|
||||
set_performance_frequency();
|
||||
}
|
||||
if ( performance_frequency <= 0.0 ) {
|
||||
return Val_none;
|
||||
}
|
||||
value ret;
|
||||
value p = caml_copy_int64(performance_frequency);
|
||||
Begin_roots1(p);
|
||||
ret = caml_alloc_small(1,0);
|
||||
Field(ret,0) = p;
|
||||
End_roots();
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
/* Unsupported */
|
||||
|
||||
#else
|
||||
|
||||
#warning OCaml Mtime_clock module: unsupported platform
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_elapsed_ns (value unit)
|
||||
{ OCAML_MTIME_RAISE_SYS_ERROR ("unsupported platform"); }
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_now_ns (value unit)
|
||||
{ OCAML_MTIME_RAISE_SYS_ERROR ("unsupported platform"); }
|
||||
|
||||
CAMLprim value ocaml_mtime_clock_period_ns (value unit)
|
||||
{ OCAML_MTIME_RAISE_SYS_ERROR ("unsupported platform"); }
|
||||
|
||||
#endif
|
||||
77
unikernel/duniverse/mtime/src/clock/runtime.js
Normal file
77
unikernel/duniverse/mtime/src/clock/runtime.js
Normal file
|
|
@ -0,0 +1,77 @@
|
|||
/*---------------------------------------------------------------------------
|
||||
Copyright (c) 2022 The mtime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*/
|
||||
|
||||
//Provides: ocaml_mtime_clock_period_ns
|
||||
function ocaml_mtime_clock_period_ns (_unit) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
//Provides: mtime_clock_now
|
||||
//Requires: caml_int64_of_float, caml_int64_mul
|
||||
//Requires: caml_raise_sys_error
|
||||
function find_performance_obj () {
|
||||
var test = function (o)
|
||||
{ return (o && o.performance && typeof o.performance.now == "function");};
|
||||
|
||||
if (test (globalThis)) { return globalThis.performance; };
|
||||
if (test (globalThis.perf_hooks)){ return globalThis.perf_hooks.performance;};
|
||||
if (typeof require == "function") {
|
||||
var ph = require ("perf_hooks");
|
||||
if (test (ph)) { return ph.performance; }
|
||||
}
|
||||
var obj = { now: function ()
|
||||
{ caml_raise_sys_error ("performance.now () is not available");}}
|
||||
return obj;
|
||||
}
|
||||
var performance_obj = find_performance_obj ();
|
||||
function mtime_clock_now () {
|
||||
/* Conversion of DOMHighResTimeStamp to uint64 nanosecond timestamps.
|
||||
|
||||
The spec https://www.w3.org/TR/hr-time-3 says DOMHighResTimeStamp
|
||||
are double milliseconds that *should* be accurate to 5 microseconds.
|
||||
We simply assume we have microsecond precision and multiply the
|
||||
stamps given by performance.now () by 1e3 to get double microseconds.
|
||||
|
||||
We then use Int64.of_float on these double microseconds to get an
|
||||
uint64 in microseconds. This works in practice for the following
|
||||
reasons. Let us assume we have the largest integer microsecond
|
||||
timestamp representable exactly in double, i.e. 2^53 :
|
||||
|
||||
1) Assuming the zero of performance.now is when the tab is created,
|
||||
our 2^53 timestamp only occurs after:
|
||||
|
||||
2^53 / 1_000_000 / (24 * 3600 * 365.25) ≅ 285.4 Julian years
|
||||
|
||||
2) 2^53 < Int64.max_int = 2^63 - 1, so seing the result of
|
||||
Int64.of_float as unsigned for this timestamp is correct and in
|
||||
the defined domain of the conversion function (the truncated float
|
||||
must lie in [Int64.min_int;Int64.max_int] for defined behaviour).
|
||||
|
||||
So the Int64.of_float conversion is unlikely to be problematic and
|
||||
we simply bring the resulting uint64 microsecond to an uint64
|
||||
nanosecond by multiplying by 1000L, which for 2^53 microseconds
|
||||
remains smaller than Int64.max_int, yielding a correct uint64
|
||||
nanosecond timestamp for a reasonable time range. */
|
||||
|
||||
var now_us = performance_obj.now () * 1e3;
|
||||
var now_ns = caml_int64_mul (caml_int64_of_float (now_us),
|
||||
caml_int64_of_float (1000));
|
||||
return now_ns;
|
||||
}
|
||||
|
||||
//Provides: ocaml_mtime_clock_now_ns
|
||||
//Requires: mtime_clock_now
|
||||
function ocaml_mtime_clock_now_ns (_unit) {
|
||||
return mtime_clock_now ();
|
||||
}
|
||||
|
||||
//Provides: ocaml_mtime_clock_elapsed_ns
|
||||
//Requires: caml_int64_sub, mtime_clock_now
|
||||
var mtime_clock_start;
|
||||
function ocaml_mtime_clock_elapsed_ns (_unix) {
|
||||
if (!mtime_clock_start) mtime_clock_start = mtime_clock_now ();
|
||||
var now = mtime_clock_now ();
|
||||
return caml_int64_sub (now, mtime_clock_start);
|
||||
}
|
||||
4
unikernel/duniverse/mtime/src/dune
Normal file
4
unikernel/duniverse/mtime/src/dune
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
(library
|
||||
(name mtime)
|
||||
(public_name mtime)
|
||||
(modules mtime))
|
||||
173
unikernel/duniverse/mtime/src/mtime.ml
Normal file
173
unikernel/duniverse/mtime/src/mtime.ml
Normal file
|
|
@ -0,0 +1,173 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The mtime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(* Time spans
|
||||
|
||||
Time spans are in nanoseconds and we represent them by an unsigned
|
||||
64-bit integer. This allows to represent spans for:
|
||||
(2^64-1) / 1_000_000_000 / (24 * 3600 * 365.25) ≅ 584.5 Julian years *)
|
||||
|
||||
type span = int64 (* unsigned nanoseconds *)
|
||||
|
||||
module Span = struct
|
||||
type t = span
|
||||
let zero = 0L
|
||||
let one = 1L
|
||||
let min_span = zero
|
||||
let max_span = -1L
|
||||
|
||||
(* Predicates *)
|
||||
|
||||
let equal = Int64.equal
|
||||
let compare = Int64.unsigned_compare
|
||||
let is_shorter s ~than = compare s than < 0
|
||||
let is_longer s ~than = compare s than > 0
|
||||
|
||||
(* Arithmetic *)
|
||||
|
||||
let add = Int64.add
|
||||
let abs_diff s0 s1 =
|
||||
if compare s0 s1 < 0 then Int64.sub s1 s0 else Int64.sub s0 s1
|
||||
|
||||
(* Durations *)
|
||||
|
||||
let ( * ) n s = Int64.mul (Int64.of_int n) s
|
||||
let ns = 1L
|
||||
let us = 1_000L
|
||||
let ms = 1_000_000L
|
||||
let s = 1_000_000_000L
|
||||
let min = 60_000_000_000L
|
||||
let hour = 3600_000_000_000L
|
||||
let day = 86400_000_000_000L
|
||||
let year = 31_557_600_000_000_000L
|
||||
|
||||
(* Converting *)
|
||||
|
||||
let to_uint64_ns s = s
|
||||
let of_uint64_ns ns = ns
|
||||
|
||||
let max_float_int = 9007199254740992. (* 2^53. *)
|
||||
let int64_min_int_float = Int64.to_float Int64.min_int
|
||||
let int64_max_int_float = Int64.to_float Int64.max_int
|
||||
|
||||
let of_float_ns sf =
|
||||
if sf < 0. || sf >= max_float_int || not (Float.is_finite sf)
|
||||
then None else Some (Int64.of_float sf)
|
||||
|
||||
let to_float_ns s =
|
||||
if Int64.compare 0L s <= 0 then Int64.to_float s else
|
||||
int64_max_int_float +. (-. int64_min_int_float +. Int64.to_float s)
|
||||
|
||||
let unsafe_of_uint64_ns_option nsopt = nsopt
|
||||
|
||||
(* Formatting *)
|
||||
|
||||
let pf = Format.fprintf
|
||||
|
||||
let rec pp_si_span unit_str unit_str_len si_unit si_higher_unit ppf span =
|
||||
let geq x y = Int64.unsigned_compare x y >= 0 in
|
||||
let m = Int64.unsigned_div span si_unit in
|
||||
let n = Int64.unsigned_rem span si_unit in
|
||||
let pp_unit ppf () = Format.pp_print_as ppf unit_str_len unit_str in
|
||||
match m with
|
||||
| m when geq m 100L -> (* No fractional digit *)
|
||||
let m_up = if Int64.equal n 0L then m else Int64.succ m in
|
||||
let span' = Int64.mul m_up si_unit in
|
||||
if geq span' si_higher_unit then pp ppf span' else
|
||||
(pf ppf "%Ld" m_up; pp_unit ppf ())
|
||||
| m when geq m 10L -> (* One fractional digit w.o. trailing zero *)
|
||||
let f_factor = Int64.unsigned_div si_unit 10L in
|
||||
let f_m = Int64.unsigned_div n f_factor in
|
||||
let f_n = Int64.unsigned_rem n f_factor in
|
||||
let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in
|
||||
begin match f_m_up with
|
||||
| 0L -> pf ppf "%Ld" m; pp_unit ppf ()
|
||||
| f when geq f 10L ->
|
||||
pp ppf Int64.(add (mul m si_unit) (mul f f_factor))
|
||||
| f -> pf ppf "%Ld.%Ld" m f; pp_unit ppf ()
|
||||
end
|
||||
| m -> (* Two or zero fractional digits w.o. trailing zero *)
|
||||
let f_factor = Int64.unsigned_div si_unit 100L in
|
||||
let f_m = Int64.unsigned_div n f_factor in
|
||||
let f_n = Int64.unsigned_rem n f_factor in
|
||||
let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in
|
||||
match f_m_up with
|
||||
| 0L -> pf ppf "%Ld" m; pp_unit ppf ()
|
||||
| f when geq f 100L ->
|
||||
pp ppf Int64.(add (mul m si_unit) (mul f f_factor))
|
||||
| f when Int64.equal (Int64.rem f 10L) 0L ->
|
||||
pf ppf "%Ld.%Ld" m (Int64.div f 10L); pp_unit ppf ()
|
||||
| f ->
|
||||
pf ppf "%Ld.%02Ld" m f; pp_unit ppf ()
|
||||
|
||||
and pp_non_si unit_str unit unit_lo_str unit_lo unit_lo_size ppf span =
|
||||
let geq x y = Int64.unsigned_compare x y >= 0 in
|
||||
let m = Int64.unsigned_div span unit in
|
||||
let n = Int64.unsigned_rem span unit in
|
||||
if Int64.equal n 0L then pf ppf "%Ld%s" m unit_str else
|
||||
let f_m = Int64.unsigned_div n unit_lo in
|
||||
let f_n = Int64.unsigned_rem n unit_lo in
|
||||
let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in
|
||||
match f_m_up with
|
||||
| f when geq f unit_lo_size ->
|
||||
pp ppf Int64.(add (mul m unit) (mul f unit_lo))
|
||||
| f ->
|
||||
pf ppf "%Ld%s%Ld%s" m unit_str f unit_lo_str
|
||||
|
||||
and pp ppf span =
|
||||
let geq x y = Int64.unsigned_compare x y >= 0 in
|
||||
let lt x y = Int64.unsigned_compare x y = -1 in
|
||||
match span with
|
||||
| sp when lt sp us -> pf ppf "%Ldns" sp
|
||||
| sp when lt sp ms -> pp_si_span "\xCE\xBCs" 2 us ms ppf sp
|
||||
| sp when lt sp s -> pp_si_span "ms" 2 ms s ppf sp
|
||||
| sp when lt sp min -> pp_si_span "s" 1 s min ppf sp
|
||||
| sp when lt sp hour -> pp_non_si "min" min "s" s 60L ppf sp
|
||||
| sp when lt sp day -> pp_non_si "h" hour "min" min 60L ppf sp
|
||||
| sp when lt sp year -> pp_non_si "d" day "h" hour 24L ppf sp | sp ->
|
||||
let m = Int64.unsigned_div sp year in
|
||||
let n = Int64.unsigned_rem sp year in
|
||||
if Int64.equal n 0L then pf ppf "%Lda" m else
|
||||
let f_m = Int64.unsigned_div n day in
|
||||
let f_n = Int64.unsigned_rem n day in
|
||||
let f_m_up = if Int64.equal f_n 0L then f_m else Int64.succ f_m in
|
||||
match f_m_up with
|
||||
| f when geq f 366L -> pf ppf "%Lda" (Int64.succ m)
|
||||
| f -> pf ppf "%Lda%Ldd" m f
|
||||
|
||||
let dump ppf s = Format.fprintf ppf "%Lu" s
|
||||
end
|
||||
|
||||
(* Monotonic timestamps *)
|
||||
|
||||
type t = int64
|
||||
|
||||
let to_uint64_ns s = s
|
||||
let of_uint64_ns ns = ns
|
||||
let min_stamp = 0L
|
||||
let max_stamp = -1L
|
||||
|
||||
(* Predicates *)
|
||||
|
||||
let equal = Int64.equal
|
||||
let compare = Int64.unsigned_compare
|
||||
let is_earlier t ~than = compare t than < 0
|
||||
let is_later t ~than = compare t than > 0
|
||||
|
||||
(* Arithmetic *)
|
||||
|
||||
let span t0 t1 = if compare t0 t1 < 0 then Int64.sub t1 t0 else Int64.sub t0 t1
|
||||
|
||||
let add_span t s =
|
||||
let sum = Int64.add t s in
|
||||
if compare t sum <= 0 then Some sum else None
|
||||
|
||||
let sub_span t s =
|
||||
if compare t s < 0 then None else Some (Int64.sub t s)
|
||||
|
||||
(* Formatters *)
|
||||
|
||||
let pp ppf ns = Format.fprintf ppf "%Luns" ns
|
||||
let dump ppf ns = Format.fprintf ppf "%Lu" ns
|
||||
228
unikernel/duniverse/mtime/src/mtime.mli
Normal file
228
unikernel/duniverse/mtime/src/mtime.mli
Normal file
|
|
@ -0,0 +1,228 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The mtime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
(** Monotonic time values.
|
||||
|
||||
[Mtime] has platform independent support for monotonic wall-clock
|
||||
time. This time increases monotonically and is not subject to
|
||||
operating system calendar time adjustments.
|
||||
|
||||
{{!spans}Time spans} represent non-negative monotonic time spans
|
||||
between two monotonic clock readings. {{!timestamps}Timestamps}
|
||||
represent system-relative monotonic {e timestamps}, their absolute
|
||||
value is meaningless but they can be compared across the processes
|
||||
of an operating system run.
|
||||
|
||||
{!Mtime_clock} provides access to a system monotonic clock. *)
|
||||
|
||||
(** {1:spans Monotonic time spans} *)
|
||||
|
||||
type span
|
||||
(** The type for non-negative monotonic time spans. They represent the
|
||||
difference between two monotonic clock readings. If the platform's
|
||||
clock has nanosecond resolution the representation guarantees that
|
||||
the function {!Mtime_clock.elapsed} can measure up to
|
||||
approximatively 584 Julian year spans before silently rolling over
|
||||
(unlikely since this is in a single program run). *)
|
||||
|
||||
(** Monotonic time spans. *)
|
||||
module Span : sig
|
||||
|
||||
(** {1:spans Monotonic time spans} *)
|
||||
|
||||
type t = span
|
||||
(** See {!Mtime.type-span}. *)
|
||||
|
||||
val zero : span
|
||||
(** [zero] is a span of 0ns. *)
|
||||
|
||||
val one : span
|
||||
(** [one] is a span of 1ns. *)
|
||||
|
||||
val min_span : span
|
||||
(** [min_span] is {!zero}. *)
|
||||
|
||||
val max_span : span
|
||||
(** [max_span] is 2{^64}-1ns. *)
|
||||
|
||||
(** {1:preds Predicates} *)
|
||||
|
||||
val equal : span -> span -> bool
|
||||
(** [equal span span'] is [true] iff [span] and [span'] are equal. *)
|
||||
|
||||
val compare : span -> span -> int
|
||||
(** [compare span span'] orders spans by increasing duration. *)
|
||||
|
||||
val is_shorter : span -> than:span -> bool
|
||||
(** [is_shorter span ~than] is [true] iff [span] lasts less than [than]. *)
|
||||
|
||||
val is_longer : span -> than:span -> bool
|
||||
(** [is_longer span ~than] is [true] iff [span] lasts more than [than]. *)
|
||||
|
||||
(** {1:arith Arithmetic} *)
|
||||
|
||||
val add : span -> span -> span
|
||||
(** [add span span'] is [span + span'].
|
||||
|
||||
{b Warning.} Rolls over on overflow. *)
|
||||
|
||||
val abs_diff : span -> span -> span
|
||||
(** [abs_diff span span'] is the absolute difference between
|
||||
[span] and [span']. *)
|
||||
|
||||
(** {1:const Durations} *)
|
||||
|
||||
val ( * ) : int -> span -> span
|
||||
(** [n * dur] is [n] times duration [dur].
|
||||
|
||||
{b Warning.} Does not check for overflow or that [n] is
|
||||
positive. *)
|
||||
|
||||
val ns : span
|
||||
(** [ns] is a nanosecond duration, 1·10{^-9}s.
|
||||
@since 1.4.0 *)
|
||||
|
||||
val us : span
|
||||
(** [us] is a microsecond duration, 1·10{^-6}s.
|
||||
@since 1.4.0 *)
|
||||
|
||||
val ms : span
|
||||
(** [ms] is a millisecond duration, 1·10{^-3}s.
|
||||
@since 1.4.0 *)
|
||||
|
||||
val s : span
|
||||
(** [s] is a second duration, 1s.
|
||||
@since 1.4.0 *)
|
||||
|
||||
val min : span
|
||||
(** [min] is a minute duration, 60s.
|
||||
@since 1.4.0 *)
|
||||
|
||||
val hour : span
|
||||
(** [hour] is an hour duration, 3600s.
|
||||
@since 1.4.0 *)
|
||||
|
||||
val day : span
|
||||
(** [day] is a day duration, 86'400s.
|
||||
@since 1.4.0 *)
|
||||
|
||||
val year : span
|
||||
(** [year] is a Julian year duration (365.25 days), 31'557'600s. *)
|
||||
|
||||
(** {1:convert Converting} *)
|
||||
|
||||
val to_uint64_ns : span -> int64
|
||||
(** [to_uint64_ns span] is [span] as an {e unsigned} 64-bit integer
|
||||
nanosecond span. *)
|
||||
|
||||
val of_uint64_ns : int64 -> span
|
||||
(** [of_uint64_ns u] is the {e unsigned} 64-bit integer nanosecond
|
||||
span [u] as a span. *)
|
||||
|
||||
val of_float_ns : float -> span option
|
||||
(** [of_float_ns f] is the positive floating point nanosecond span [f] as
|
||||
a span. This is [None] if [f] is negative, non finite, or
|
||||
larger or equal than 2{^53} (~104 days, the largest exact floating point
|
||||
integer).
|
||||
@since 2.0.0 *)
|
||||
|
||||
val to_float_ns : span -> float
|
||||
(** [to_float_ns s] is [span] as a nanosecond floating point span.
|
||||
Note that if [s] is larger than 2{^53} (~104 days, the largest
|
||||
exact floating point integer) the result is an approximation and
|
||||
will not round trip with {!of_float_ns}.
|
||||
@since 2.0.0 *)
|
||||
|
||||
(** {1:fmt Formatters} *)
|
||||
|
||||
val pp : Format.formatter -> span -> unit
|
||||
(** [pp] formats spans according to their magnitude using SI
|
||||
prefixes on seconds and accepted non-SI units. Years are counted
|
||||
in Julian years (365.25 SI-accepted days) as
|
||||
{{:http://www.iau.org/publications/proceedings_rules/units/}defined}
|
||||
by the International Astronomical Union.
|
||||
|
||||
Rounds towards positive infinity, i.e. over approximates, no
|
||||
duration is formatted shorter than it is.
|
||||
|
||||
The output is UTF-8 encoded, it uses U+03BC for [µs]
|
||||
(10{^-6}[s]). *)
|
||||
|
||||
val dump : Format.formatter -> t -> unit
|
||||
(** [dump ppf span] formats an unspecified raw representation of [span]
|
||||
on [ppf]. *)
|
||||
|
||||
(**/**)
|
||||
|
||||
val unsafe_of_uint64_ns_option : int64 option -> t option
|
||||
end
|
||||
|
||||
(** {1:timestamps Monotonic timestamps}
|
||||
|
||||
{b Note.} Only use timestamps if you need inter-process time
|
||||
correlation, otherwise prefer {!Mtime_clock.elapsed} and
|
||||
{{!Mtime_clock.counters}counters}. *)
|
||||
|
||||
type t
|
||||
(** The type for monotonic timestamps relative to an indeterminate
|
||||
system-wide event (e.g. last startup). Their absolute value has no
|
||||
meaning but can be used for inter-process time correlation. *)
|
||||
|
||||
val to_uint64_ns : t -> int64
|
||||
(** [to_uint64_ns t] is [t] as an {e unsigned} 64-bit integer
|
||||
nanosecond timestamp. The absolute value is meaningless. *)
|
||||
|
||||
val of_uint64_ns : int64 -> t
|
||||
(** [to_uint64_ns t] is [t] is an {e unsigned} 64-bit integer
|
||||
nanosecond timestamp as a timestamp.
|
||||
|
||||
{b Warning.} Timestamps returned by this function should only be
|
||||
used with other timestamp values that are know to come from the
|
||||
same operating system run. *)
|
||||
|
||||
val min_stamp : t
|
||||
(** [min_stamp] is the earliest timestamp. *)
|
||||
|
||||
val max_stamp : t
|
||||
(** [max_stamp] is the latest timestamp. *)
|
||||
|
||||
(** {2:preds Predicates} *)
|
||||
|
||||
val equal : t -> t -> bool
|
||||
(** [equal t t'] is [true] iff [t] and [t'] are equal. *)
|
||||
|
||||
val compare : t -> t -> int
|
||||
(** [compare t t'] orders timestamps by increasing time. *)
|
||||
|
||||
val is_earlier : t -> than:t -> bool
|
||||
(** [is_earlier t ~than] is [true] iff [t] occurred before [than]. *)
|
||||
|
||||
val is_later : t -> than:t -> bool
|
||||
(** [is_later t ~than] is [true] iff [t] occurred after [than]. *)
|
||||
|
||||
(** {2:arith Arithmetic} *)
|
||||
|
||||
val span : t -> t -> span
|
||||
(** [span t t'] is the span between [t] and [t'] regardless of the
|
||||
order between [t] and [t']. *)
|
||||
|
||||
val add_span : t -> span -> t option
|
||||
(** [add_span t s] is the timestamp [s] units later than [t] or [None] if
|
||||
the result overflows. *)
|
||||
|
||||
val sub_span : t -> span -> t option
|
||||
(** [sub_span t s] is the timestamp [s] units earlier than [t] or
|
||||
[None] if the result underflows. *)
|
||||
|
||||
(** {2:fmt Formatting} *)
|
||||
|
||||
val pp : Format.formatter -> t -> unit
|
||||
(** [pp] formats [t] as an {e unsigned} 64-bit integer
|
||||
nanosecond timestamp. Note that the absolute value is
|
||||
meaningless. *)
|
||||
|
||||
val dump : Format.formatter -> t -> unit
|
||||
(** [dump ppf t] formats an unspecified raw representation of [t] on
|
||||
[ppf]. *)
|
||||
1
unikernel/duniverse/mtime/src/mtime.mllib
Normal file
1
unikernel/duniverse/mtime/src/mtime.mllib
Normal file
|
|
@ -0,0 +1 @@
|
|||
Mtime
|
||||
7
unikernel/duniverse/mtime/src/mtime_top_init.ml
Normal file
7
unikernel/duniverse/mtime/src/mtime_top_init.ml
Normal file
|
|
@ -0,0 +1,7 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The mtime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
#install_printer Mtime.pp;;
|
||||
#install_printer Mtime.Span.pp;;
|
||||
4
unikernel/duniverse/mtime/src/top/dune
Normal file
4
unikernel/duniverse/mtime/src/top/dune
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
(library
|
||||
(name mtime_top)
|
||||
(public_name mtime.top)
|
||||
(libraries compiler-libs.toplevel mtime))
|
||||
6
unikernel/duniverse/mtime/src/top/mtime_top.ml
Normal file
6
unikernel/duniverse/mtime/src/top/mtime_top.ml
Normal file
|
|
@ -0,0 +1,6 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The mtime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
let () = ignore (Toploop.use_file Format.err_formatter "mtime_top_init.ml")
|
||||
1
unikernel/duniverse/mtime/src/top/mtime_top.mllib
Normal file
1
unikernel/duniverse/mtime/src/top/mtime_top.mllib
Normal file
|
|
@ -0,0 +1 @@
|
|||
Mtime_top
|
||||
3
unikernel/duniverse/mtime/test/dune
Normal file
3
unikernel/duniverse/mtime/test/dune
Normal file
|
|
@ -0,0 +1,3 @@
|
|||
(test
|
||||
(name min_clock)
|
||||
(libraries mtime mtime.clock))
|
||||
23
unikernel/duniverse/mtime/test/min_clock.ml
Normal file
23
unikernel/duniverse/mtime/test/min_clock.ml
Normal file
|
|
@ -0,0 +1,23 @@
|
|||
(*
|
||||
Compile with:
|
||||
|
||||
ocamlfind ocamlopt \
|
||||
-package mtime.clock -linkpkg -o min_clock.native min_clock.ml
|
||||
|
||||
ocamlfind ocamlc \
|
||||
-package mtime.clock -linkpkg -o min_clock.byte min_clock.ml
|
||||
|
||||
js_of_ocaml \
|
||||
$(ocamlfind query -format "%+(jsoo_runtime)" -r mtime.clock) \
|
||||
min_clock.byte
|
||||
*)
|
||||
|
||||
let main () =
|
||||
Format.printf "Elapsed: %a@." Mtime.Span.pp (Mtime_clock.elapsed ());
|
||||
Format.printf "Timestamp: %a@." Mtime.pp (Mtime_clock.now ());
|
||||
Format.printf "Clock period: %s@."
|
||||
(match Mtime_clock.period () with
|
||||
| None -> "unknown" | Some s -> Format.asprintf "%a" Mtime.Span.pp s);
|
||||
()
|
||||
|
||||
let () = if !Sys.interactive then () else main ()
|
||||
291
unikernel/duniverse/mtime/test/test_mtime.ml
Normal file
291
unikernel/duniverse/mtime/test/test_mtime.ml
Normal file
|
|
@ -0,0 +1,291 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The mtime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
|
||||
let test_pp_span () =
|
||||
Test.test "Mtime.pp_span" @@ fun () ->
|
||||
(* The floating point stuff here comes from the previous incarnations
|
||||
of the formatter. Let's keep that it exercices a bit the of_float_ns. *)
|
||||
let pp s =
|
||||
let s = Option.get (Mtime.Span.of_float_ns (s *. 1e+9)) in
|
||||
Format.asprintf "%a" Mtime.Span.pp s
|
||||
in
|
||||
(* sub ns scale *)
|
||||
Test.string ~__POS__ (pp 1.0e-10) "0ns";
|
||||
Test.string ~__POS__ (pp 4.0e-10) "0ns";
|
||||
Test.string ~__POS__ (pp 6.0e-10) "0ns";
|
||||
Test.string ~__POS__ (pp 9.0e-10) "0ns";
|
||||
(* ns scale *)
|
||||
Test.string ~__POS__ (pp 2.0e-9) "2ns";
|
||||
Test.string ~__POS__ (pp 2.136767676e-9) "2ns";
|
||||
Test.string ~__POS__ (pp 2.6e-9) "2ns";
|
||||
Test.string ~__POS__ (pp 2.836767676e-9) "2ns";
|
||||
(* us scale *)
|
||||
Test.string ~__POS__ (pp 2.0e-6) "2μs";
|
||||
Test.string ~__POS__ (pp 2.555e-6) "2.56μs";
|
||||
Test.string ~__POS__ (pp 2.5556e-6) "2.56μs";
|
||||
Test.string ~__POS__ (pp 99.9994e-6) "100μs";
|
||||
Test.string ~__POS__ (pp 99.9996e-6) "100μs";
|
||||
Test.string ~__POS__ (pp 100.1555e-6) "101μs";
|
||||
Test.string ~__POS__ (pp 100.5555e-6) "101μs";
|
||||
Test.string ~__POS__ (pp 100.6555e-6) "101μs";
|
||||
Test.string ~__POS__ (pp 999.4e-6) "1ms";
|
||||
Test.string ~__POS__ (pp 999.6e-6) "1ms";
|
||||
(* ms scale *)
|
||||
Test.string ~__POS__ (pp 1e-3) "1ms";
|
||||
Test.string ~__POS__ (pp 1.555e-3) "1.56ms";
|
||||
Test.string ~__POS__ (pp 1.5556e-3) "1.56ms";
|
||||
Test.string ~__POS__ (pp 99.9994e-3) "100ms";
|
||||
Test.string ~__POS__ (pp 99.9996e-3) "100ms";
|
||||
Test.string ~__POS__ (pp 100.1555e-3) "101ms";
|
||||
Test.string ~__POS__ (pp 100.5555e-3) "101ms";
|
||||
Test.string ~__POS__ (pp 100.6555e-3) "101ms";
|
||||
Test.string ~__POS__ (pp 999.4e-3) "1s";
|
||||
Test.string ~__POS__ (pp 999.6e-3) "1s";
|
||||
(* s scale *)
|
||||
Test.string ~__POS__ (pp 1.) "1s";
|
||||
Test.string ~__POS__ (pp 1.555) "1.56s";
|
||||
Test.string ~__POS__ (pp 1.5554) "1.56s";
|
||||
Test.string ~__POS__ (pp 1.5556) "1.56s";
|
||||
Test.string ~__POS__ (pp 59.) "59s";
|
||||
Test.string ~__POS__ (pp 59.9994) "1min";
|
||||
Test.string ~__POS__ (pp 59.9996) "1min";
|
||||
(* min scale *)
|
||||
Test.string ~__POS__ (pp 60.) "1min";
|
||||
Test.string ~__POS__ (pp 62.) "1min2s";
|
||||
Test.string ~__POS__ (pp 62.4) "1min3s";
|
||||
Test.string ~__POS__ (pp 3599.) "59min59s";
|
||||
(* hour scale *)
|
||||
Test.string ~__POS__ (pp 3600.0) "1h";
|
||||
Test.string ~__POS__ (pp 3629.0) "1h1min";
|
||||
Test.string ~__POS__ (pp 3660.0) "1h1min";
|
||||
Test.string ~__POS__ (pp 7164.0) "2h";
|
||||
Test.string ~__POS__ (pp 7200.0) "2h";
|
||||
Test.string ~__POS__ (pp 86399.) "1d";
|
||||
(* day scale *)
|
||||
Test.string ~__POS__ (pp 86400.) "1d";
|
||||
Test.string ~__POS__ (pp (86400. +. (23. *. 3600.))) "1d23h";
|
||||
Test.string ~__POS__ (pp (86400. +. (24. *. 3600.))) "2d";
|
||||
(* These tests come from the b0 Fmt.uint64_ns_span tes *);
|
||||
let span s =
|
||||
Format.asprintf "%a"
|
||||
Mtime.Span.pp (Mtime.Span.of_uint64_ns (Int64.of_string s));
|
||||
in
|
||||
Test.string ~__POS__ (span "0u0") "0ns";
|
||||
Test.string ~__POS__ (span "0u999") "999ns";
|
||||
Test.string ~__POS__ (span "0u1_000") "1μs";
|
||||
Test.string ~__POS__ (span "0u1_001") "1.01μs";
|
||||
Test.string ~__POS__ (span "0u1_009") "1.01μs";
|
||||
Test.string ~__POS__ (span "0u1_010") "1.01μs";
|
||||
Test.string ~__POS__ (span "0u1_011") "1.02μs";
|
||||
Test.string ~__POS__ (span "0u1_090") "1.09μs";
|
||||
Test.string ~__POS__ (span "0u1_091") "1.1μs";
|
||||
Test.string ~__POS__ (span "0u1_100") "1.1μs";
|
||||
Test.string ~__POS__ (span "0u1_101") "1.11μs";
|
||||
Test.string ~__POS__ (span "0u1_109") "1.11μs";
|
||||
Test.string ~__POS__ (span "0u1_110") "1.11μs";
|
||||
Test.string ~__POS__ (span "0u1_111") "1.12μs";
|
||||
Test.string ~__POS__ (span "0u1_990") "1.99μs";
|
||||
Test.string ~__POS__ (span "0u1_991") "2μs";
|
||||
Test.string ~__POS__ (span "0u1_999") "2μs";
|
||||
Test.string ~__POS__ (span "0u2_000") "2μs";
|
||||
Test.string ~__POS__ (span "0u2_001") "2.01μs";
|
||||
Test.string ~__POS__ (span "0u9_990") "9.99μs";
|
||||
Test.string ~__POS__ (span "0u9_991") "10μs";
|
||||
Test.string ~__POS__ (span "0u9_999") "10μs";
|
||||
Test.string ~__POS__ (span "0u10_000") "10μs";
|
||||
Test.string ~__POS__ (span "0u10_001") "10.1μs";
|
||||
Test.string ~__POS__ (span "0u10_099") "10.1μs";
|
||||
Test.string ~__POS__ (span "0u10_100") "10.1μs";
|
||||
Test.string ~__POS__ (span "0u10_101") "10.2μs";
|
||||
Test.string ~__POS__ (span "0u10_900") "10.9μs";
|
||||
Test.string ~__POS__ (span "0u10_901") "11μs";
|
||||
Test.string ~__POS__ (span "0u10_999") "11μs";
|
||||
Test.string ~__POS__ (span "0u11_000") "11μs";
|
||||
Test.string ~__POS__ (span "0u11_001") "11.1μs";
|
||||
Test.string ~__POS__ (span "0u11_099") "11.1μs";
|
||||
Test.string ~__POS__ (span "0u11_100") "11.1μs";
|
||||
Test.string ~__POS__ (span "0u11_101") "11.2μs";
|
||||
Test.string ~__POS__ (span "0u99_900") "99.9μs";
|
||||
Test.string ~__POS__ (span "0u99_901") "100μs";
|
||||
Test.string ~__POS__ (span "0u99_999") "100μs";
|
||||
Test.string ~__POS__ (span "0u100_000") "100μs";
|
||||
Test.string ~__POS__ (span "0u100_001") "101μs";
|
||||
Test.string ~__POS__ (span "0u100_999") "101μs";
|
||||
Test.string ~__POS__ (span "0u101_000") "101μs";
|
||||
Test.string ~__POS__ (span "0u101_001") "102μs";
|
||||
Test.string ~__POS__ (span "0u101_999") "102μs";
|
||||
Test.string ~__POS__ (span "0u102_000") "102μs";
|
||||
Test.string ~__POS__ (span "0u999_000") "999μs";
|
||||
Test.string ~__POS__ (span "0u999_001") "1ms";
|
||||
Test.string ~__POS__ (span "0u999_001") "1ms";
|
||||
Test.string ~__POS__ (span "0u999_999") "1ms";
|
||||
Test.string ~__POS__ (span "0u1_000_000") "1ms";
|
||||
Test.string ~__POS__ (span "0u1_000_001") "1.01ms";
|
||||
Test.string ~__POS__ (span "0u1_009_999") "1.01ms";
|
||||
Test.string ~__POS__ (span "0u1_010_000") "1.01ms";
|
||||
Test.string ~__POS__ (span "0u1_010_001") "1.02ms";
|
||||
Test.string ~__POS__ (span "0u9_990_000") "9.99ms";
|
||||
Test.string ~__POS__ (span "0u9_990_001") "10ms";
|
||||
Test.string ~__POS__ (span "0u9_999_999") "10ms";
|
||||
Test.string ~__POS__ (span "0u10_000_000") "10ms";
|
||||
Test.string ~__POS__ (span "0u10_000_001") "10.1ms";
|
||||
Test.string ~__POS__ (span "0u10_000_001") "10.1ms";
|
||||
Test.string ~__POS__ (span "0u10_099_999") "10.1ms";
|
||||
Test.string ~__POS__ (span "0u10_100_000") "10.1ms";
|
||||
Test.string ~__POS__ (span "0u10_100_001") "10.2ms";
|
||||
Test.string ~__POS__ (span "0u99_900_000") "99.9ms";
|
||||
Test.string ~__POS__ (span "0u99_900_001") "100ms";
|
||||
Test.string ~__POS__ (span "0u99_999_999") "100ms";
|
||||
Test.string ~__POS__ (span "0u100_000_000") "100ms";
|
||||
Test.string ~__POS__ (span "0u100_000_001") "101ms";
|
||||
Test.string ~__POS__ (span "0u100_999_999") "101ms";
|
||||
Test.string ~__POS__ (span "0u101_000_000") "101ms";
|
||||
Test.string ~__POS__ (span "0u101_000_001") "102ms";
|
||||
Test.string ~__POS__ (span "0u999_000_000") "999ms";
|
||||
Test.string ~__POS__ (span "0u999_000_001") "1s";
|
||||
Test.string ~__POS__ (span "0u999_999_999") "1s";
|
||||
Test.string ~__POS__ (span "0u1_000_000_000") "1s";
|
||||
Test.string ~__POS__ (span "0u1_000_000_001") "1.01s";
|
||||
Test.string ~__POS__ (span "0u1_009_999_999") "1.01s";
|
||||
Test.string ~__POS__ (span "0u1_010_000_000") "1.01s";
|
||||
Test.string ~__POS__ (span "0u1_010_000_001") "1.02s";
|
||||
Test.string ~__POS__ (span "0u1_990_000_000") "1.99s";
|
||||
Test.string ~__POS__ (span "0u1_990_000_001") "2s";
|
||||
Test.string ~__POS__ (span "0u1_999_999_999") "2s";
|
||||
Test.string ~__POS__ (span "0u2_000_000_000") "2s";
|
||||
Test.string ~__POS__ (span "0u2_000_000_001") "2.01s";
|
||||
Test.string ~__POS__ (span "0u9_990_000_000") "9.99s";
|
||||
Test.string ~__POS__ (span "0u9_999_999_999") "10s";
|
||||
Test.string ~__POS__ (span "0u10_000_000_000") "10s";
|
||||
Test.string ~__POS__ (span "0u10_000_000_001") "10.1s";
|
||||
Test.string ~__POS__ (span "0u10_099_999_999") "10.1s";
|
||||
Test.string ~__POS__ (span "0u10_100_000_000") "10.1s";
|
||||
Test.string ~__POS__ (span "0u10_100_000_001") "10.2s";
|
||||
Test.string ~__POS__ (span "0u59_900_000_000") "59.9s";
|
||||
Test.string ~__POS__ (span "0u59_900_000_001") "1min";
|
||||
Test.string ~__POS__ (span "0u59_999_999_999") "1min";
|
||||
Test.string ~__POS__ (span "0u60_000_000_000") "1min";
|
||||
Test.string ~__POS__ (span "0u60_000_000_001") "1min1s";
|
||||
Test.string ~__POS__ (span "0u60_999_999_999") "1min1s";
|
||||
Test.string ~__POS__ (span "0u61_000_000_000") "1min1s";
|
||||
Test.string ~__POS__ (span "0u61_000_000_001") "1min2s";
|
||||
Test.string ~__POS__ (span "0u119_000_000_000") "1min59s";
|
||||
Test.string ~__POS__ (span "0u119_000_000_001") "2min";
|
||||
Test.string ~__POS__ (span "0u119_999_999_999") "2min";
|
||||
Test.string ~__POS__ (span "0u120_000_000_000") "2min";
|
||||
Test.string ~__POS__ (span "0u120_000_000_001") "2min1s";
|
||||
Test.string ~__POS__ (span "0u3599_000_000_000") "59min59s";
|
||||
Test.string ~__POS__ (span "0u3599_000_000_001") "1h";
|
||||
Test.string ~__POS__ (span "0u3599_999_999_999") "1h";
|
||||
Test.string ~__POS__ (span "0u3600_000_000_000") "1h";
|
||||
Test.string ~__POS__ (span "0u3600_000_000_001") "1h1min";
|
||||
Test.string ~__POS__ (span "0u3659_000_000_000") "1h1min";
|
||||
Test.string ~__POS__ (span "0u3659_000_000_001") "1h1min";
|
||||
Test.string ~__POS__ (span "0u3659_999_999_999") "1h1min";
|
||||
Test.string ~__POS__ (span "0u3660_000_000_000") "1h1min";
|
||||
Test.string ~__POS__ (span "0u3660_000_000_001") "1h2min";
|
||||
Test.string ~__POS__ (span "0u3660_000_000_001") "1h2min";
|
||||
Test.string ~__POS__ (span "0u3660_000_000_001") "1h2min";
|
||||
Test.string ~__POS__ (span "0u3720_000_000_000") "1h2min";
|
||||
Test.string ~__POS__ (span "0u3720_000_000_001") "1h3min";
|
||||
Test.string ~__POS__ (span "0u7140_000_000_000") "1h59min";
|
||||
Test.string ~__POS__ (span "0u7140_000_000_001") "2h";
|
||||
Test.string ~__POS__ (span "0u7199_999_999_999") "2h";
|
||||
Test.string ~__POS__ (span "0u7200_000_000_000") "2h";
|
||||
Test.string ~__POS__ (span "0u7200_000_000_001") "2h1min";
|
||||
Test.string ~__POS__ (span "0u86340_000_000_000") "23h59min";
|
||||
Test.string ~__POS__ (span "0u86340_000_000_001") "1d";
|
||||
Test.string ~__POS__ (span "0u86400_000_000_000") "1d";
|
||||
Test.string ~__POS__ (span "0u86400_000_000_001") "1d1h";
|
||||
Test.string ~__POS__ (span "0u89999_999_999_999") "1d1h";
|
||||
Test.string ~__POS__ (span "0u90000_000_000_000") "1d1h";
|
||||
Test.string ~__POS__ (span "0u90000_000_000_001") "1d2h";
|
||||
Test.string ~__POS__ (span "0u169200_000_000_000") "1d23h";
|
||||
Test.string ~__POS__ (span "0u169200_000_000_001") "2d";
|
||||
Test.string ~__POS__ (span "0u169200_000_000_001") "2d";
|
||||
Test.string ~__POS__ (span "0u172799_999_999_999") "2d";
|
||||
Test.string ~__POS__ (span "0u172800_000_000_000") "2d";
|
||||
Test.string ~__POS__ (span "0u172800_000_000_001") "2d1h";
|
||||
Test.string ~__POS__ (span "0u31536000_000_000_000") "365d";
|
||||
Test.string ~__POS__ (span "0u31554000_000_000_000") "365d5h";
|
||||
Test.string ~__POS__ (
|
||||
(* Technically this should round to a year but it does get rendered.
|
||||
I don't think it matters, it's not inacurate per se. *)
|
||||
span "0u31554000_000_000_001") "365d6h";
|
||||
Test.string ~__POS__ (span "0u31557600_000_000_000") "1a";
|
||||
Test.string ~__POS__ (span "0u31557600_000_000_001") "1a1d";
|
||||
Test.string ~__POS__ (span "0u63028800_000_000_000") "1a365d";
|
||||
Test.string ~__POS__ (span "0u63093600_000_000_000") "1a365d";
|
||||
Test.string ~__POS__ (span "0u63093600_000_000_001") "2a";
|
||||
Test.string ~__POS__ (span "0u63115200_000_000_000") "2a";
|
||||
Test.string ~__POS__ (span "0u63115200_000_000_001") "2a1d";
|
||||
()
|
||||
|
||||
let test_span_compare () =
|
||||
Test.test "Mtime.Span.{compare,is_shorter,is_longer}" @@ fun () ->
|
||||
let zero_mtime = Mtime.Span.of_uint64_ns 0_L in
|
||||
let large_mtime = Mtime.Span.of_uint64_ns Int64.max_int in
|
||||
let larger_mtime = Mtime.Span.of_uint64_ns Int64.min_int in
|
||||
let max_mtime = Mtime.Span.of_uint64_ns (-1_L) in
|
||||
let test_less_than fn =
|
||||
let (<) = fn in
|
||||
assert (zero_mtime < large_mtime);
|
||||
assert (zero_mtime < larger_mtime);
|
||||
assert (zero_mtime < max_mtime);
|
||||
assert (large_mtime < larger_mtime);
|
||||
assert (large_mtime < max_mtime);
|
||||
assert (larger_mtime < max_mtime);
|
||||
()
|
||||
in
|
||||
test_less_than (fun x y -> Mtime.Span.compare x y < 0);
|
||||
test_less_than (fun x y -> Mtime.Span.is_shorter x ~than:y);
|
||||
test_less_than (fun x y -> Mtime.Span.compare y x > 0);
|
||||
test_less_than (fun x y -> Mtime.Span.is_longer y ~than:x);
|
||||
()
|
||||
|
||||
let test_span_constants () =
|
||||
Test.test "Mtime.Span.{zero,one,max_span,min_span}" @@ fun () ->
|
||||
let (<) x y = Mtime.Span.compare x y < 0 in
|
||||
assert (Mtime.Span.zero < Mtime.Span.one);
|
||||
assert (Mtime.Span.zero < Mtime.Span.max_span);
|
||||
assert (Mtime.Span.min_span < Mtime.Span.one);
|
||||
assert (Mtime.Span.min_span < Mtime.Span.max_span);
|
||||
assert (Mtime.Span.one < Mtime.Span.max_span);
|
||||
()
|
||||
|
||||
let test_span_arith () =
|
||||
Test.test "Mtime.Span.{abs_diff,add}" @@ fun () ->
|
||||
assert (Mtime.Span.(equal (add zero one) one));
|
||||
assert (Mtime.Span.(equal (add one zero) one));
|
||||
assert (Mtime.Span.(equal (add (abs_diff max_span one) one) max_span));
|
||||
()
|
||||
|
||||
let test_float_ns () =
|
||||
Test.test "Mtime.{to,of}_float_ns" @@ fun () ->
|
||||
assert (Mtime.Span.to_float_ns Mtime.Span.max_span = (2. ** 64.) -. 1.);
|
||||
assert (Mtime.Span.to_float_ns Mtime.Span.min_span = 0.);
|
||||
assert (Mtime.Span.of_float_ns (2. ** 53. -. 1.) =
|
||||
Some (Mtime.Span.of_uint64_ns (Int64.(sub (shift_left 1L 53) one))));
|
||||
assert (Mtime.Span.of_float_ns (2. ** 53.) = None);
|
||||
assert (Mtime.Span.of_float_ns 0. = Some Mtime.Span.zero);
|
||||
assert (Mtime.Span.of_float_ns (-.0.) = Some Mtime.Span.zero);
|
||||
assert (Mtime.Span.of_float_ns infinity = None);
|
||||
assert (Mtime.Span.of_float_ns nan = None);
|
||||
assert (Mtime.Span.of_float_ns (-3.) = None);
|
||||
assert (Mtime.Span.of_float_ns 1. = Some Mtime.Span.one);
|
||||
()
|
||||
|
||||
let main () =
|
||||
Test.main @@ fun () ->
|
||||
test_pp_span ();
|
||||
test_span_compare ();
|
||||
test_span_constants ();
|
||||
test_span_arith ();
|
||||
test_float_ns ();
|
||||
()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
62
unikernel/duniverse/mtime/test/test_mtime_clock.ml
Normal file
62
unikernel/duniverse/mtime/test/test_mtime_clock.ml
Normal file
|
|
@ -0,0 +1,62 @@
|
|||
(*---------------------------------------------------------------------------
|
||||
Copyright (c) 2015 The mtime programmers. All rights reserved.
|
||||
SPDX-License-Identifier: ISC
|
||||
---------------------------------------------------------------------------*)
|
||||
|
||||
open B0_testing
|
||||
|
||||
(* Note nothing is being asserted in these tests. *)
|
||||
|
||||
let test_available () = try ignore (Mtime_clock.elapsed ()) with
|
||||
| Sys_error e -> Test.failstop "No monotonic time available: %s" e
|
||||
|
||||
let test_counters () =
|
||||
Test.test "Mtime_clock.counter" @@ fun () ->
|
||||
let count max =
|
||||
let c = Mtime_clock.counter () in
|
||||
for i = 1 to max do () done;
|
||||
Mtime_clock.count c
|
||||
in
|
||||
let do_count max =
|
||||
let span = count max in
|
||||
let span_ns = Mtime.Span.to_uint64_ns span in
|
||||
Test.log "Count to % 8d: %10Luns %gs %a"
|
||||
max span_ns (Mtime.Span.to_float_ns span *. 1e-9) Mtime.Span.pp span
|
||||
in
|
||||
do_count 1000000;
|
||||
do_count 100000;
|
||||
do_count 10000;
|
||||
do_count 1000;
|
||||
do_count 100;
|
||||
do_count 10;
|
||||
do_count 1;
|
||||
()
|
||||
|
||||
let test_elapsed () =
|
||||
Test.test "Mtime_clock.elapsed ns - s - pp - dump" @@ fun () ->
|
||||
let span = Mtime_clock.elapsed () in
|
||||
Test.log " %Luns - %gs - %a - %a"
|
||||
(Mtime.Span.to_uint64_ns span)
|
||||
(Mtime.Span.to_float_ns span *. 1e-9)
|
||||
Mtime.Span.pp span
|
||||
Mtime.Span.dump span;
|
||||
()
|
||||
|
||||
let test_now () =
|
||||
Test.test "Mtime_clock.now ns - s - pp - dump " @@ fun () ->
|
||||
let t = Mtime_clock.now () in
|
||||
let span = Mtime.(span t (of_uint64_ns 0_L)) in
|
||||
Test.log " %Luns - %gs - %a - %a"
|
||||
(Mtime.to_uint64_ns t) (Mtime.Span.to_float_ns span *. 1e-9)
|
||||
Mtime.pp t Mtime.dump t;
|
||||
()
|
||||
|
||||
let main () =
|
||||
Test.main @@ fun () ->
|
||||
test_available ();
|
||||
test_counters ();
|
||||
test_elapsed ();
|
||||
test_now ();
|
||||
()
|
||||
|
||||
let () = if !Sys.interactive then () else exit (main ())
|
||||
Loading…
Add table
Add a link
Reference in a new issue