diff --git a/code/time.lisp b/code/time.lisp index d4ed85eff66e217610fea0d9d404d107cae995f3..c52cbca972d721f74cb550ba2922b11b34aafab8 100644 --- a/code/time.lisp +++ b/code/time.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.10 1992/02/19 21:53:58 wlott Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.11 1992/02/20 00:59:18 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -352,24 +352,29 @@ (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)) + (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)) - (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~% ~ - ~S page fault~:P and~% ~ - ~S bytes consed.~%" - (max (/ (- new-real-time old-real-time) - (float 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) - (max (- new-page-faults old-page-faults) 0) - (max (- new-bytes-consed old-bytes-consed) 0))))) + (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]~% ~]~ + ~S page fault~:P and~% ~ + ~S bytes consed.~%" + (max (/ (- new-real-time old-real-time) + (float 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) + (not (zerop gc-run-time)) + (/ (float gc-run-time) (float internal-time-units-per-second)) + (max (- new-page-faults old-page-faults) 0) + (max (- new-bytes-consed old-bytes-consed) 0)))))))