Mercurial > hg > xemacs-beta

comparison lisp/utils/bench.el @ 72:b9518feda344 r20-0b31

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b31
author cvs
date Mon, 13 Aug 2007 09:03:46 +0200
parents
children 54cc21c15cbb
comparison
equal deleted inserted replaced
71:bae944334fa4 72:b9518feda344
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