From 9b458bf995314b7edd1cc050bd11ede83ada4328 Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Thu, 1 Jun 2006 12:49:00 +0000 Subject: [PATCH] 0.9.13.21: Make TIME show the amount of run-time spent in GC. SBCLs of old used to have this feature, but (as far as I can tell) it was unintentionally disabled in 0.pre8.119.thread-gc.1. --- NEWS | 1 + src/code/gc.lisp | 5 ++++- src/code/time.lisp | 42 +++++++++++++++++++++--------------------- version.lisp-expr | 2 +- 4 files changed, 27 insertions(+), 23 deletions(-) diff --git a/NEWS b/NEWS index 07b2e1a..4696a39 100644 --- a/NEWS +++ b/NEWS @@ -18,6 +18,7 @@ changes in sbcl-0.9.14 relative to sbcl-0.9.13: constant index and a (simple-array (signed-byte 32)) array * bug fix: NAME-CHAR on an invalid symbol no longer signals an error (patch by Robert J. Macomber) + * feature: TIME now displays the amount of run-time spent in GC * fixed some bugs revealed by Paul Dietz' test suite: ** MISC.641: LET-conversion were not supposed to work in late compilation stages. diff --git a/src/code/gc.lisp b/src/code/gc.lisp index 95ff75c..cf5451e 100644 --- a/src/code/gc.lisp +++ b/src/code/gc.lisp @@ -192,7 +192,10 @@ environment these hooks may run in any thread.") ;; to run as little as possible without them. (without-interrupts (gc-stop-the-world) - (collect-garbage gen) + (let ((start-time (get-internal-run-time))) + (collect-garbage gen) + (incf *gc-run-time* + (- (get-internal-run-time) start-time))) (setf *gc-pending* nil new-usage (dynamic-usage)) (gc-start-the-world)) diff --git a/src/code/time.lisp b/src/code/time.lisp index ddc8cbc..29a7687 100644 --- a/src/code/time.lisp +++ b/src/code/time.lisp @@ -354,29 +354,29 @@ (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:~% ~ + (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 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))) + (max (- new-page-faults old-page-faults) 0) + (max (- new-bytes-consed old-bytes-consed) 0))))))) diff --git a/version.lisp-expr b/version.lisp-expr index 4eb4da5..f8aadc1 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.9.13.20" +"0.9.13.21" -- 1.7.10.4