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 ))
|
|
75
|
|
76 (defconst bench-enabled-profiling nil
|
|
77 "If non-nil and the underlying emacs supports it, do function profiling.")
|
|
78
|
|
79 (defconst bench-mark-profile-buffer "*Profile*"
|
|
80 "Buffer used for collection of profiling data.")
|
|
81
|
|
82 (setq gc-cons-threshold 40000000)
|
|
83
|
|
84 (defconst bench-number-of-large-lists 10
|
|
85 "Number of lists to use in large list creation/garbage collections")
|
|
86
|
|
87 (defconst bench-number-of-small-lists 1000000
|
|
88 "Number of lists to use in small list creation/garbage collections")
|
|
89
|
|
90 (defconst bench-large-list-size 1000000
|
|
91 "Size of list to use in small list creation/garbage collection")
|
|
92
|
|
93 (defconst bench-small-list-size 10
|
|
94 "Size of list to use in small list creation/garbage collection")
|
|
95
|
|
96 ;-----------------------------------------------------------------------------
|
|
97 (defun bench-mark-1 ()
|
|
98 "How long to complete the tower of hanoi."
|
|
99 (hanoi 4))
|
|
100
|
|
101 ;-----------------------------------------------------------------------------
|
|
102 (defun bench-mark-2 ()
|
|
103 "How long to fonitfy a large file."
|
|
104 (find-file bench-large-lisp-file)
|
|
105 (font-lock-fontify-buffer))
|
|
106
|
|
107 ;-----------------------------------------------------------------------------
|
|
108 (defun bench-mark-3 ()
|
|
109 "How long does it take to scroll down through a large file."
|
|
110 (let ((buffer-read-only t))
|
|
111 (goto-char (point-min))
|
|
112 (while (< (point) (point-max))
|
|
113 (next-line 1)
|
|
114 (sit-for 0))))
|
|
115
|
|
116 ;-----------------------------------------------------------------------------
|
|
117 (defun bench-mark-4 ()
|
|
118 "How quickly can emacs create a new frame."
|
|
119 (make-frame))
|
|
120
|
|
121
|
|
122 ;-----------------------------------------------------------------------------
|
|
123 (defun bench-mark-5 ()
|
|
124 "How long does it take to generate lots of random words."
|
|
125 (set-buffer (get-buffer-create bench-sort-buffer))
|
|
126 (let ((tmp-words bench-sort-number-words))
|
|
127 (while (not (= tmp-words 0))
|
|
128 (let ((word-len (random 10)))
|
|
129 (while (not (= word-len 0))
|
|
130 (insert (+ ?a (random 25)))
|
|
131 (setq word-len (- word-len 1))))
|
|
132 (insert "\n")
|
|
133 (setq tmp-words (- tmp-words 1)))))
|
|
134
|
|
135 ;-----------------------------------------------------------------------------
|
|
136
|
|
137 (defun bench-mark-6 ()
|
|
138 "How long does it take to sort the random words from bench-mark-5."
|
|
139 (set-buffer (get-buffer-create bench-sort-buffer))
|
|
140 (sort-lines nil (point-min) (point-max))
|
|
141 )
|
|
142
|
|
143 ;-----------------------------------------------------------------------------
|
|
144 (defun bench-mark-7 ()
|
|
145 "How long does it take to byte-compile a large lisp file"
|
|
146 (byte-compile-file bench-large-lisp-file)
|
|
147 )
|
|
148
|
|
149 ;-----------------------------------------------------------------------------
|
|
150 (defun bench-mark-8 ()
|
|
151 "How long does it take to run through a loop."
|
|
152 (let ((count 250000))
|
|
153 (let ((i 0) (gcount 0))
|
|
154 (while (< i count)
|
|
155 (increment)
|
|
156 (setq i (1+ i)))
|
|
157 (message "gcount = %d" gcount))))
|
|
158
|
|
159 (defun increment ()
|
|
160 "Increment a variable for bench-mark-8."
|
|
161 (setq gcount (1+ gcount)))
|
|
162
|
|
163 ;-----------------------------------------------------------------------------
|
|
164 (defun bench-mark-9 ()
|
|
165 (let ((tmp-foo bench-number-of-large-lists))
|
|
166 (while (> tmp-foo 0)
|
|
167 (make-list bench-large-list-size '1)
|
|
168 (setq tmp-foo (- tmp-foo 1)))
|
|
169 )
|
|
170 )
|
|
171
|
|
172 ;-----------------------------------------------------------------------------
|
|
173 (defun bench-mark-10 ()
|
|
174 (garbage-collect)
|
|
175 )
|
|
176
|
|
177 ;-----------------------------------------------------------------------------
|
|
178 (defun bench-mark-11 ()
|
|
179 (let ((tmp-foo bench-number-of-small-lists))
|
|
180 (while (> tmp-foo 0)
|
|
181 (make-list bench-small-list-size '1)
|
|
182 (setq tmp-foo (- tmp-foo 1))
|
|
183 ))
|
|
184 )
|
|
185
|
|
186 ;-----------------------------------------------------------------------------
|
|
187 (defun bench-mark-12 ()
|
|
188 (garbage-collect)
|
|
189 )
|
|
190
|
|
191 ;=============================================================================
|
|
192 (defun bench-init ()
|
|
193 "Initialize profiling for bench marking package."
|
|
194 (if (fboundp 'start-profiling)
|
|
195 (let ((buf (get-buffer-create bench-mark-profile-buffer)))
|
|
196 (erase-buffer buf)
|
|
197 (when (profiling-active-p)
|
|
198 (stop-profiling)
|
|
199 (clear-profiling-info)))
|
|
200 (message "Profiling not available in this Emacs.")
|
|
201 (sit-for 2)))
|
|
202
|
|
203 (defun bench-profile-start (test-name)
|
|
204 "Turn on profiling for test `test-name'."
|
|
205 (when (and bench-enabled-profiling
|
|
206 (fboundp 'start-profiling))
|
|
207 (when (profiling-active-p)
|
|
208 (stop-profiling))
|
|
209 (let ((buf (get-buffer-create bench-mark-profile-buffer)))
|
|
210 (save-excursion
|
|
211 (set-buffer buf)
|
|
212 (insert "Test `" test-name "'\n")
|
|
213 (start-profiling)))))
|
|
214
|
|
215 (defun bench-profile-stop (test-name)
|
|
216 "Turn off profiling for test `test-name'."
|
|
217 (when (and bench-enabled-profiling
|
|
218 (fboundp 'stop-profiling))
|
|
219 (stop-profiling)
|
|
220 (let ((buf (get-buffer-create bench-mark-profile-buffer)))
|
|
221 (save-excursion
|
|
222 (set-buffer buf)
|
|
223 (insert (with-output-to-string
|
|
224 (pretty-print-profiling-info)) "\n")))
|
|
225 (clear-profiling-info)))
|
|
226
|
|
227 (add-hook 'bench-pre-bench-hook 'bench-profile-start)
|
|
228 (add-hook 'bench-post-bench-hook 'bench-profile-stop)
|
|
229
|
|
230 (defun bench (arg)
|
|
231 "Run a series of benchmarks."
|
|
232 (interactive "p")
|
|
233 (elp-instrument-package "bench-mark") ;Only instrument functions
|
|
234 ;beginning with bench-mark
|
|
235 (bench-init)
|
|
236 (if (fboundp 'byte-optimize) ;Turn off byte-compile optimization in XEmacs
|
|
237 (setq byte-optimize nil))
|
|
238 (let ((benches bench-mark-function-alist))
|
|
239 (while benches
|
|
240 (let ((test-name (cdar benches)))
|
|
241 (run-hook-with-args 'bench-pre-bench-hook test-name)
|
|
242 (let ((count arg))
|
|
243 (while (> count 0)
|
|
244 (message "Running %s - %s." (symbol-name (caar benches)) test-name)
|
|
245 (funcall (caar benches))
|
|
246 (setq count (1- count))))
|
|
247 (setq benches (cdr benches))
|
|
248 (run-hook-with-args 'bench-post-bench-hook test-name))
|
|
249 ))
|
|
250 (elp-results)
|
|
251 (goto-char (point-min))
|
|
252 (next-line 2)
|
|
253 ; I can't figure out a good way to sort the lines numerically.
|
|
254 ; If someone comes up with a good way, let me know.
|
|
255 (sort-lines nil (point) (point-max))
|
|
256 (goto-char (point-min))
|
|
257 (let ((benches bench-mark-function-alist))
|
|
258 (while benches
|
|
259 (goto-char (point-min))
|
|
260 (let ((test-name (cdar benches))
|
|
261 (test-func (caar benches)))
|
|
262 (search-forward (symbol-name test-func))
|
|
263 (end-of-line)
|
|
264 (insert " <= " test-name))
|
|
265 (setq benches (cdr benches))
|
|
266 ))
|
|
267 )
|
|
268
|
|
269 ;;; bench.el ends here
|