Skip to content
Snippets Groups Projects
Commit fa3ae664 authored by gerd's avatar gerd
Browse files

* src/code/time.lisp (*in-get-time-consing*): New var.

	(get-time-consing): Use it.
	(%time): Don't print if *in-get-time-consing*.
parent b18e32b6
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.24 2003/07/24 13:59:51 gerd Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/time.lisp,v 1.25 2003/07/26 17:42:32 gerd Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -292,11 +292,13 @@ ...@@ -292,11 +292,13 @@
(defvar *time-consing* nil) (defvar *time-consing* nil)
(defvar *last-time-consing* nil) (defvar *last-time-consing* nil)
(defvar *in-get-time-consing* nil)
(defun get-time-consing () (defun get-time-consing ()
(when (null *time-consing*) (when (and (null *time-consing*) (not *in-get-time-consing*))
(time nil) (let ((*in-get-time-consing* t))
(setq *time-consing* *last-time-consing*))) (time nil)
(setq *time-consing* *last-time-consing*))))
;;; %TIME -- Internal ;;; %TIME -- Internal
...@@ -304,7 +306,7 @@ ...@@ -304,7 +306,7 @@
;;; The guts of the TIME macro. Compute overheads, run the (compiled) ;;; The guts of the TIME macro. Compute overheads, run the (compiled)
;;; function, report the times. ;;; function, report the times.
;;; ;;;
(defun %time (fun) (defun %time (fun &optional get-time-p)
(let ((fun (massage-time-function fun)) (let ((fun (massage-time-function fun))
old-run-utime old-run-utime
new-run-utime new-run-utime
...@@ -359,27 +361,28 @@ ...@@ -359,27 +361,28 @@
(setq new-real-time (- (get-internal-real-time) real-time-overhead)) (setq new-real-time (- (get-internal-real-time) real-time-overhead))
(let ((gc-run-time (max (- *gc-run-time* start-gc-run-time) 0)) (let ((gc-run-time (max (- *gc-run-time* start-gc-run-time) 0))
(bytes-consed (- new-bytes-consed old-bytes-consed cons-overhead))) (bytes-consed (- new-bytes-consed old-bytes-consed cons-overhead)))
(terpri *trace-output*) (unless *in-get-time-consing*
(pprint-logical-block (*trace-output* nil :per-line-prefix "; ") (terpri *trace-output*)
(format *trace-output* (pprint-logical-block (*trace-output* nil :per-line-prefix "; ")
"Evaluation took:~% ~ (format *trace-output*
~S second~:P of real time~% ~ "Evaluation took:~% ~
~S second~:P of user run time~% ~ ~S second~:P of real time~% ~
~S second~:P of system run time~% ~ ~S second~:P of user run time~% ~
~:D CPU cycles~% ~ ~S second~:P of system run time~% ~
~@[[Run times include ~S second~:P GC run time]~% ~]~ ~:D CPU cycles~% ~
~S page fault~:P and~% ~ ~@[[Run times include ~S second~:P GC run time]~% ~]~
~:D bytes consed.~%" ~S page fault~:P and~% ~
(max (/ (- new-real-time old-real-time) ~:D bytes consed.~%"
(float internal-time-units-per-second)) (max (/ (- new-real-time old-real-time)
0.0) (float internal-time-units-per-second))
(max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0) 0.0)
(max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0) (max (/ (- new-run-utime old-run-utime) 1000000.0) 0.0)
(truncate cycle-count) (max (/ (- new-run-stime old-run-stime) 1000000.0) 0.0)
(unless (zerop gc-run-time) (truncate cycle-count)
(/ (float gc-run-time) (unless (zerop gc-run-time)
(float internal-time-units-per-second))) (/ (float gc-run-time)
(max (- new-page-faults old-page-faults) 0) (float internal-time-units-per-second)))
(max (- bytes-consed (or *time-consing* 0)) 0))) (max (- new-page-faults old-page-faults) 0)
(terpri *trace-output*) (max (- bytes-consed (or *time-consing* 0)) 0)))
(setq *last-time-consing* bytes-consed))))))) (terpri *trace-output*))
(setq *last-time-consing* bytes-consed))))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment