X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ftime.lisp;h=60bf2a5313de9eb4cd17cd8236f0e09d18d4c779;hb=9fd95117be995b9e15a19aa182fafe4a489a4ac7;hp=29a7687f390b70db3203716b47151f3d323a464a;hpb=9b458bf995314b7edd1cc050bd11ede83ada4328;p=sbcl.git diff --git a/src/code/time.lisp b/src/code/time.lisp index 29a7687..60bf2a5 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -11,58 +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.") +(defun time-reinit () + (reinit-internal-real-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 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 - (+ (* (- 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." - (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 (+ (* (+ 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. @@ -130,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))) @@ -353,7 +316,9 @@ (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*)) + (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) @@ -367,7 +332,8 @@ ~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) @@ -378,5 +344,7 @@ (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))))))) +