(defconstant micro-seconds-per-internal-time-unit
(/ 1000000 sb!xc:internal-time-units-per-second))
+
+(defconstant 100ns-per-internal-time-unit
+ (/ 10000000 internal-time-units-per-second))
\f
;;; The base number of seconds for our internal "epoch". We initialize
;;; this to the time of the first call to GET-INTERNAL-REAL-TIME, and
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)))))
#!+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)))
+ ;; FIXME: This is yet another creeping malaise: instead of #+/-win32
+ ;; conditionals things like these need to be split into wholly separate
+ ;; implementations of get-internal-run-time, probably one in
+ ;; unix.lisp and one in win32.lisp -- that however requires also
+ ;; cleaning up unix.lisp sufficiently to remove it from the Windows build.
+ #-win32
(multiple-value-bind (ignore utime-sec utime-usec stime-sec stime-usec)
(sb!unix:unix-fast-getrusage sb!unix:rusage_self)
(declare (ignore ignore)
;; 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))
micro-seconds-per-internal-time-unit))))
- result)))
+ result))
+ #!+win32
+ (multiple-value-bind
+ (creation-time exit-time kernel-time user-time)
+ (sb!win32:get-process-times)
+ (declare (ignore creation-time exit-time))
+ (values (floor (+ user-time kernel-time) 100ns-per-internal-time-unit))))
\f
;;;; Encode and decode universal times.
(cond
((< unix-time (- (ash 1 31)))
(multiple-value-bind (year offset) (years-since-mar-2000 utime)
- (declare (ignore year))
- (+ +mar-1-1903+ (- unix-to-universal-time) offset)))
+ (declare (ignore year))
+ (+ +mar-1-1903+ (- unix-to-universal-time) offset)))
((>= unix-time (ash 1 31))
(multiple-value-bind (year offset) (years-since-mar-2000 utime)
- (declare (ignore year))
- (+ +mar-1-2035+ (- unix-to-universal-time) offset)))
+ (declare (ignore year))
+ (+ +mar-1-2035+ (- unix-to-universal-time) offset)))
(t unix-time))))
-
+
(defun decode-universal-time (universal-time &optional time-zone)
#!+sb-doc
"Converts a universal-time to decoded time format returning the following
(type (integer 1 31) date)
(type (integer 1 12) month)
(type (or (integer 0 99) (integer 1899)) year)
- ;; that type used to say (integer 1900), but that's
- ;; incorrect when a time-zone is specified: we should be
- ;; able to encode to produce 0 when a non-zero timezone is
- ;; specified - bem, 2005-08-09
+ ;; that type used to say (integer 1900), but that's
+ ;; incorrect when a time-zone is specified: we should be
+ ;; able to encode to produce 0 when a non-zero timezone is
+ ;; specified - bem, 2005-08-09
(type (or null rational) time-zone))
(let* ((year (if (< year 100)
(pick-obvious-year year)
(leap-years-before year))
(* (- year 1900) 365)))
(hours (+ hour (* days 24)))
- (encoded-time 0))
+ (encoded-time 0))
(if time-zone
(setf encoded-time (+ second (* (+ minute (* (+ hours time-zone) 60)) 60)))
(let* ((secwest-guess
(old-run-utime old-run-stime old-page-faults old-bytes-consed)
(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:~% ~
+ (let ((start-gc-run-time *gc-run-time*)
+ #!+sb-eval (sb!eval:*eval-calls* 0))
+ (declare #!+sb-eval (special sb!eval:*eval-calls*))
+ (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 call~:P to %EVAL~% ~]~
~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)))
+ #!+sb-eval sb!eval:*eval-calls* #!-sb-eval nil
+ (max (- new-page-faults old-page-faults) 0)
+ (max (- new-bytes-consed old-bytes-consed) 0)))))))
+