1.0.28.66: implement SB-EXT:GET-TIME-OF-DAY

 * On unixoid platforms is this pretty much what UNIX-GETTIMEOFDAY
   used to be, whereas on Windows we build it on top of
   SystemTimeAsFileTime since gettimeofday() doesn't give us
   microseconds there -- it's almost as if the POSIX API support on
   Windows as intentionally sucky...

 * Keep UNIX-GETTIMEOFDAY around as a wrapper to GET-TIME-OF-DAY,
   since there are applications in the wild that use it directly.
   Scheduled for deletion towards to the end of 2009, or so.

diff --git a/NEWS b/NEWS
index 4b3e1a9..a3dacf7 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -10,6 +10,8 @@
     :HASH-FUNCTION argument. Refer to user manual for details.
   * new feature: SB-EXT:DEFGLOBAL macro allows defining global non-special
     variables.
+  * new feature: SB-EXT:GET-TIME-OF-DAY provides access to seconds and
+    microseconds since the Unix epoch on all platforms.
   * new feature: SB-EXT:ALWAYS-BOUND proclamation inhibits MAKUNBOUND, and
     allows the compiler to safely elide boundedness checks for special
     variables.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 138f893..44e6e46 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -586,8 +586,9 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
                "COMPARE-AND-SWAP"
                "ATOMIC-INCF"
 
-               ;; Timing information
+               ;; Time related things
                "CALL-WITH-TIMING"
+               "GET-TIME-OF-DAY"
 
                ;; People have various good reasons to mess with the GC.
                "*AFTER-GC-HOOKS*"

diff --git a/src/code/time.lisp b/src/code/time.lisp
index 834f143..6cdb53d 100644 (file)
--- a/src/code/time.lisp
+++ b/src/code/time.lisp
@@ -95,9 +95,7 @@ Includes both \"system\" and \"user\" time."
   #!+sb-doc
   "Return a single integer for the current time of day in universal time
 format."
-  (multiple-value-bind (res secs) (sb!unix:unix-gettimeofday)
-    (declare (ignore res))
-    (+ secs unix-to-universal-time)))
+  (+ (get-time-of-day) unix-to-universal-time))
 
 (defun get-decoded-time ()
   #!+sb-doc

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 3abc1d1..fb70a51 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -838,39 +838,6 @@ corresponds to NAME, or NIL if there is none."
   (struct timezone
     (tz-minuteswest int)                ; minutes west of Greenwich
     (tz-dsttime int)))                  ; type of dst correction
-
-;;; If it works, UNIX-GETTIMEOFDAY returns 5 values: T, the seconds
-;;; and microseconds of the current time of day, the timezone (in
-;;; minutes west of Greenwich), and a daylight-savings flag. If it
-;;; doesn't work, it returns NIL and the errno.
-#!-sb-fluid (declaim (inline unix-gettimeofday))
-(defun unix-gettimeofday ()
-  #!+(and x86-64 darwin)
-  (with-alien ((tv (struct timeval)))
-    ;; CLH: FIXME! This seems to be a MacOS bug, but on x86-64/darwin,
-    ;; gettimeofday occasionally fails. passing in a null pointer for
-    ;; the timezone struct seems to work around the problem. I can't
-    ;; find any instances in the SBCL where we actually ues the
-    ;; timezone values, so we just punt for the moment.
-    (syscall* ("gettimeofday" (* (struct timeval))
-                              (* (struct timezone)))
-              (values t
-                      (slot tv 'tv-sec)
-                      (slot tv 'tv-usec))
-              (addr tv)
-              nil))
-  #!-(and x86-64 darwin)
-  (with-alien ((tv (struct timeval))
-               (tz (struct timezone)))
-    (syscall* ("gettimeofday" (* (struct timeval))
-                              (* (struct timezone)))
-              (values t
-                      (slot tv 'tv-sec)
-                      (slot tv 'tv-usec)
-                      (slot tz 'tz-minuteswest)
-                      (slot tz 'tz-dsttime))
-              (addr tv)
-              (addr tz))))
 \f
 
 ;; Type of the second argument to `getitimer' and
@@ -956,12 +923,40 @@ corresponds to NAME, or NIL if there is none."
 ;;; Windows build.
 #!-win32
 (progn
+
+  #!-sb-fluid (declaim (inline get-time-of-day))
+  (defun get-time-of-day ()
+    "Return the number of seconds and microseconds since the beginning og
+the UNIX epoch (January 1st 1970.)"
+    #!+darwin
+    (with-alien ((tv (struct timeval)))
+      ;; CLH: FIXME! This seems to be a MacOS bug, but on x86-64/darwin,
+      ;; gettimeofday occasionally fails. passing in a null pointer for the
+      ;; timezone struct seems to work around the problem. NS notes: Darwin
+      ;; manpage says the timezone is not used anymore in their implementation
+      ;; at all.
+      (syscall* ("gettimeofday" (* (struct timeval))
+                                (* (struct timezone)))
+                (values (slot tv 'tv-sec)
+                        (slot tv 'tv-usec))
+                (addr tv)
+                nil))
+    #!-(and x86-64 darwin)
+    (with-alien ((tv (struct timeval))
+                 (tz (struct timezone)))
+      (syscall* ("gettimeofday" (* (struct timeval))
+                                (* (struct timezone)))
+                (values (slot tv 'tv-sec)
+                        (slot tv 'tv-usec))
+                (addr tv)
+                (addr tz))))
+
   (declaim (inline system-internal-run-time
                    system-real-time-values))
 
   (defun system-real-time-values ()
-    (multiple-value-bind (_ sec usec) (unix-gettimeofday)
-      (declare (ignore _) (type (unsigned-byte 32) sec usec))
+    (multiple-value-bind (sec usec) (get-time-of-day)
+      (declare (type (unsigned-byte 32) sec usec))
       (values sec (truncate usec micro-seconds-per-internal-time-unit))))
 
   ;; There are two optimizations here that actually matter (on 32-bit
@@ -1036,6 +1031,17 @@ corresponds to NAME, or NIL if there is none."
                               micro-seconds-per-internal-time-unit))))
         result))))
 \f
+;;; FIXME, KLUDGE: GET-TIME-OF-DAY used to be UNIX-GETTIMEOFDAY, and had a
+;;; primary return value indicating sucess, and also returned timezone
+;;; information -- though the timezone data was not there on Darwin.
+;;; Now we have GET-TIME-OF-DAY, but it turns out that despite SB-UNIX being
+;;; an implementation package UNIX-GETTIMEOFDAY has users in the wild.
+;;; So we're stuck with it for a while -- maybe delete it towards the end
+;;; of 2009.
+(defun unix-gettimeofday ()
+  (multiple-value-bind (sec usec) (get-time-of-day)
+    (values t sec usec nil nil)))
+\f
 ;;;; opendir, readdir, closedir, and dirent-name
 
 (declaim (inline unix-opendir))

diff --git a/src/code/win32.lisp b/src/code/win32.lisp
index facc8c9..fb3d5c1 100644 (file)
--- a/src/code/win32.lisp
+++ b/src/code/win32.lisp
@@ -530,6 +530,51 @@
   (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 og 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.

diff --git a/version.lisp-expr b/version.lisp-expr
index a8b2452..e8d9473 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.28.65"
+"1.0.28.66"