From dc981e6c25bbc2abd48c8d48a424c6bd55e905bb Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Thu, 5 Apr 2007 12:24:27 +0000 Subject: [PATCH] 1.0.4.28: optimize GET-INTERNAL-REAL-TIME on Unix. * Avoid bignum computations, and cache the final result for reuse. --- NEWS | 2 ++ package-data-list.lisp-expr | 2 +- src/code/time.lisp | 16 +++++-------- src/code/unix.lisp | 52 +++++++++++++++++++++++++++++++++++++------ src/code/win32.lisp | 18 ++++++++++----- version.lisp-expr | 2 +- 6 files changed, 68 insertions(+), 24 deletions(-) diff --git a/NEWS b/NEWS index 6efc3c2..d67ccfe 100644 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4