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

;;; Carnegie Mellon University, and has been placed in the public domain.

;;;

(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 $")

;;;

;;; **********************************************************************

;;;

(defvar *time-consing* nil)

(defvar *last-time-consing* nil)

(defvar *in-get-time-consing* nil)

(defun get-time-consing ()

  (when (null *time-consing*)

  (when (and (null *time-consing*) (not *in-get-time-consing*))

    (let ((*in-get-time-consing* t))

      (time nil)

    (setq *time-consing* *last-time-consing*)))

      (setq *time-consing* *last-time-consing*))))

;;; %TIME  --  Internal

;;;    The guts of the TIME macro.  Compute overheads, run the (compiled)

;;; function, report the times.

;;;

(defun %time (fun)

(defun %time (fun &optional get-time-p)

  (let ((fun (massage-time-function fun))

	old-run-utime

        new-run-utime

      (setq new-real-time (- (get-internal-real-time) real-time-overhead))

      (let ((gc-run-time (max (- *gc-run-time* start-gc-run-time) 0))

	    (bytes-consed (- new-bytes-consed old-bytes-consed cons-overhead)))

	(unless *in-get-time-consing*

	  (terpri *trace-output*)

	  (pprint-logical-block (*trace-output* nil :per-line-prefix "; ")

	    (format *trace-output*

			 (float internal-time-units-per-second)))

		    (max (- new-page-faults old-page-faults) 0)

		    (max (- bytes-consed (or *time-consing* 0)) 0)))

	(terpri *trace-output*)

	(setq *last-time-consing* bytes-consed)))))))

	  (terpri *trace-output*))

	(setq *last-time-consing* bytes-consed))))))