;;; 7/18/2001 Alexander Repenning
;;; Micro Second Timer
;;; Fred Extension: Ctrl-x Ctrl-t will show the time is takes to compute the 
;;; current form selected in a Fred buffer. Time is in micro seconds
;;; unlike a previous version of this code called hires timer, code will be executed
;;; only once.

(in-package :CCL)



(eval-when (:compile-toplevel :load-toplevel :execute)
(defmacro TIME-TO-RUN (&body Form) "
  in: &body Form {t}.
  Measure the time is takes to run <Form> in microseconds.
  Form will run only ONCE."
  `(locally (declare (optimize (speed 3) (safety 0)))
     (without-interrupts
      (rlet ((t1 :unsignedwide)
             (t2 :unsignedwide)
             (t3 :unsignedwide)
             (t4 :unsignedwide))
        (#_MicroSeconds t1)             ;; Cache the trap call
        (#_MicroSeconds t1)
        ,@Form
        (#_MicroSeconds t2)
        (#_WideSubtract t2 t1)
        ;; compensate overhead time
        (#_MicroSeconds t3)
        (#_MicroSeconds t4)
        (#_WideSubtract t4 t3)
        (- (+ (%get-unsigned-long t2 4) (* #.(expt 2 32) (%get-unsigned-long t2)))
           (+ (%get-unsigned-long t4 4) (* #.(expt 2 32) (%get-unsigned-long t4)))))))))


(defun PRINT-TIME (Time &optional (S t))
  "
  in:  Time {float} time in seconds,
       &optional S {stream} default t.
  Print <Time> using s, ms, us, or ns representation."
  (if (<= Time 0.0) 
    (format S "close to timer resolution => repeat test")
    (let ((E (/ (log (abs Time)) #.(log 10))))
      (cond
       ((> E 0)  (format S "~6,2F seconds" Time))
       ((> E -3) (format S "~6,2F ms" (* Time 1e3)))
       ((> E -6) (format S "~A us" (truncate (* Time 1e6))))
       ((> E -9) (format S "~6,2F ns" (* Time 1e9)))
       (t (format S "~E seconds" Time))))))


(defmethod TIME-OF-SEXP-TEST-ONLY-ONCE ((Self ccl:fred-mixin)) "
  in: Self {fred-mixin}." 
  (let ((*Package* (or (ccl:window-package Self) *Package*))
        (ccl::*Clear-Mini-Buffer* t))
    (without-interrupts
     (ccl:set-mini-buffer 
      (ccl:view-window Self)
      (with-output-to-string (String)
        (let ((Time (/ (eval `(time-to-run ,(ccl:buffer-current-sexp (ccl:fred-buffer Self))))
                       1000000)))
          (format String "  Time: ")
          (print-time Time String)))))))


(ccl:comtab-set-key ccl:*Control-X-Comtab* '(:control #\t) 'time-of-sexp-test-only-once)


#| Examples:


(time-to-run (dotimes (i 1000) (sin 3.3)))

(eval '(time-to-run (sleep 1.5)))

(time-to-run)

(read-from-string "44534535345")

(defvar *Array* (make-array 100))

(dotimes (i 1000) (aref *Array* 3))

|#