X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftime.lisp;h=9ae42fcbfb9b69d2a1916c0269c611ee1c8119ed;hb=4cacd5df6c36c1815db4f09767017f5b85757ed1;hp=4bb9d9c42737f6bed288147f67a3bdc9d0b8b434;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/code/time.lisp b/src/code/time.lisp
index 4bb9d9c..9ae42fc 100644
--- a/src/code/time.lisp
+++ b/src/code/time.lisp
@@ -11,9 +11,6 @@
 
 (in-package "SB!IMPL")
 
-(file-comment
-  "$Header$")
-
 (defconstant internal-time-units-per-second 100
   #!+sb-doc
   "The number of internal time units that fit into a second. See
@@ -31,7 +28,7 @@
 (defun get-internal-real-time ()
   #!+sb-doc
   "Return the real time in the internal time format. This is useful for
-  finding elapsed time. See Internal-Time-Units-Per-Second."
+  finding elapsed time. See INTERNAL-TIME-UNITS-PER-SECOND."
   ;; FIXME: See comment on OPTIMIZE declaration in GET-INTERNAL-RUN-TIME.
   (declare (optimize (speed 3) (safety 3)))
   (multiple-value-bind (ignore seconds useconds) (sb!unix:unix-gettimeofday)
@@ -50,7 +47,6 @@
 	     (setq *internal-real-time-base-seconds* seconds)
 	     uint)))))
 
-#!-(and sparc svr4)
 (defun get-internal-run-time ()
   #!+sb-doc
   "Return the run time in the internal time format. This is useful for
@@ -71,26 +67,15 @@
 	     ;; documented anywhere and the observed behavior is to
 	     ;; sometimes return 1000000 exactly.)
 	     (type (integer 0 1000000) utime-usec stime-usec))
-    (+ (the (unsigned-byte 32)
-	    (* (the (unsigned-byte 32) (+ utime-sec stime-sec))
-	       internal-time-units-per-second))
-       (truncate (+ utime-usec stime-usec)
-		 micro-seconds-per-internal-time-unit))))
 
-#!+(and sparc svr4)
-(defun get-internal-run-time ()
-  #!+sb-doc
-  "Return the run time in the internal time format. This is useful for
-  finding CPU usage."
-  (declare (values (unsigned-byte 32)))
-  ;; FIXME: See comment on OPTIMIZE declaration in other
-  ;; version of GET-INTERNAL-RUN-TIME.
-  (declare (optimize (speed 3) (safety 3)))
-  (multiple-value-bind (ignore utime stime cutime cstime)
-      (sb!unix:unix-times)
-    (declare (ignore ignore cutime cstime)
-	     (type (unsigned-byte 31) utime stime))
-    (the (unsigned-byte 32) (+ utime stime))))
+    (let ((result (+ (the (unsigned-byte 32)
+			  (* (the (unsigned-byte 32) (+ utime-sec stime-sec))
+			     internal-time-units-per-second))
+		     (floor (+ utime-usec
+			       stime-usec
+			       (floor micro-seconds-per-internal-time-unit 2))
+			    micro-seconds-per-internal-time-unit))))
+      result)))
 
 ;;;; Encode and decode universal times.
 
@@ -102,9 +87,9 @@
   (minutes-west sb!c-call:int :out)
   (daylight-savings-p sb!alien:boolean :out))
 
-;;; Subtract from the returned Internal-Time to get the universal time.
-;;; The offset between our time base and the Perq one is 2145 weeks and
-;;; five days.
+;;; Subtract from the returned Internal-Time to get the universal
+;;; time. The offset between our time base and the Perq one is 2145
+;;; weeks and five days.
 (defconstant seconds-in-week (* 60 60 24 7))
 (defconstant weeks-offset 2145)
 (defconstant seconds-offset 432000)
@@ -254,20 +239,15 @@
 
 ;;; Try to compile the closure arg to %TIME if it is interpreted.
 (defun massage-time-function (fun)
-  (cond
-   ((sb!eval:interpreted-function-p fun)
-    (multiple-value-bind (def env-p) (function-lambda-expression fun)
-      (declare (ignore def))
-      (cond
-       (env-p
-	(warn "TIME form in a non-null environment, forced to interpret.~@
-	       Compiling entire form will produce more accurate times.")
-	fun)
-       (t
-	(compile nil fun)))))
-   (t fun)))
+  ;; This is just a placeholder as of the switch from IR1 interpreter
+  ;; to bytecode interpreter. Someday it might make sense to complain
+  ;; about bytecoded FUN and/or compile it to native code, so I've
+  ;; left the placeholder in place, but as of sbcl-0.7.0 it's not
+  ;; obvious how to do the right thing easily, so I haven't actually 
+  ;; done it. -- WHN
+  fun)
 
-;;; Return all the files that we want time to report.
+;;; Return all the data that we want TIME to report.
 (defun time-get-sys-info ()
   (multiple-value-bind (user sys faults) (sb!sys:get-system-info)
     (values user sys faults (get-bytes-consed))))