From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Sat, 3 Jan 2009 17:05:44 +0000 (+0000)
Subject: 1.0.24.19: COMPILE-TIME reports timings at millisecond accuracy
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=2f492b2a39b1361e1dd97d5243bc47238b98ca8f;p=sbcl.git

1.0.24.19: COMPILE-TIME reports timings at millisecond accuracy

 * Patch by Luis Oliveira.
---

diff --git a/NEWS b/NEWS
index 4aec9ca..7830d10 100644
--- a/NEWS
+++ b/NEWS
@@ -10,6 +10,8 @@ changes in sbcl-1.0.25 relative to 1.0.24:
   * improvement: GET-SETF-EXPANDER avoids adding bindings for constant
     arguments, making compiler-macros for SETF-functions able to inspect
     their constant arguments.
+  * improvement: COMPILE-FILE reports times with millisecond accuracy
+    (thanks to Luis Oliveira)
   * optimization: CHAR-CODE type derivation has been improved, making
     TYPEP elimination on subtypes of CHARACTER work better. (reported
     by Tobias Rittweiler, patch by Paul Khuong)
diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 14c3b43..f1fc851 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -758,7 +758,7 @@
                               (print-unreadable-object (s stream :type t))))
              (:copier nil))
   ;; the UT that compilation started at
-  (start-time (get-universal-time) :type unsigned-byte)
+  (start-time (get-internal-real-time) :type unsigned-byte)
   ;; the FILE-INFO structure for this compilation
   (file-info nil :type (or file-info null))
   ;; the stream that we are using to read the FILE-INFO, or NIL if
@@ -1606,10 +1606,13 @@
             ((try-with-type pathname "lisp"  nil))
             ((try-with-type pathname "lisp"  t))))))
 
-(defun elapsed-time-to-string (tsec)
-  (multiple-value-bind (tmin sec) (truncate tsec 60)
-    (multiple-value-bind (thr min) (truncate tmin 60)
-      (format nil "~D:~2,'0D:~2,'0D" thr min sec))))
+(defun elapsed-time-to-string (internal-time-delta)
+  (multiple-value-bind (tsec remainder)
+      (truncate internal-time-delta internal-time-units-per-second)
+    (let ((ms (truncate remainder (/ internal-time-units-per-second 1000))))
+      (multiple-value-bind (tmin sec) (truncate tsec 60)
+        (multiple-value-bind (thr min) (truncate tmin 60)
+          (format nil "~D:~2,'0D:~2,'0D.~3,'0D" thr min sec ms))))))
 
 ;;; Print some junk at the beginning and end of compilation.
 (defun print-compile-start-note (source-info)
@@ -1630,7 +1633,7 @@
   (compiler-mumble "~&; compilation ~:[aborted after~;finished in~] ~A~&"
                    won
                    (elapsed-time-to-string
-                    (- (get-universal-time)
+                    (- (get-internal-real-time)
                        (source-info-start-time source-info))))
   (values))
 
diff --git a/version.lisp-expr b/version.lisp-expr
index 2112b35..297a8de 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.24.18"
+"1.0.24.19"