1.0.4.28: optimize GET-INTERNAL-REAL-TIME on Unix.

 * Avoid bignum computations, and cache the final result for reuse.

diff --git a/NEWS b/NEWS
index 6efc3c2..d67ccfe 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -10,6 +10,8 @@ changes in sbcl-1.0.5 relative to sbcl-1.0.4:
     documented as unsafe.
   * documentation: SB-SYS:WITHOUT-GCING has been documented as unsafe
     in multithreaded application code.
+  * optimization: GET-INTERNAL-REAL-TIME has been optimized on POSIX
+    platforms. (thanks to James Anderson for the optimization hint)
   * bug fix: number of characters that can be written onto a single
     line in a file is unlimited.
   * bug fix: GC deadlocks from asynchronous interrupts has been fixed

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index fe1ab00..2f05952 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1992,7 +1992,7 @@ SB-KERNEL) have been undone, but probably more remain."
                ;; FIXME: STRUCTURE!OBJECT stuff probably belongs in SB!KERNEL.
                "STRUCTURE!OBJECT" "STRUCTURE!OBJECT-MAKE-LOAD-FORM"
                "SYSTEM-AREA-POINTER" "SYSTEM-AREA-POINTER-P"
-               "SYSTEM-INTERNAL-REAL-TIME"
+               "REINIT-INTERNAL-REAL-TIME"
                "SYSTEM-INTERNAL-RUN-TIME"
                "UNDEFINED-FOREIGN-SYMBOLS-P"
                "UPDATE-LINKAGE-TABLE" "VECTOR-SAP"

diff --git a/src/code/time.lisp b/src/code/time.lisp
index 9a6d825..60bf2a5 100644 (file)
--- a/src/code/time.lisp
+++ b/src/code/time.lisp
@@ -11,18 +11,14 @@
 
 (in-package "SB!IMPL")
 
-;;; Internal epoch, used as base for real-time.
-(declaim (unsigned-byte *internal-epoch*))
-(defvar *internal-epoch* 0)
-
 (defun time-reinit ()
-  (setf *internal-epoch* (system-internal-real-time)))
+  (reinit-internal-real-time))
 
-(defun get-internal-real-time ()
-  #!+sb-doc
-  "Return the real time (\"wallclock time\") since startup in the internal
-time format. (See INTERNAL-TIME-UNITS-PER-SECOND.)"
-  (- (system-internal-real-time) *internal-epoch*))
+;;; Implemented in unix.lisp and win32.lisp.
+#!+sb-doc
+(setf (fdocumentation 'get-internal-real-time 'function)
+      "Return the real time (\"wallclock time\") since startup in the internal
+time format. (See INTERNAL-TIME-UNITS-PER-SECOND.)")
 
 (defun get-internal-run-time ()
   #!+sb-doc

diff --git a/src/code/unix.lisp b/src/code/unix.lisp
index 5147726..606afda 100644 (file)
--- a/src/code/unix.lisp
+++ b/src/code/unix.lisp
@@ -966,15 +966,53 @@ SYSCALL-FORM. Repeat evaluation of SYSCALL-FORM if it is interrupted."
   (defconstant micro-seconds-per-internal-time-unit
     (/ 1000000 sb!xc:internal-time-units-per-second))
 
-  (declaim (inline system-internal-real-time system-internal-run-time))
-  (defun system-internal-real-time ()
+  (declaim (inline system-internal-run-time
+                   internal-real-time-values))
+
+  (defun internal-real-time-values ()
     (multiple-value-bind (ignore seconds useconds) (unix-gettimeofday)
       (declare (ignore ignore) (type (unsigned-byte 32) seconds useconds))
-      (let ((uint (truncate useconds
-                            micro-seconds-per-internal-time-unit)))
-        (declare (type (unsigned-byte 32) uint))
-        (+ (* seconds sb!xc:internal-time-units-per-second)
-           uint))))
+      (values seconds (truncate useconds micro-seconds-per-internal-time-unit))))
+
+  ;; There are two optimizations here that actually matter (on 32-bit
+  ;; systems): substract the epoch from seconds and milliseconds
+  ;; separately, as those should remain fixnums for the first 17 years
+  ;; or so of runtime. Also, avoid doing consing a new bignum if the
+  ;; result would be = to the last result given.
+  ;;
+  ;; Note: the next trick would be to spin a separate thread to update
+  ;; a global value once per internal tick, so each individual call to
+  ;; get-internal-real-time would be just a memory read... but that is
+  ;; probably best left for user-level code. ;)
+  ;;
+  ;; Thanks to James Anderson for the optimization hint.
+  ;;
+  ;; Yes, it is possible to a computation to be GET-INTERNAL-REAL-TIME
+  ;; bound.
+  ;;
+  ;; --NS 2007-04-05
+  (let ((e-sec 0)
+        (e-msec 0)
+        (c-sec 0)
+        (c-msec 0)
+        (now 0))
+    (declare (type (unsigned-byte 32) e-sec c-sec)
+             (type fixnum e-msec c-msec)
+             (type unsigned-byte now))
+    (defun reinit-internal-real-time ()
+      (setf (values e-sec e-msec) (internal-real-time-values)
+            c-sec 0
+            c-msec 0))
+    ;; If two threads call this at the same time, we're still safe, I believe,
+    ;; as long as NOW is updated before either of C-MSEC or C-SEC. --NS
+    (defun get-internal-real-time ()
+      (multiple-value-bind (sec msec) (internal-real-time-values)
+        (unless (and (= msec c-msec) (= sec c-sec))
+          (setf now (+ (* (- sec e-sec) sb!xc:internal-time-units-per-second)
+                       (- msec e-msec))
+                c-msec msec
+                c-sec sec))
+        now)))
 
   (defun system-internal-run-time ()
     (multiple-value-bind (ignore utime-sec utime-usec stime-sec stime-usec)

diff --git a/src/code/win32.lisp b/src/code/win32.lisp
index 4b18a45..c91d9aa 100644 (file)
--- a/src/code/win32.lisp
+++ b/src/code/win32.lisp
@@ -512,11 +512,19 @@
                (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))))
+
+(let ((epoch 0))
+  (declare (unsigned-byte epoch))
+  ;; FIXME: For optimization ideas see the unix implementation.
+  (defun reinit-internal-real-time ()
+    (setf epoch 0
+          epoch (system-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)

diff --git a/version.lisp-expr b/version.lisp-expr
index 492094b..fc2febb 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.4.27"
+"1.0.4.28"