Mercurial > hg > xemacs-beta

comparison lisp/utils/bench.el @ 80:1ce6082ce73f r20-0b90

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b90
author cvs
date Mon, 13 Aug 2007 09:06:37 +0200
parents 54cc21c15cbb
children 6a378aca36af
comparison
equal deleted inserted replaced
79:5b0a5bbffab6 80:1ce6082ce73f
1 ;;; bench.el --- a crude benchmark for emacsen 1 ;;; bench.el --- benchmarking utility for emacsen
2
2 ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc. 3 ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
4 ;; $Id: bench.el,v 1.2 1997/01/11 20:14:12 steve Exp $
5 ;; $Source: /afs/informatik.uni-tuebingen.de/local/web/xemacs/xemacs-cvs/XEmacs/xemacs/lisp/utils/Attic/bench.el,v $
6 ;; $Revision: 1.2 $
7 ;; $Author: steve $
8 ;; $Date: 1997/01/11 20:14:12 $
3 9
4 ;; Author: Shane Holder <holder@rsn.hp.com> 10 ;; Author: Shane Holder <holder@rsn.hp.com>
5 ;; Adapted-By: Steve Baur <steve@altair.xemacs.org> 11 ;; Adapted-By: Steve Baur <steve@altair.xemacs.org>
12 ;; Further adapted by: Shane Holder <holder@rsn.hp.com>
13 ;; Keywords: internal, maint
6 14
7 ;; This file is part of XEmacs. 15 ;; This file is part of XEmacs.
8 16
9 ;; XEmacs is free software; you can redistribute it and/or modify it 17 ;; XEmacs is free software; you can redistribute it and/or modify it
10 ;; under the terms of the GNU General Public License as published by 18 ;; under the terms of the GNU General Public License as published by
21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 29 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
22 ;; 02111-1307, USA. 30 ;; 02111-1307, USA.
23 31
24 ;;; Commentary: 32 ;;; Commentary:
25 33
34 ;; Adapted from Shane Holder's bench.el by steve@altair.xemacs.org.
35
26 ;; To run 36 ;; To run
27 ;; Extract the shar file in /tmp, or modify bench-large-lisp-file to 37 ;; Extract the shar file in /tmp, or modify bench-lisp-file to
28 ;; point to the gnus-bench.el file. 38 ;; point to the gnus.el file.
29 ;; At the shell prompt emacs -q --no-site-file <= don't load users .emacs or 39 ;; At the shell prompt emacs -q --no-site-file <= don't load users .emacs or site-file
30 ;; site-file
31 ;; M-x byte-compile-file "/tmp/bench.el" 40 ;; M-x byte-compile-file "/tmp/bench.el"
32 ;; M-x load-file "/tmp/bench.elc" 41 ;; M-x load-file "/tmp/bench.elc"
33 ;; In the scratch buffer (bench 1) 42 ;; In the scratch buffer (bench 1)
34 43
44
45 ;; All bench marks must be named bench-mark-<something>
46 ;; Results are put in bench-mark-<something-times which is a list of
47 ;; times for the runs.
48 ;; If the bench mark is not simple then there needs to be a
49 ;; corresponding bench-handler-<something>
50
35 ;;; Code: 51 ;;; Code:
36 52
37 ;; Use elp to profile benchmarks 53 ;; Use elp to profile benchmarks
38 (require 'elp) 54 (require 'cl) ;Emacs doesn't have when and cdar
39 (eval-when-compile (require 'cl)) ; Emacs doesn't have when and cdar 55
40 56 ;-----------------------------------------------------------------------------
41 (defconst bench-version 1.0) 57 (defvar bench-mark-hanoi-times nil)
42 58
43 (defconst bench-large-lisp-file "/usr/local/lib/gnus-bench.el" 59 (defun bench-handler-hanoi (times)
44 "Large lisp file to use in benchmarks. 60 (let ((start-time))
45 Grab `ftp://ftp.xemacs.org/pub/beta/contrib/gnus-bench.el.gz' for a good 61 (while (> times 0)
46 version. Don't install this file with Emacs/XEmacs.") 62 ; (setq start-time (bench-get-time))
47 63 (bench-mark-hanoi)
48 (defconst bench-sort-buffer "*Sort*" 64 ; (setq bench-mark-hanoi-times (cons (- (bench-get-time) start-time ) bench-mark-hanoi-times ))
49 "File to be used in the sort benchmark") 65 (setq times (- times 1))))
50 66 )
51 (defconst bench-sort-number-words 10000 67
52 "Number of words to use in sort benchmark") 68 (defun bench-mark-hanoi ()
53
54 (defconst bench-pre-bench-hook nil
55 "Hook for individual bench mark initialization.")
56
57 (defconst bench-post-bench-hook nil
58 "Hook for individual bench mark statistic collection.")
59
60 (defconst bench-mark-function-alist
61 '(
62 (bench-mark-1 . "Tower of Hanoi")
63 (bench-mark-2 . "Font Lock")
64 (bench-mark-3 . "Large File scrolling")
65 (bench-mark-4 . "Frame Creation")
66 (bench-mark-5 . "Generate Words")
67 (bench-mark-6 . "Sort Buffer")
68 (bench-mark-7 . "Large File bytecompilation")
69 (bench-mark-8 . "Loop Computation")
70 (bench-mark-9 . "Make a Few Large Size List")
71 (bench-mark-10 . "Garbage Collection Large Size List")
72 (bench-mark-11 . "Make Several Small Size List")
73 (bench-mark-12 . "Garbage Collection Small Size List")
74 (bench-mark-13 . "Append to buffer")
75 ))
76
77 (defconst bench-enabled-profiling nil
78 "If non-nil and the underlying emacs supports it, do function profiling.")
79
80 (defconst bench-mark-profile-buffer "*Profile*"
81 "Buffer used for collection of profiling data.")
82
83 (setq gc-cons-threshold 40000000)
84
85 (defconst bench-number-of-large-lists 10
86 "Number of lists to use in large list creation/garbage collections")
87
88 (defconst bench-number-of-small-lists 1000000
89 "Number of lists to use in small list creation/garbage collections")
90
91 (defconst bench-large-list-size 1000000
92 "Size of list to use in small list creation/garbage collection")
93
94 (defconst bench-small-list-size 10
95 "Size of list to use in small list creation/garbage collection")
96
97 ;-----------------------------------------------------------------------------
98 (defun bench-mark-1 ()
99 "How long to complete the tower of hanoi." 69 "How long to complete the tower of hanoi."
100 (hanoi 4)) 70 (hanoi 4))
101 71
102 ;----------------------------------------------------------------------------- 72 ;-----------------------------------------------------------------------------
103 (defun bench-mark-2 () 73 (defvar bench-mark-font-lock-buffer nil "buffer used for bench-mark-fontlock")
74
75 (defun bench-handler-font-lock (times)
76 (setq bench-mark-font-lock-buffer (find-file bench-lisp-file))
77 (while (> times 0)
78 (bench-mark-font-lock)
79 (font-lock-mode) ; Turn it off
80 (setq times (- times 1)))
81 (kill-buffer bench-mark-font-lock-buffer)
82 )
83
84 (defun bench-mark-font-lock ()
104 "How long to fonitfy a large file." 85 "How long to fonitfy a large file."
105 (find-file bench-large-lisp-file) 86 (font-lock-fontify-buffer)
106 (font-lock-fontify-buffer)) 87 )
107 88
108 ;----------------------------------------------------------------------------- 89 ;-----------------------------------------------------------------------------
109 (defun bench-mark-3 () 90 (defvar bench-mark-scrolling-buffer nil "buffer used for bench-mark-scrolling")
110 "How long does it take to scroll down through a large file." 91
92 (defun bench-handler-scrolling (times)
93 (setq bench-mark-scrolling-buffer (find-file bench-lisp-file))
94 (set-buffer bench-mark-scrolling-buffer)
95 ; (setq scroll-step 1)
96 (font-lock-mode -1)
97 (goto-char (point-min)) ;Start at point min
98 (let ((temp-times times))
99 (while (> temp-times 0)
100 (bench-mark-scrolling-down)
101 (bench-mark-scrolling-up)
102 (setq temp-times (- temp-times 1))))
103
104 (font-lock-fontify-buffer)
105
106 (goto-char (point-min)) ;Start at point min
107 (let ((temp-times times))
108 (while (> temp-times 0)
109 (bench-mark-scrolling-down-fontified)
110 (bench-mark-scrolling-up-fontified)
111 (setq temp-times (- temp-times 1))))
112 (kill-buffer bench-mark-scrolling-buffer)
113 )
114
115 (defun bench-mark-scrolling-down ()
116 "How long does it take to scroll down through a large file.
117 Expect point to be at point min"
118 (let ((buffer-read-only t))
119 (while (< (point) (point-max))
120 (next-line 1)
121 (sit-for 0))))
122
123 (defun bench-mark-scrolling-up ()
124 "How long does it take to scroll up through a large fontified ile."
125 (let ((buffer-read-only t))
126 (while (> (point) (point-min))
127 (previous-line 1)
128 (sit-for 0))))
129
130 (defun bench-mark-scrolling-down-fontified ()
131 "How long does it take to scroll down through a large fontified file."
111 (let ((buffer-read-only t)) 132 (let ((buffer-read-only t))
112 (goto-char (point-min)) 133 (goto-char (point-min))
113 (while (< (point) (point-max)) 134 (while (< (point) (point-max))
114 (next-line 1) 135 (next-line 1)
115 (sit-for 0)))) 136 (sit-for 0))))
116 137
117 ;----------------------------------------------------------------------------- 138 (defun bench-mark-scrolling-up-fontified ()
118 (defun bench-mark-4 () 139 "How long does it take to scroll up through a large fontified ile."
140 (let ((buffer-read-only t))
141 (while (> (point) (point-min))
142 (previous-line 1)
143 (sit-for 0))))
144
145 ;-----------------------------------------------------------------------------
146
147 (defun bench-handler-make-frames (times)
148 (let ((temp-times times)
149 (frame))
150 (while (> temp-times 0)
151 (setq frame (bench-mark-make-frame)) ;Make frame
152 (bench-mark-delete-frame frame) ;Delete frame
153 (setq temp-times (- temp-times 1))))
154
155 (let ((temp-times times)
156 (frames))
157 (while (> temp-times 0)
158 (setq frames (cons (bench-mark-make-multiple-frames) frames)) ;Make frames
159 (setq temp-times (- temp-times 1)))
160
161 (setq temp-times times)
162
163 (while (> temp-times 0)
164 (bench-mark-delete-multiple-frames (car frames)) ;Delete frames
165 (setq frames (cdr frames))
166 (setq temp-times (- temp-times 1))))
167
168 )
169
170 (defun bench-mark-make-frame ()
119 "How quickly can emacs create a new frame." 171 "How quickly can emacs create a new frame."
120 (make-frame)) 172 (make-frame))
121 173
122 174 (defun bench-mark-delete-frame (frame)
123 ;----------------------------------------------------------------------------- 175 "How quickly can emacs create a new frame."
124 (defun bench-mark-5 () 176 (delete-frame frame))
177
178 (defun bench-mark-make-multiple-frames ()
179 "How quickly can emacs create a new frame."
180 (make-frame))
181
182 (defun bench-mark-delete-multiple-frames (frame)
183 "How quickly can emacs create a new frame."
184 (delete-frame frame))
185
186
187 ;-----------------------------------------------------------------------------
188 (defconst bench-mark-make-words-buffer nil)
189 (defconst bench-mark-make-words-buffer-name "*bench-mark-make-words*")
190 (defconst bench-mark-make-words-number-of-words 10000)
191
192 (defun bench-handler-make-words (times)
193 (setq bench-mark-make-words-buffer (get-buffer-create bench-mark-make-words-buffer-name))
194 (set-buffer bench-mark-make-words-buffer)
195 (while (> times 0)
196 (bench-mark-make-words)
197 (erase-buffer)
198 (setq times (- times 1)))
199 (kill-buffer bench-mark-make-words-buffer)
200 )
201
202 (defun bench-mark-make-words ()
125 "How long does it take to generate lots of random words." 203 "How long does it take to generate lots of random words."
126 (set-buffer (get-buffer-create bench-sort-buffer)) 204 (let ((tmp-words bench-mark-make-words-number-of-words))
127 (let ((tmp-words bench-sort-number-words))
128 (while (not (= tmp-words 0)) 205 (while (not (= tmp-words 0))
129 (let ((word-len (random 10))) 206 (let ((word-len (random 10)))
130 (while (not (= word-len 0)) 207 (while (not (= word-len 0))
131 (insert (+ ?a (random 25))) 208 (insert (+ ?a (random 25)))
132 (setq word-len (- word-len 1)))) 209 (setq word-len (- word-len 1))))
133 (insert "\n") 210 (insert "\n")
134 (setq tmp-words (- tmp-words 1))))) 211 (setq tmp-words (- tmp-words 1)))))
135 212
136 ;----------------------------------------------------------------------------- 213 ;-----------------------------------------------------------------------------
137 214 (defconst bench-mark-sort-words-buffer-name "*bench-mark-sort-words*")
138 (defun bench-mark-6 () 215 (defconst bench-mark-sort-words-buffer nil)
139 "How long does it take to sort the random words from bench-mark-5." 216 (defconst bench-mark-sort-words-number-words 10000)
140 (set-buffer (get-buffer-create bench-sort-buffer)) 217
218 (defun bench-handler-sort-words (times)
219 (setq bench-mark-sort-words-buffer (get-buffer-create bench-mark-sort-words-buffer-name))
220 (switch-to-buffer bench-mark-sort-words-buffer)
221 (while (> times 0)
222 (bench-pre-sort-words) ;Generate the random words
223 (bench-mark-sort-words) ;Sort those puppies
224 (erase-buffer)
225 (setq times (- times 1)))
226 (kill-buffer bench-mark-sort-words-buffer)
227 )
228
229 (defun bench-pre-sort-words ()
230 "How long does it take to generate lots of random words."
231 (let ((tmp-words bench-mark-sort-words-number-words))
232 (while (not (= tmp-words 0))
233 (let ((word-len (random 10)))
234 (while (not (= word-len 0))
235 (insert (+ ?a (random 25)))
236 (setq word-len (- word-len 1))))
237 (insert "\n")
238 (setq tmp-words (- tmp-words 1)))))
239
240 (defun bench-mark-sort-words ()
141 (sort-lines nil (point-min) (point-max)) 241 (sort-lines nil (point-min) (point-max))
142 ) 242 )
143 243
144 ;----------------------------------------------------------------------------- 244 ;-----------------------------------------------------------------------------
145 (defun bench-mark-7 () 245 ; Byte compile a file
246 (defun bench-handler-byte-compile (times)
247 (while (> times 0)
248 (bench-mark-byte-compile)
249 (setq times (- times 1)))
250 )
251
252 (defun bench-mark-byte-compile ()
146 "How long does it take to byte-compile a large lisp file" 253 "How long does it take to byte-compile a large lisp file"
147 (byte-compile-file bench-large-lisp-file) 254 (byte-compile-file bench-lisp-file)
148 ) 255 )
149 256
150 ;----------------------------------------------------------------------------- 257 ;-----------------------------------------------------------------------------
151 (defun bench-mark-8 () 258 ; Run through a loop
259
260 (defconst bench-mark-loop-count 250000)
261
262 (defun bench-handler-loop (times)
263 (while (> times 0)
264 (bench-mark-loop)
265 (setq times (- times 1)))
266 )
267
268 (defun bench-mark-loop ()
152 "How long does it take to run through a loop." 269 "How long does it take to run through a loop."
153 (let ((count 250000)) 270 (let ((count bench-mark-loop-count))
154 (let ((i 0) (gcount 0)) 271 (let ((i 0) (gcount 0))
155 (while (< i count) 272 (while (< i count)
156 (increment) 273 (increment)
157 (setq i (1+ i))) 274 (setq i (1+ i)))
158 (message "gcount = %d" gcount)))) 275 (message "gcount = %d" gcount))))
159 276
160 (defun increment () 277 (defun increment ()
161 "Increment a variable for bench-mark-8." 278 "Increment a variable for bench-mark-loop."
162 (setq gcount (1+ gcount))) 279 (setq gcount (1+ gcount)))
163 280
164 ;----------------------------------------------------------------------------- 281 ;-----------------------------------------------------------------------------
165 (defun bench-mark-9 () 282 (defconst bench-mark-large-list-list-size 500000
166 (let ((tmp-foo bench-number-of-large-lists)) 283 "Size of list to use in small list creation/garbage collection")
284 (defconst bench-mark-large-list-num-lists 10)
285
286 (defun bench-handler-large-list (times)
287 (let ((tmp-foo bench-mark-large-list-num-lists))
167 (while (> tmp-foo 0) 288 (while (> tmp-foo 0)
168 (make-list bench-large-list-size '1) 289 (bench-mark-large-list)
290 (setq tmp-foo (- tmp-foo 1))))
291 )
292
293 (defun bench-mark-large-list ()
294 (make-list bench-mark-large-list-list-size '1)
295 )
296
297 ;-----------------------------------------------------------------------------
298 (defun bench-mark-large-list-garbage-collect (times)
299 (garbage-collect)
300 )
301
302 ;-----------------------------------------------------------------------------
303 (defconst bench-mark-small-list-list-size 10
304 "Size of list to use in small list creation/garbage collection")
305
306 (defconst bench-mark-small-list-num-lists 100000
307 "Number of lists to use in small list creation/garbage collections")
308
309 (defun bench-handler-small-list (times)
310 (let ((tmp-foo bench-mark-small-list-num-lists))
311 (while (> tmp-foo 0)
312 (bench-mark-small-list)
169 (setq tmp-foo (- tmp-foo 1))) 313 (setq tmp-foo (- tmp-foo 1)))
170 ) 314 ))
171 ) 315
172 316 (defun bench-mark-small-list ()
173 ;----------------------------------------------------------------------------- 317 (make-list bench-mark-small-list-list-size '1)
174 (defun bench-mark-10 () 318 )
319
320 ;-----------------------------------------------------------------------------
321 (defun bench-mark-small-list-garbage-collect (times)
175 (garbage-collect) 322 (garbage-collect)
176 ) 323 )
177 324
178 ;----------------------------------------------------------------------------- 325 ;-----------------------------------------------------------------------------
179 (defun bench-mark-11 () 326 (defconst bench-mark-insert-into-empty-buffer-num-words 100000)
180 (let ((tmp-foo bench-number-of-small-lists)) 327
181 (while (> tmp-foo 0) 328 (defun bench-handler-insert-into-empty-buffer ()
182 (make-list bench-small-list-size '1) 329 (set-buffer (get-buffer-create "*tmp*"))
183 (setq tmp-foo (- tmp-foo 1)) 330 (bench-mark-insert-into-empty-buffer)
184 )) 331 (erase-buffer)
185 ) 332 (kill-buffer "*tmp*")
186 333 )
187 ;----------------------------------------------------------------------------- 334
188 (defun bench-mark-12 () 335 (defun bench-mark-insert-into-empty-buffer ()
189 (garbage-collect) 336 (let ((a bench-mark-insert-into-empty-buffer-num-words))
190 ) 337 (while (> a 0)
191 338 (insert "0123456789\n")
192 ;----------------------------------------------------------------------------- 339 (setq a (1- a))))
193 (defun bench-mark-13 () 340 )
194 (unwind-protect
195 (let ((a 100000))
196 (set-buffer (get-buffer-create "*tmp*"))
197 (erase-buffer)
198 (while (> a 0)
199 (insert "0123456789\n")
200 (setq a (1- a))))
201 (kill-buffer "*tmp*")))
202
203 341
204 ;============================================================================= 342 ;=============================================================================
343 (defconst bench-version (let ((rcsvers "$Revision: 1.2 $"))
344 (substring rcsvers 11 (- (length rcsvers) 2)))
345 "*Version number of bench.el")
346
347 (defconst temp-dir (file-name-as-directory
348 (or (getenv "TMPDIR")
349 (getenv "TMP")
350 (getenv "TEMP")
351 "/tmp/")))
352
353 (defconst bench-large-lisp-file (concat temp-dir "./bench-large.el")
354 "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el")
355
356 (defconst bench-small-lisp-file (concat temp-dir "./bench-small.el")
357 "Large lisp file to use in benchmarks should be /temp-dir/bench-text.el")
358
359 (defconst bench-lisp-file bench-large-lisp-file)
360
361 (defconst bench-pre-bench-hook nil
362 "Hook for individual bench mark initialization.")
363
364 (defconst bench-post-bench-hook nil
365 "Hook for individual bench mark statistic collection.")
366
367 (defconst bench-mark-function-alist
368 '(
369 (bench-handler-hanoi . "Tower of Hanoi")
370 (bench-handler-font-lock . "Font Lock")
371 (bench-handler-scrolling . "Large File scrolling")
372 (bench-handler-make-frames . "Frame Creation")
373 (bench-handler-make-words . "Generate Words")
374 (bench-handler-sort-words . "Sort Buffer")
375 (bench-handler-byte-compile . "Large File bytecompilation")
376 (bench-handler-loop . "Loop Computation")
377 (bench-handler-large-list . "Make a Few Large Size List")
378 (bench-mark-large-list-garbage-collect . "Garbage Collection Large Size List")
379 (bench-handler-small-list . "Make Several Small Size List")
380 (bench-mark-small-list-garbage-collect . "Garbage Collection Small Size List")
381 (bench-handler-insert-into-empty-buffer . "Text Insertion")
382 ))
383
384 (defconst bench-enabled-profiling nil
385 "If non-nil and the underlying emacs supports it, do function profiling.")
386
387 (defconst bench-mark-profile-buffer "*Profile*"
388 "Buffer used for collection of profiling data.")
389
390 (setq gc-cons-threshold 40000000)
391
392 (defconst bench-small-frame-alist '((height . 24) (width . 80)))
393 (defconst bench-medium-frame-alist '((height . 48) (width . 80)))
394 (defconst bench-large-frame-alist '((height . 72) (width . 80)))
395
396 (defsubst bench-get-time ()
397 ;; Stolen from elp
398 ;; get current time in seconds and microseconds. I throw away the
399 ;; most significant 16 bits of seconds since I doubt we'll ever want
400 ;; to profile lisp on the order of 18 hours. See notes at top of file.
401 (let ((now (current-time)))
402 (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0))))
403
205 (defun bench-init () 404 (defun bench-init ()
206 "Initialize profiling for bench marking package." 405 "Initialize profiling for bench marking package."
207 (if (fboundp 'start-profiling) 406 (if (fboundp 'start-profiling)
208 (let ((buf (get-buffer-create bench-mark-profile-buffer))) 407 (let ((buf (get-buffer-create bench-mark-profile-buffer)))
209 (erase-buffer buf) 408 (erase-buffer buf)
210 (when (profiling-active-p) 409 (when (profiling-active-p)
211 (stop-profiling) 410 (stop-profiling)
212 (clear-profiling-info))) 411 (clear-profiling-info)))
213 (message "Profiling not available in this Emacs.") 412 (message "Profiling not available in this XEmacs.")
214 (sit-for 2))) 413 (sit-for 2)))
414
415 (defun bench-test-init ()
416 "Initialize profiling for bench marking package."
417 (if (fboundp 'start-profiling)
418 (let ((buf (get-buffer-create bench-mark-profile-buffer)))
419 (erase-buffer buf)
420 (when (profiling-active-p)
421 (stop-profiling)
422 (clear-profiling-info)))
423 (message "Profiling not available in this XEmacs.")
424 (sit-for 2))
425 (setq bench-lisp-file bench-small-lisp-file)
426 (setq bench-mark-make-words-number-of-words 100)
427 (setq bench-mark-sort-words-number-of-words 100)
428 (setq bench-mark-loop-count 10000)
429 (setq bench-mark-large-list-list-size 500)
430 (setq bench-mark-small-list-num-lists 100)
431 (setq bench-mark-insert-into-empty-buffer-num-words 100)
432
433 )
215 434
216 (defun bench-profile-start (test-name) 435 (defun bench-profile-start (test-name)
217 "Turn on profiling for test `test-name'." 436 "Turn on profiling for test `test-name'."
218 (when (and bench-enabled-profiling 437 (when (and bench-enabled-profiling
219 (fboundp 'start-profiling)) 438 (fboundp 'start-profiling))
238 (clear-profiling-info))) 457 (clear-profiling-info)))
239 458
240 (add-hook 'bench-pre-bench-hook 'bench-profile-start) 459 (add-hook 'bench-pre-bench-hook 'bench-profile-start)
241 (add-hook 'bench-post-bench-hook 'bench-profile-stop) 460 (add-hook 'bench-post-bench-hook 'bench-profile-stop)
242 461
462 (defun bench-post ()
463 "Post processing of elp results"
464 ; I can't figure out a good way to sort the lines numerically.
465 ; If someone comes up with a good way, let me know.
466 (goto-char (point-min))
467 (next-line 2)
468 (sort-lines nil (point) (point-max))
469 (mail-results (current-buffer))
470 )
471
243 (defun bench (arg) 472 (defun bench (arg)
244 "Run a series of benchmarks." 473 "Run a series of benchmarks."
245 (interactive "p") 474 (interactive "p")
246 (elp-instrument-package "bench-mark") ;Only instrument functions 475 (elp-instrument-package "bench-mark") ;Only instrument functions
247 ;beginning with bench-mark 476 ;beginning with bench-mark
248 (bench-init) 477 (bench-init)
249 (if (fboundp 'byte-optimize) ;Turn off byte-compile optimization in XEmacs 478 (if (fboundp 'byte-optimize) ;Turn off byte-compile optimization in XEmacs
250 (setq byte-optimize nil)) 479 (setq byte-optimize nil))
480 (if (fboundp 'menu-bar-mode)
481 (menu-bar-mode -1)) ;Turn off menu-bar
251 (let ((benches bench-mark-function-alist)) 482 (let ((benches bench-mark-function-alist))
252 (while benches 483 (while benches
253 (let ((test-name (cdar benches))) 484 (let ((test-name (cdar benches)))
254 (run-hook-with-args 'bench-pre-bench-hook test-name) 485 (run-hook-with-args 'bench-pre-bench-hook test-name)
255 (let ((count arg)) 486 (message "Running %s - %s." (symbol-name (caar benches)) test-name)
256 (while (> count 0) 487 (funcall (caar benches) arg)
257 (message "Running %s - %s." (symbol-name (caar benches)) test-name)
258 (funcall (caar benches))
259 (setq count (1- count))))
260 (setq benches (cdr benches)) 488 (setq benches (cdr benches))
261 (run-hook-with-args 'bench-post-bench-hook test-name)) 489 (run-hook-with-args 'bench-post-bench-hook test-name))
262 )) 490 ))
263 (elp-results) 491 (elp-results)
264 (goto-char (point-min)) 492 (bench-post)
265 (next-line 2) 493 )
266 ; I can't figure out a good way to sort the lines numerically. 494
267 ; If someone comes up with a good way, let me know. 495 (defun bench-test (arg)
268 (sort-lines nil (point) (point-max)) 496 "Run all the tests but with smaller values so the tests run quicker.
269 (goto-char (point-min)) 497 This way I don't have to sit around to see if the tests complete"
498 (interactive "p")
499 (elp-instrument-package "bench-mark") ;Only instrument functions
500 ;beginning with bench-mark
501 (bench-test-init)
502 (if (fboundp 'byte-optimize) ;Turn off byte-compile optimization in XEmacs
503 (setq byte-optimize nil))
504 (if (fboundp 'menu-bar-mode)
505 (menu-bar-mode -1)) ;Turn off menu-bar
270 (let ((benches bench-mark-function-alist)) 506 (let ((benches bench-mark-function-alist))
271 (while benches 507 (while benches
272 (goto-char (point-min)) 508 (let ((test-name (cdar benches)))
273 (let ((test-name (cdar benches)) 509 (run-hook-with-args 'bench-pre-bench-hook test-name)
274 (test-func (caar benches))) 510 (message "Running %s - %s." (symbol-name (caar benches)) test-name)
275 (search-forward (symbol-name test-func)) 511 (funcall (caar benches) arg)
276 (end-of-line)
277 (insert " <= " test-name))
278 (setq benches (cdr benches)) 512 (setq benches (cdr benches))
513 (run-hook-with-args 'bench-post-bench-hook test-name))
279 )) 514 ))
280 ) 515 (elp-results)
281 516 (bench-post)
517 )
518
519
520 (defconst bench-send-results-to "holder@rsn.hp.com")
521 (defconst bench-subject "Bench Mark Results")
522 (defconst bench-system-form (format "
523
524 Please fill in as much of the following as you can
525 and then hit C-cC-c to send.
526
527 CPU Manufacturer (Intel,HP,DEC,etc.):
528 CPU Type (Pentium,Alpha):
529 CPU Speed:
530 RAM (in meg):
531 Emacs Version: %s
532 Emacs (version): %s
533 Compile line:
534 Bench Version: %s
535 " emacs-version (emacs-version) bench-version))
536
537 (defun mail-results (buffer)
538 (mail nil bench-send-results-to bench-subject)
539 (sit-for 0)
540 (goto-char (point-max))
541 (insert bench-system-form)
542 (insert-buffer buffer)
543 )
282 ;;; bench.el ends here 544 ;;; bench.el ends here