ernst@boring.UUCP (11/01/85)
Some time ago there were some timers on the net for FranzL. So I
have dug up mine & polished it a bit. Though not a real profiler, it is useful
at least to me. It is called "time" and it has 1 to 4 arguments which are
passed evaluated:
First arg.: the expression to be timed;
Second . .: the number of times the first arg is to be evaluated;
Third . .: a file to print the timing-results to;
Fourth . .: sets gcdisable, so that you can influence gc.
Only the first argument is required, the other three are optional
and their default values are:
Second: 1
Third : t (terminal)
Fourth: nil (gc enabled)
The value of the timer is the value of the first argument. If you ask
more than one evaluation, then mean, standard deviation and 95%
confidence-interval are printed, assuming data are normally distributed:
$ lisp
Franz Lisp, Opus 38.79
Date built: Tue Dec 18 00:49:48 1984.
-> (include time)
[fasl time.o]
t
-> (setq l (do ((i 128 (1- i)) (l '() (cons '() l))) ((= i 0) l))
a (array t nil 128))
array[128]
-> (length l)
128
-> (time '(nth 127 l) 100)
466.7/100 = 4.67 ms; stdev(N-1) = 8.9 ms; 95% conf.intv: 2.9 .. 6.4 ms;
real: 1/100 = 0.01 sec.
nil
-> (time '(eval (arrayref a 127)) 100)
50.0/100 = 0.5 ms; stdev(N-1) = 2.9 ms; 95% conf.intv: 0.0 .. 1.1 ms;
real: 1/100 = 0.01 sec.
nil
If you are unhappy with the assumption that the data collected by
the timer are normally distributed, Jain & Chlomtac (CACM 28(10), (Oct.
1985), pp 1076-1085) describe their P**2 algorithm that may be used
efficiently for distribution-free parameter-estimation. I have not tried it
myself, though. Anyway, here is my timer which assumes normally distributed
processing times:
;==============================================================================
; Tue Aug 13 16:54:57 1985
(declare (macros t)
(special $gcprint $gccount$ gcdisable)
(localf time:mean time:stdev))
(defun round (n &optional (precision 0))
(times (fix (plus 0.5 (times n (expt 10 precision))))
(expt 10 (minus precision))))
(defun ticks-to-msec (ticks &optional (prec 1) (Hz 60.0))
(round (times 1000.0 (quotient (float ticks) Hz)) prec))
; Thu Aug 2 17:30:19 1984
(defun time:mean (file score n time-unit)
(format file "~D" score)
(and (>& n 1)
(format file
"/~D = ~D"
(fix n)
(round (quotient (float score) n) 2)))
(format file " ~A" time-unit))
(defun time:stdev (file sum-sq sum N)
(let* ((fsum (float sum))
(fsum-sq (float sum-sq))
(mean (quotient fsum N))
(stdevN1 ; stdev(N-1)
(sqrt (quotient (difference fsum-sq (times mean mean N)) (sub1 N))))
(stdevN ; stdev(N)
(sqrt (difference (quotient fsum-sq N) (times mean mean))))
(conf-const ; constant for computation of 95% confidence interval
(quotient (times 1.96 stdevN) (sqrt N))))
(format file
"; stdev(N-1) = ~D ms; 95% conf.intv: ~D .. ~D ms;~%"
(ticks-to-msec stdevN1)
(ticks-to-msec ; 0 is the (asymptotically valid) minimum.
(let ((min (difference mean conf-const))) (cond
((minusp min) 0.0)
(t min))))
(ticks-to-msec (plus mean conf-const)))))
(defun time (term &rest options)
(let ((gc-count $gccount$)
(proc-ticks 0)
(sum-sq 0)
(real-time 0)
(gc-ticks 0)
(rt0 0)
(rt1 0)
(pt0 0)
(pt1 0)
(n
(let ((n (car options))) (cond
((or (not (numberp n)) (lessp n 1)) 1)
(t n))))
(file
(let ((f (cadr options))) (cond
((or (null f) (eq f 't)) 't)
((atom f)
(format f "~&~S:~%" `(time ',term . ,options))
f)
(t 't))))
(gcdisable (caddr options)))
(do ((i n (1- i))
(value 'nil))
((=& i 0)
(let ((gc-s (- $gccount$ gc-count))
(nf (float n)))
(format file "~&")
(time:mean file (ticks-to-msec proc-ticks) nf 'ms)
(cond ((>& n 1) (time:stdev file sum-sq proc-ticks nf))
(t (format file "; ")))
(and (>& gc-s 0)
(progn (format file "gc: ")
(time:mean file (ticks-to-msec gc-ticks) gc-s 'ms)
(format file "; ")))
(format file "real: ")
(time:mean file real-time nf 'sec)
(format file ".~%")
value))
(let (($gcprint 't)) ; print every gc.
(setq rt0 (sys:time)
pt0 (ptime)
value (eval term)
pt1 (ptime)
rt1 (sys:time)))
(let ((ticks (- (- (car pt1) (car pt0)) (- (cadr pt1) (cadr pt0)))))
(setq proc-ticks (+ proc-ticks ticks)
sum-sq (+ sum-sq (expt ticks 2))
real-time (+ real-time (- rt1 rt0))
gc-ticks (+ gc-ticks (- (cadr pt1) (cadr pt0))))))))
(putprop 'time 't 'version)
--
Ernst van Waning.
ernst@mcvax.UUCP
or: ernst%uva.uucp@seismo.arpa