Mercurial > hg > xemacs-beta

comparison lisp/utils/bench.el @ 8:4b173ad71786 r19-15b5

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b5
author cvs
date Mon, 13 Aug 2007 08:47:35 +0200
parents
children 9ee227acff29
comparison
equal deleted inserted replaced
7:c153ca296910 8:4b173ad71786
1 ;;; bench.el --- a crude benchmark for emacsen
2 ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
3
4 ;; Author: Shane Holder <holder@rsn.hp.com>
5 ;; Adapted-By: Steve Baur <steve@altair.xemacs.org>
6
7 ;; This file is part of XEmacs.
8
9 ;; 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
11 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; any later version.
13
14 ;; XEmacs is distributed in the hope that it will be useful, but
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
22 ;; 02111-1307, USA.
23
24 ;;; Commentary:
25
26 ;; To run
27 ;; Extract the shar file in /tmp, or modify bench-large-lisp-file to
28 ;; point to the gnus-bench.el file.
29 ;; At the shell prompt emacs -q --no-site-file <= don't load users .emacs or
30 ;; site-file
31 ;; M-x byte-compile-file "/tmp/bench.el"
32 ;; M-x load-file "/tmp/bench.elc"
33 ;; In the scratch buffer (bench 1)
34
35 ;;; Code:
36
37 ;; Use elp to profile benchmarks
38 (require 'elp)
39 (eval-when-compile (require 'cl)) ; Emacs doesn't have when and cdar
40
41 (defconst bench-version 1.0)
42
43 (defconst bench-large-lisp-file "/usr/local/lib/gnus-bench.el"
44 "Large lisp file to use in benchmarks.
45 Grab `ftp://ftp.xemacs.org/pub/beta/contrib/gnus-bench.el.gz' for a good
46 version. Don't install this file with Emacs/XEmacs.")
47
48 (defconst bench-sort-buffer "*Sort*"
49 "File to be used in the sort benchmark")
50
51 (defconst bench-sort-number-words 10000
52 "Number of words to use in sort benchmark")
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."
100 (hanoi 4))
101
102 ;-----------------------------------------------------------------------------
103 (defun bench-mark-2 ()
104 "How long to fonitfy a large file."
105 (find-file bench-large-lisp-file)
106 (font-lock-fontify-buffer))
107
108 ;-----------------------------------------------------------------------------
109 (defun bench-mark-3 ()
110 "How long does it take to scroll down through a large file."
111 (let ((buffer-read-only t))
112 (goto-char (point-min))
113 (while (< (point) (point-max))
114 (next-line 1)
115 (sit-for 0))))
116
117 ;-----------------------------------------------------------------------------
118 (defun bench-mark-4 ()
119 "How quickly can emacs create a new frame."
120 (make-frame))
121
122
123 ;-----------------------------------------------------------------------------
124 (defun bench-mark-5 ()
125 "How long does it take to generate lots of random words."
126 (set-buffer (get-buffer-create bench-sort-buffer))
127 (let ((tmp-words bench-sort-number-words))
128 (while (not (= tmp-words 0))
129 (let ((word-len (random 10)))
130 (while (not (= word-len 0))
131 (insert (+ ?a (random 25)))
132 (setq word-len (- word-len 1))))
133 (insert "\n")
134 (setq tmp-words (- tmp-words 1)))))
135
136 ;-----------------------------------------------------------------------------
137
138 (defun bench-mark-6 ()
139 "How long does it take to sort the random words from bench-mark-5."
140 (set-buffer (get-buffer-create bench-sort-buffer))
141 (sort-lines nil (point-min) (point-max))
142 )
143
144 ;-----------------------------------------------------------------------------
145 (defun bench-mark-7 ()
146 "How long does it take to byte-compile a large lisp file"
147 (byte-compile-file bench-large-lisp-file)
148 )
149
150 ;-----------------------------------------------------------------------------
151 (defun bench-mark-8 ()
152 "How long does it take to run through a loop."
153 (let ((count 250000))
154 (let ((i 0) (gcount 0))
155 (while (< i count)
156 (increment)
157 (setq i (1+ i)))
158 (message "gcount = %d" gcount))))
159
160 (defun increment ()
161 "Increment a variable for bench-mark-8."
162 (setq gcount (1+ gcount)))
163
164 ;-----------------------------------------------------------------------------
165 (defun bench-mark-9 ()
166 (let ((tmp-foo bench-number-of-large-lists))
167 (while (> tmp-foo 0)
168 (make-list bench-large-list-size '1)
169 (setq tmp-foo (- tmp-foo 1)))
170 )
171 )
172
173 ;-----------------------------------------------------------------------------
174 (defun bench-mark-10 ()
175 (garbage-collect)
176 )
177
178 ;-----------------------------------------------------------------------------
179 (defun bench-mark-11 ()
180 (let ((tmp-foo bench-number-of-small-lists))
181 (while (> tmp-foo 0)
182 (make-list bench-small-list-size '1)
183 (setq tmp-foo (- tmp-foo 1))
184 ))
185 )
186
187 ;-----------------------------------------------------------------------------
188 (defun bench-mark-12 ()
189 (garbage-collect)
190 )
191
192 ;-----------------------------------------------------------------------------
193 (defun bench-mark-13 ()
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
204 ;=============================================================================
205 (defun bench-init ()
206 "Initialize profiling for bench marking package."
207 (if (fboundp 'start-profiling)
208 (let ((buf (get-buffer-create bench-mark-profile-buffer)))
209 (erase-buffer buf)
210 (when (profiling-active-p)
211 (stop-profiling)
212 (clear-profiling-info)))
213 (message "Profiling not available in this Emacs.")
214 (sit-for 2)))
215
216 (defun bench-profile-start (test-name)
217 "Turn on profiling for test `test-name'."
218 (when (and bench-enabled-profiling
219 (fboundp 'start-profiling))
220 (when (profiling-active-p)
221 (stop-profiling))
222 (let ((buf (get-buffer-create bench-mark-profile-buffer)))
223 (save-excursion
224 (set-buffer buf)
225 (insert "Test `" test-name "'\n")
226 (start-profiling)))))
227
228 (defun bench-profile-stop (test-name)
229 "Turn off profiling for test `test-name'."
230 (when (and bench-enabled-profiling
231 (fboundp 'stop-profiling))
232 (stop-profiling)
233 (let ((buf (get-buffer-create bench-mark-profile-buffer)))
234 (save-excursion
235 (set-buffer buf)
236 (insert (with-output-to-string
237 (pretty-print-profiling-info)) "\n")))
238 (clear-profiling-info)))
239
240 (add-hook 'bench-pre-bench-hook 'bench-profile-start)
241 (add-hook 'bench-post-bench-hook 'bench-profile-stop)
242
243 (defun bench (arg)
244 "Run a series of benchmarks."
245 (interactive "p")
246 (elp-instrument-package "bench-mark") ;Only instrument functions
247 ;beginning with bench-mark
248 (bench-init)
249 (if (fboundp 'byte-optimize) ;Turn off byte-compile optimization in XEmacs
250 (setq byte-optimize nil))
251 (let ((benches bench-mark-function-alist))
252 (while benches
253 (let ((test-name (cdar benches)))
254 (run-hook-with-args 'bench-pre-bench-hook test-name)
255 (let ((count arg))
256 (while (> count 0)
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))
261 (run-hook-with-args 'bench-post-bench-hook test-name))
262 ))
263 (elp-results)
264 (goto-char (point-min))
265 (next-line 2)
266 ; I can't figure out a good way to sort the lines numerically.
267 ; If someone comes up with a good way, let me know.
268 (sort-lines nil (point) (point-max))
269 (goto-char (point-min))
270 (let ((benches bench-mark-function-alist))
271 (while benches
272 (goto-char (point-min))
273 (let ((test-name (cdar benches))
274 (test-func (caar benches)))
275 (search-forward (symbol-name test-func))
276 (end-of-line)
277 (insert " <= " test-name))
278 (setq benches (cdr benches))
279 ))
280 )
281
282 ;;; bench.el ends here