1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174

;;; 7/18/2001 Alexander Repenning
;;; 12/12/08 Clozure CL
;;; Nano Second Timer
;;; works for intel macs
;;; Hemlock Editor Extension: Ctrl-x Ctrl-t will show the time is takes to compute the 
;;; current form selected in an editor buffer. Time is in nano seconds
;;; unlike a previous version of this code called hires timer, code will be executed
;;; only once.

(in-package :hemlock)

(export '(time-to-run time-to-run-milli))
#-cocotro
(defvar *mach-time-unit-ratio*
 (ccl::rlet ((info #>mach_timebase_info))
   (#_mach_timebase_info info)
   (/ (ccl::pref info #>mach_timebase_info.numer)
      (ccl::pref info #>mach_timebase_info.denom))))


(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 Nano seconds.
  Form will run only ONCE."
  #-cocotron
  `(locally (declare (optimize (speed 3) (safety 0)))
     (ccl::without-interrupts
       (let (t2 t3 t4)
         (setq t2 (#_mach_absolute_time))  ;; prime/cache the call: otherwise delta time will be significantly larger between first two calls
         (setq t2 (#_mach_absolute_time))
         ,@Form
         (setq t3 (#_mach_absolute_time))
         (setq t4 (#_mach_absolute_time))
         (values (round (* (max (- t3 t2 (- t4 t3)) 0)  *mach-time-unit-ratio*))))))
  #+cocotron
  `(locally (declare (optimize (speed 3) (safety 0)))
     (ccl::without-interrupts
      (let ((t1 (delta-time2))
            (t2 nil))
        ,@Form
        (setf t2 (delta-time2))
        (* 1000000000 (max t2 0))
        )
      ))))

(defmacro TIME-TO-RUN-MILLI (&body Form)
  (/ (TIME-TO-RUN Form) 1000000.0))
#-cocotron
(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,3F seconds" Time))
       ((> E -3) (format S "~6,2F ms" (* Time 1e3)))
       ((> E -6) (format S "~6,2F us"  (* Time 1e6)))
       ((> E -9) (format S "~6,2F ns" (* Time 1e9)))
       (t (format S "~E seconds" Time))))))

(defparameter *animation-time* nil)
(defun GET-ANIMATION-TIME ()
  (or *animation-time*
      (setf *animation-time* 0.0)))

(defun DELTA-TIME2 () "
  Return time in seconds passed since last animation."
  #+:X8632-target (declare (optimize (safety 2))) ;; avoid 2^32 nano second time warps in CCL 32bit
  #-windows-target
  (let ((Time (#_mach_absolute_time)))
    (prog1
        (if (zerop (get-animation-time))
          0.0                           ;First time through
          (float (* 0.000000001
                    (- Time (get-animation-time))
                    #.(ccl::rlet ((info #>mach_timebase_info))
                        (#_mach_timebase_info info)
                        (/ (ccl::pref info #>mach_timebase_info.numer)
                           (ccl::pref info #>mach_timebase_info.denom))))))
      (setf *animation-time* Time)
      ))
  #+windows-target
  (let ((Time (ccl::rlet ((now #>FILETIME))
                ;; this Win32 timer function is no good: typically 10ms or worse resolution!
                ;; consider using QueryPerformanceCounterrad http://www.devsource.com/c/a/Techniques/High-Performance-Timing-under-Windows/1/
		(#_GetSystemTimeAsFileTime now)
		(dpb (ccl::pref now #>FILETIME.dwHighDateTime)
		     (byte 32 32)
		     (ccl::pref now #>FILETIME.dwLowDateTime)))))
    (prog1
	(if (zerop (get-animation-time))
          0.0                           ;First time through
          (float (* 0.0000001 (- Time (get-animation-time)))))
      (setf *animation-time* Time)
      )))

(defmacro TIME-TO-RUN2 (&body Form)
;;; Hemlock Bindings
  `(locally (declare (optimize (speed 3) (safety 0)))
     (ccl::without-interrupts
      (let ((t1 (delta-time2))
            (t2 nil))
         ,@Form
        (setf t2 (delta-time2))
        (* 1000000000 (max t2 0))
        )
      )))
#-cocotron     
(defun benchmark-region (region)
  (message 
   (let ((*Package* (buffer-package (current-buffer))))  ;; not implemented yet
     (with-output-to-string (string)
       (let ((Time (eval `(time-to-run ,(read-from-string (region-to-string region))))))
	 (format String "  Time: ")
	 (print-time (/ Time 1000000000.0) String))))))

#-cocotron
(defcommand "Editor Benchmark Region" (p)
  "Benchmark lisp forms between the point and the mark in the editor Lisp."
  "Benchmark lisp forms between the point and the mark in the editor Lisp."
  (declare (ignore p))
  (if (region-active-p)
    (benchmark-region (current-region))
    (let* ((point (current-point)))
      (pre-command-parse-check point)
      (when (valid-spot point nil)      ; not in the middle of a comment
        (cond ((eql (next-character point) #\()
               (with-mark ((m point))
                 (if (list-offset m 1)
                   (benchmark-region (region point m)))))
              ((eql (previous-character point) #\))
               (with-mark ((m point))
                 (if (list-offset m -1)
                   (benchmark-region (region m point))))))))))

#-cocotron
(bind-key "Editor Benchmark Region" #k"control-x control-t")


#| Examples:

;; use the time-to-run macro or do a ctrl-x ctrl-t after selecting expression

(time-to-run (sin 3.3))

(tan 3.3)

(sleep 1.0)

(time-to-run)

(read-from-string "44534535345")
(read-from-string "4")

(member 'z '(a h k g r i f l i j g k l b l g z))


(defparameter *HT* (make-hash-table :test #'eq))

(setf (gethash 99 *ht*) 'bla)

(defparameter test (* 67 34))

(setq test (* 67 34))

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

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

|#