X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftime.lisp;h=9a6d825c96750e241c09fb5a4c86d6518b0f7677;hb=2b90fd1dbad23322258222a2ef4cef7f6a00831d;hp=180b6b6bc1b414d107f6e89fb3aafd694539cac4;hpb=95a014cffbb243fdc59adbdd6ab7f6dbb0058ca4;p=sbcl.git diff --git a/src/code/time.lisp b/src/code/time.lisp index 180b6b6..9a6d825 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -11,62 +11,25 @@ (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.") +;;; Internal epoch, used as base for real-time. +(declaim (unsigned-byte *internal-epoch*)) +(defvar *internal-epoch* 0) -(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 () + (setf *internal-epoch* (system-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))))) + "Return the real time (\"wallclock time\") since startup in the internal +time format. (See INTERNAL-TIME-UNITS-PER-SECOND.)" + (- (system-internal-real-time) *internal-epoch*)) (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 +97,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))) @@ -357,30 +320,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))))))) +