0.9.13.34: Class objects as specializers
[sbcl.git] / src / code / time.lisp
index 180b6b6..29a7687 100644 (file)
                           micro-seconds-per-internal-time-unit)))
       (declare (type (unsigned-byte 32) uint))
       (cond (base
-             (truly-the (unsigned-byte 32)
-                        (+ (the (unsigned-byte 32)
-                                (* (the (unsigned-byte 32) (- seconds base))
-                                   sb!xc:internal-time-units-per-second))
-                           uint)))
+             (+ (* (- seconds base)
+                   sb!xc:internal-time-units-per-second)
+                uint))
             (t
              (setq *internal-real-time-base-seconds* seconds)
              uint)))))
@@ -49,7 +47,6 @@
   #!+sb-doc
   "Return the run time in the internal time format. (See
   INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding CPU usage."
-  (declare (values (unsigned-byte 32)))
   (multiple-value-bind (ignore utime-sec utime-usec stime-sec stime-usec)
       (sb!unix:unix-fast-getrusage sb!unix:rusage_self)
     (declare (ignore ignore)
@@ -59,9 +56,8 @@
              ;; documented anywhere and the observed behavior is to
              ;; sometimes return 1000000 exactly.)
              (type (integer 0 1000000) utime-usec stime-usec))
-    (let ((result (+ (the (unsigned-byte 32)
-                          (* (the (unsigned-byte 32) (+ utime-sec stime-sec))
-                             sb!xc:internal-time-units-per-second))
+    (let ((result (+ (* (+ utime-sec stime-sec)
+                        sb!xc:internal-time-units-per-second)
                      (floor (+ utime-usec
                                stime-usec
                                (floor micro-seconds-per-internal-time-unit 2))
       (time-get-sys-info))
     (setq old-real-time (get-internal-real-time))
     (let ((start-gc-run-time *gc-run-time*))
-    (multiple-value-prog1
-        ;; Execute the form and return its values.
-        (funcall fun)
-      (multiple-value-setq
-          (new-run-utime new-run-stime new-page-faults new-bytes-consed)
-        (time-get-sys-info))
-      (setq new-real-time (- (get-internal-real-time) real-time-overhead))
-      (let ((gc-run-time (max (- *gc-run-time* start-gc-run-time) 0)))
-        (format *trace-output*
-                "~&Evaluation took:~%  ~
+      (multiple-value-prog1
+          ;; Execute the form and return its values.
+          (funcall fun)
+        (multiple-value-setq
+            (new-run-utime new-run-stime new-page-faults new-bytes-consed)
+          (time-get-sys-info))
+        (setq new-real-time (- (get-internal-real-time) real-time-overhead))
+        (let ((gc-run-time (max (- *gc-run-time* start-gc-run-time) 0)))
+          (format *trace-output*
+                  "~&Evaluation took:~%  ~
                  ~S second~:P of real time~%  ~
                  ~S second~:P of user run time~%  ~
                  ~S second~:P of system run time~%  ~
-~@[                 [Run times include ~S second~:P GC run time.]~%  ~]~
+                ~@[[Run times include ~S second~:P GC run time.]~%  ~]~
                  ~S page fault~:P and~%  ~
                  ~:D bytes consed.~%"
-                (max (/ (- new-real-time old-real-time)
-                        (float sb!xc:internal-time-units-per-second))
-                     0.0)
-                (max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0)
-                (max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0)
-                (unless (zerop gc-run-time)
-                  (/ (float gc-run-time)
-                     (float sb!xc:internal-time-units-per-second)))
-                (max (- new-page-faults old-page-faults) 0)
-                (max (- new-bytes-consed old-bytes-consed) 0)))))))
+                  (max (/ (- new-real-time old-real-time)
+                          (float sb!xc:internal-time-units-per-second))
+                       0.0)
+                  (max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0)
+                  (max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0)
+                  (unless (zerop gc-run-time)
+                    (/ (float gc-run-time)
+                       (float sb!xc:internal-time-units-per-second)))
+                  (max (- new-page-faults old-page-faults) 0)
+                  (max (- new-bytes-consed old-bytes-consed) 0)))))))