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