diff --git a/README.md b/README.md index fab94d5..f166dc7 100644 --- a/README.md +++ b/README.md @@ -3,7 +3,7 @@ Provides a clock that returns nondecreasing values and is not affected by (user-adjustable) system time. -## [Function] monotonic-now &optional mode +## [Function] monotonic-now &optional mode include-suspend-p Return the current monotonic time in monotonic time units. @@ -11,6 +11,9 @@ If `mode` is `nil` (the default) the monotonic time is possibly affected by NTP. If it is `:raw`, effort is made to return a monotonic time that is not affected by NTP. +If `include-suspend-p` is true, time spent while the system is suspended is +included. The default is platform dependent. + ## [Function] monotonic-time-units-per-second Return the number of monotonic time units in one second. @@ -18,7 +21,7 @@ Return the number of monotonic time units in one second. The value returned should remain valid for the duration of the running Lisp process, but no guarantee is made beyond this extent. -## [Function] monotonic-now/ms &optional mode +## [Function] monotonic-now/ms &optional mode include-suspend-p A convenience function to return the current monotonic time in milliseconds. diff --git a/darwin-grovel.lisp b/darwin-grovel.lisp new file mode 100644 index 0000000..ecbd6f0 --- /dev/null +++ b/darwin-grovel.lisp @@ -0,0 +1,4 @@ +(in-package #:monotonic-clock) + +(include "mach.h") +(include "mach/mach_time.h") diff --git a/darwin.lisp b/darwin.lisp new file mode 100644 index 0000000..69f646a --- /dev/null +++ b/darwin.lisp @@ -0,0 +1,36 @@ +(in-package #:monotonic-clock) + +;; https://developer.apple.com/library/content/qa/qa1398/_index.html + +(defcfun ("mach_absolute_time" mach-absolute-time) :uint64) + +(defcstruct mach-timebase-info + (numer :uint32) + (denom :uint32)) + +(defcfun ("mach_timebase_info" mach-timebase-info) :void + (timebase-info :pointer)) + +(declaim (inline monotonic-time-units-per-second)) +(defun monotonic-time-units-per-second () + "Return the number of monotonic time units in one second. + +The value returned should remain valid for the duration of the running +Lisp process, but no guarantee is made beyond this extent." + (load-time-value + (with-foreign-object (ti '(:struct mach-timebase-info)) + (mach-timebase-info ti) + (with-foreign-slots ((numer denom) ti (:struct mach-timebase-info)) + (truncate (* 1000000000 (/ numer denom))))))) + +(defun monotonic-now (&optional mode include-suspend-p) + "Return the current monotonic time in monotonic time units. + +MODE is ignored. The monotonic time is not affected by NTP. + +If INCLUDE-SUSPEND-P is true, time spent while the system is suspended is +included. The default is false." + (declare (ignore mode)) + (assert (not include-suspend-p) (include-suspend-p) + "Does not support INCLUDE-SUSPEND-P = true.") + (mach-absolute-time)) diff --git a/linux.lisp b/linux.lisp index f42ccb2..f0bc5bf 100644 --- a/linux.lisp +++ b/linux.lisp @@ -29,12 +29,17 @@ The value returned should remain valid for the duration of the running Lisp process, but no guarantee is made beyond this extent." 1000000000) -(defun monotonic-now (&optional mode) +(defun monotonic-now (&optional mode include-suspend-p) "Return the current monotonic time in monotonic time units. If MODE is NIL (the default) the monotonic time is possibly affected by NTP. If it is :RAW, effort is made to return a monotonic time that -is not affected by NTP." +is not affected by NTP. + +If INCLUDE-SUSPEND-P is true, time spent while the system is suspended is +included. The default is false." + (assert (not include-suspend-p) (include-suspend-p) + "Does not support INCLUDE-SUSPEND-P = true.") (multiple-value-bind (sec nsec) (clock-gettime (ecase mode ((nil) clock-monotonic) diff --git a/monotonic-clock.asd b/monotonic-clock.asd index 9227263..e41ccf1 100644 --- a/monotonic-clock.asd +++ b/monotonic-clock.asd @@ -6,11 +6,15 @@ :description "A nondecreasing clock that is not affected by user settings." :author "death " :license "MIT" - :defsystem-depends-on (#+linux #:cffi-grovel) + :defsystem-depends-on (#+(or linux darwin windows) #:cffi-grovel) :depends-on (#:cffi) :serial t :components ((:file "packages") #+linux (:cffi-grovel-file "linux-grovel") #+linux (:file "linux") + #+darwin (:cffi-grovel-file "darwin-grovel") + #+darwin (:file "darwin") + #+windows (:cffi-grovel-file "windows-grovel") + #+windows (:file "windows") (:file "convenience"))) diff --git a/windows-grovel.lisp b/windows-grovel.lisp new file mode 100644 index 0000000..b23267f --- /dev/null +++ b/windows-grovel.lisp @@ -0,0 +1,3 @@ +(in-package #:monotonic-clock) + +(include "Windows.h") diff --git a/windows.lisp b/windows.lisp new file mode 100644 index 0000000..673402a --- /dev/null +++ b/windows.lisp @@ -0,0 +1,25 @@ +(in-package #:monotonic-clock) + +;; https://msdn.microsoft.com/en-us/library/windows/desktop/ms724411%28v=vs.85%29.aspx + +(defcfun ("GetTickCount64" get-tick-count-64) :uint64) + +(declaim (inline monotonic-time-units-per-second)) +(defun monotonic-time-units-per-second () + "Return the number of monotonic time units in one second. + +The value returned should remain valid for the duration of the running +Lisp process, but no guarantee is made beyond this extent." + 1000) + +(defun monotonic-now (&optional mode (include-suspend-p t)) + "Return the current monotonic time in monotonic time units. + +MODE is ignored. The monotonic time is not affected by NTP. + +If INCLUDE-SUSPEND-P is true, time spent while the system is suspended is +included. The default is true." + (declare (ignore mode)) + (assert include-suspend-p (include-suspend-p) + "Does not support INCLUDE-SUSPEND-P = false.") + (get-tick-count-64))