|
72
|
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
|
74 (bench-mark-13 . "Append to buffer")
|
|
72
|
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
|
|
74
|
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
|
|
72
|
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
|
