[WIP] Windows and Darwin support

README.md

@@ -3,22 +3,25 @@
 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.
 
 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.
 
 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.

darwin-grovel.lisp

@@ -0,0 +1,4 @@
+(in-package #:monotonic-clock)
+
+(include "mach.h")
+(include "mach/mach_time.h")

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))

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)

monotonic-clock.asd

@@ -6,11 +6,15 @@
   :description "A nondecreasing clock that is not affected by user settings."
   :author "death <github.com/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")))

windows-grovel.lisp

@@ -0,0 +1,3 @@
+(in-package #:monotonic-clock)
+
+(include "Windows.h")

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))