X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftime.lisp;h=60bf2a5313de9eb4cd17cd8236f0e09d18d4c779;hb=496071a75429677a2c064e4995c379d3ba6ec458;hp=72abe2123353fbc596fb975d62394f97b754b687;hpb=881c3a215e3a82faf928265f8606f940f3e44e1e;p=sbcl.git diff --git a/src/code/time.lisp b/src/code/time.lisp index 72abe21..60bf2a5 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -11,62 +11,21 @@ (in-package "SB!IMPL") -(defconstant sb!xc:internal-time-units-per-second 1000 - #!+sb-doc - "The number of internal time units that fit into a second. See - GET-INTERNAL-REAL-TIME and GET-INTERNAL-RUN-TIME.") - -(defconstant micro-seconds-per-internal-time-unit - (/ 1000000 sb!xc:internal-time-units-per-second)) - -;;; 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 -;;; then subtract this out of the result. -(defvar *internal-real-time-base-seconds* nil) -(declaim (type (or (unsigned-byte 32) null) *internal-real-time-base-seconds*)) +(defun time-reinit () + (reinit-internal-real-time)) -(defun get-internal-real-time () - #!+sb-doc - "Return the real time in the internal time format. (See - INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding elapsed time." - (multiple-value-bind (ignore seconds useconds) (sb!unix:unix-gettimeofday) - (declare (ignore ignore) (type (unsigned-byte 32) seconds useconds)) - (let ((base *internal-real-time-base-seconds*) - (uint (truncate useconds - 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))) - (t - (setq *internal-real-time-base-seconds* seconds) - uint))))) +;;; 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 - "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) - (type (unsigned-byte 31) utime-sec stime-sec) - ;; (Classic CMU CL had these (MOD 1000000) instead, but - ;; at least in Linux 2.2.12, the type doesn't seem to be - ;; 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)) - (floor (+ utime-usec - stime-usec - (floor micro-seconds-per-internal-time-unit 2)) - micro-seconds-per-internal-time-unit)))) - result))) + "Return the run time used by the process in the internal time format. (See +INTERNAL-TIME-UNITS-PER-SECOND.) This is useful for finding CPU usage. +Includes both \"system\" and \"user\" time." + (system-internal-run-time)) ;;;; Encode and decode universal times. @@ -134,8 +93,8 @@ (defun get-universal-time () #!+sb-doc - "Return a single integer for the current time of - day in universal time format." + "Return a single integer for the current time of day in universal time +format." (multiple-value-bind (res secs) (sb!unix:unix-gettimeofday) (declare (ignore res)) (+ secs unix-to-universal-time))) @@ -176,14 +135,14 @@ (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 @@ -266,10 +225,10 @@ (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) @@ -281,7 +240,7 @@ (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 @@ -357,30 +316,35 @@ (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))))))) +