X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fwin32.lisp;h=3aef59335d89c05c7d259545dc007ef8969bc75f;hb=65b5ab7e713d04e0d76bc0ee196374f6e57b922f;hp=4b18a459a8ad7bc1fe23259d94761de185d4369c;hpb=0d5ff04e2ced1cbb2979dd1a7fcfd7ba3d6da7c1;p=sbcl.git

diff --git a/src/code/win32.lisp b/src/code/win32.lisp
index 4b18a45..3aef593 100644
--- a/src/code/win32.lisp
+++ b/src/code/win32.lisp
@@ -511,17 +511,70 @@
                (addr ,kernel-time)
                (addr ,user-time))))
 
-(declaim (inline system-internal-real-time system-internal-run-time))
-(defun system-internal-real-time ()
-  (with-alien ((system-time filetime))
-    (syscall (("GetSystemTimeAsFileTime" 4) void (* filetime))
-             (values (floor system-time 100ns-per-internal-time-unit))
-             (addr system-time))))
+(declaim (inline system-internal-real-time))
+
+(let ((epoch 0))
+  (declare (unsigned-byte epoch))
+  ;; FIXME: For optimization ideas see the unix implementation.
+  (defun reinit-internal-real-time ()
+    (setf epoch 0
+          epoch (get-internal-real-time)))
+  (defun get-internal-real-time ()
+    (- (with-alien ((system-time filetime))
+         (syscall (("GetSystemTimeAsFileTime" 4) void (* filetime))
+                  (values (floor system-time 100ns-per-internal-time-unit))
+                  (addr system-time)))
+       epoch)))
 
 (defun system-internal-run-time ()
   (with-process-times (creation-time exit-time kernel-time user-time)
     (values (floor (+ user-time kernel-time) 100ns-per-internal-time-unit))))
 
+(define-alien-type hword (unsigned 16))
+
+(define-alien-type systemtime
+    (struct systemtime
+            (year hword)
+            (month hword)
+            (weekday hword)
+            (day hword)
+            (hour hword)
+            (minute hword)
+            (second hword)
+            (millisecond hword)))
+
+;; Obtained with, but the XC can't deal with that -- but
+;; it's not like the value is ever going to change...
+;; (with-alien ((filetime filetime)
+;;              (epoch systemtime))
+;;   (setf (slot epoch 'year) 1970
+;;         (slot epoch 'month) 1
+;;         (slot epoch 'day) 1
+;;         (slot epoch 'hour) 0
+;;         (slot epoch 'minute) 0
+;;         (slot epoch 'second) 0
+;;         (slot epoch 'millisecond) 0)
+;;   (syscall (("SystemTimeToFileTime" 8) void
+;;             (* systemtime) (* filetime))
+;;            filetime
+;;            (addr epoch)
+;;            (addr filetime)))
+(defconstant +unix-epoch-filetime+ 116444736000000000)
+
+#!-sb-fluid
+(declaim (inline get-time-of-day))
+(defun get-time-of-day ()
+  "Return the number of seconds and microseconds since the beginning of the
+UNIX epoch: January 1st 1970."
+  (with-alien ((system-time filetime))
+    (syscall (("GetSystemTimeAsFileTime" 4) void (* filetime))
+             (multiple-value-bind (sec 100ns)
+                 (floor (- system-time +unix-epoch-filetime+)
+                        (* 100ns-per-internal-time-unit
+                           internal-time-units-per-second))
+               (values sec (floor 100ns 10)))
+             (addr system-time))))
+
 ;; SETENV
 ;; The SetEnvironmentVariable function sets the contents of the specified
 ;; environment variable for the current process.