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

Import from CVS: tag r20-0b31
author cvs
date Mon, 13 Aug 2007 09:03:46 +0200
parents
children 54cc21c15cbb
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
72
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
1 ;;; bench.el --- a crude benchmark for emacsen
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
2 ;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
3
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
4 ;; Author: Shane Holder <holder@rsn.hp.com>
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
5 ;; Adapted-By: Steve Baur <steve@altair.xemacs.org>
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
6
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
7 ;; This file is part of XEmacs.
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
8
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
9 ;; XEmacs is free software; you can redistribute it and/or modify it
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
10 ;; under the terms of the GNU General Public License as published by
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
11 ;; the Free Software Foundation; either version 2, or (at your option)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
12 ;; any later version.
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
13
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
14 ;; XEmacs is distributed in the hope that it will be useful, but
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
17 ;; General Public License for more details.
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
18
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
19 ;; You should have received a copy of the GNU General Public License
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
21 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
22 ;; 02111-1307, USA.
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
23
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
24 ;;; Commentary:
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
25
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
26 ;; To run
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
27 ;; Extract the shar file in /tmp, or modify bench-large-lisp-file to
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
28 ;; point to the gnus-bench.el file.
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
29 ;; At the shell prompt emacs -q --no-site-file <= don't load users .emacs or
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
30 ;; site-file
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
31 ;; M-x byte-compile-file "/tmp/bench.el"
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
32 ;; M-x load-file "/tmp/bench.elc"
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
33 ;; In the scratch buffer (bench 1)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
34
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
35 ;;; Code:
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
36
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
37 ;; Use elp to profile benchmarks
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
38 (require 'elp)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
39 (eval-when-compile (require 'cl)) ; Emacs doesn't have when and cdar
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
40
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
41 (defconst bench-version 1.0)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
42
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
43 (defconst bench-large-lisp-file "/usr/local/lib/gnus-bench.el"
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
44 "Large lisp file to use in benchmarks.
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
45 Grab `ftp://ftp.xemacs.org/pub/beta/contrib/gnus-bench.el.gz' for a good
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
46 version. Don't install this file with Emacs/XEmacs.")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
47
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
48 (defconst bench-sort-buffer "*Sort*"
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
49 "File to be used in the sort benchmark")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
50
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
51 (defconst bench-sort-number-words 10000
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
52 "Number of words to use in sort benchmark")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
53
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
54 (defconst bench-pre-bench-hook nil
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
55 "Hook for individual bench mark initialization.")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
56
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
57 (defconst bench-post-bench-hook nil
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
58 "Hook for individual bench mark statistic collection.")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
59
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
60 (defconst bench-mark-function-alist
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
61 '(
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
62 (bench-mark-1 . "Tower of Hanoi")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
63 (bench-mark-2 . "Font Lock")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
64 (bench-mark-3 . "Large File scrolling")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
65 (bench-mark-4 . "Frame Creation")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
66 (bench-mark-5 . "Generate Words")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
67 (bench-mark-6 . "Sort Buffer")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
68 (bench-mark-7 . "Large File bytecompilation")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
69 (bench-mark-8 . "Loop Computation")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
70 (bench-mark-9 . "Make a Few Large Size List")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
71 (bench-mark-10 . "Garbage Collection Large Size List")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
72 (bench-mark-11 . "Make Several Small Size List")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
73 (bench-mark-12 . "Garbage Collection Small Size List")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
74 ))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
75
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
76 (defconst bench-enabled-profiling nil
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
77 "If non-nil and the underlying emacs supports it, do function profiling.")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
78
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
79 (defconst bench-mark-profile-buffer "*Profile*"
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
80 "Buffer used for collection of profiling data.")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
81
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
82 (setq gc-cons-threshold 40000000)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
83
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
84 (defconst bench-number-of-large-lists 10
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
85 "Number of lists to use in large list creation/garbage collections")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
86
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
87 (defconst bench-number-of-small-lists 1000000
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
88 "Number of lists to use in small list creation/garbage collections")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
89
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
90 (defconst bench-large-list-size 1000000
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
91 "Size of list to use in small list creation/garbage collection")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
92
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
93 (defconst bench-small-list-size 10
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
94 "Size of list to use in small list creation/garbage collection")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
95
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
96 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
97 (defun bench-mark-1 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
98 "How long to complete the tower of hanoi."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
99 (hanoi 4))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
100
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
101 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
102 (defun bench-mark-2 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
103 "How long to fonitfy a large file."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
104 (find-file bench-large-lisp-file)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
105 (font-lock-fontify-buffer))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
106
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
107 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
108 (defun bench-mark-3 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
109 "How long does it take to scroll down through a large file."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
110 (let ((buffer-read-only t))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
111 (goto-char (point-min))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
112 (while (< (point) (point-max))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
113 (next-line 1)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
114 (sit-for 0))))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
115
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
116 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
117 (defun bench-mark-4 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
118 "How quickly can emacs create a new frame."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
119 (make-frame))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
120
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
121
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
122 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
123 (defun bench-mark-5 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
124 "How long does it take to generate lots of random words."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
125 (set-buffer (get-buffer-create bench-sort-buffer))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
126 (let ((tmp-words bench-sort-number-words))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
127 (while (not (= tmp-words 0))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
128 (let ((word-len (random 10)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
129 (while (not (= word-len 0))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
130 (insert (+ ?a (random 25)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
131 (setq word-len (- word-len 1))))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
132 (insert "\n")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
133 (setq tmp-words (- tmp-words 1)))))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
134
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
135 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
136
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
137 (defun bench-mark-6 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
138 "How long does it take to sort the random words from bench-mark-5."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
139 (set-buffer (get-buffer-create bench-sort-buffer))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
140 (sort-lines nil (point-min) (point-max))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
141 )
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
142
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
143 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
144 (defun bench-mark-7 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
145 "How long does it take to byte-compile a large lisp file"
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
146 (byte-compile-file bench-large-lisp-file)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
147 )
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
148
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
149 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
150 (defun bench-mark-8 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
151 "How long does it take to run through a loop."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
152 (let ((count 250000))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
153 (let ((i 0) (gcount 0))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
154 (while (< i count)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
155 (increment)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
156 (setq i (1+ i)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
157 (message "gcount = %d" gcount))))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
158
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
159 (defun increment ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
160 "Increment a variable for bench-mark-8."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
161 (setq gcount (1+ gcount)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
162
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
163 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
164 (defun bench-mark-9 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
165 (let ((tmp-foo bench-number-of-large-lists))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
166 (while (> tmp-foo 0)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
167 (make-list bench-large-list-size '1)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
168 (setq tmp-foo (- tmp-foo 1)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
169 )
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
170 )
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
171
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
172 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
173 (defun bench-mark-10 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
174 (garbage-collect)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
175 )
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
176
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
177 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
178 (defun bench-mark-11 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
179 (let ((tmp-foo bench-number-of-small-lists))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
180 (while (> tmp-foo 0)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
181 (make-list bench-small-list-size '1)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
182 (setq tmp-foo (- tmp-foo 1))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
183 ))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
184 )
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
185
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
186 ;-----------------------------------------------------------------------------
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
187 (defun bench-mark-12 ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
188 (garbage-collect)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
189 )
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
190
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
191 ;=============================================================================
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
192 (defun bench-init ()
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
193 "Initialize profiling for bench marking package."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
194 (if (fboundp 'start-profiling)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
195 (let ((buf (get-buffer-create bench-mark-profile-buffer)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
196 (erase-buffer buf)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
197 (when (profiling-active-p)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
198 (stop-profiling)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
199 (clear-profiling-info)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
200 (message "Profiling not available in this Emacs.")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
201 (sit-for 2)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
202
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
203 (defun bench-profile-start (test-name)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
204 "Turn on profiling for test `test-name'."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
205 (when (and bench-enabled-profiling
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
206 (fboundp 'start-profiling))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
207 (when (profiling-active-p)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
208 (stop-profiling))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
209 (let ((buf (get-buffer-create bench-mark-profile-buffer)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
210 (save-excursion
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
211 (set-buffer buf)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
212 (insert "Test `" test-name "'\n")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
213 (start-profiling)))))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
214
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
215 (defun bench-profile-stop (test-name)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
216 "Turn off profiling for test `test-name'."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
217 (when (and bench-enabled-profiling
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
218 (fboundp 'stop-profiling))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
219 (stop-profiling)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
220 (let ((buf (get-buffer-create bench-mark-profile-buffer)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
221 (save-excursion
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
222 (set-buffer buf)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
223 (insert (with-output-to-string
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
224 (pretty-print-profiling-info)) "\n")))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
225 (clear-profiling-info)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
226
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
227 (add-hook 'bench-pre-bench-hook 'bench-profile-start)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
228 (add-hook 'bench-post-bench-hook 'bench-profile-stop)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
229
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
230 (defun bench (arg)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
231 "Run a series of benchmarks."
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
232 (interactive "p")
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
233 (elp-instrument-package "bench-mark") ;Only instrument functions
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
234 ;beginning with bench-mark
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
235 (bench-init)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
236 (if (fboundp 'byte-optimize) ;Turn off byte-compile optimization in XEmacs
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
237 (setq byte-optimize nil))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
238 (let ((benches bench-mark-function-alist))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
239 (while benches
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
240 (let ((test-name (cdar benches)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
241 (run-hook-with-args 'bench-pre-bench-hook test-name)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
242 (let ((count arg))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
243 (while (> count 0)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
244 (message "Running %s - %s." (symbol-name (caar benches)) test-name)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
245 (funcall (caar benches))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
246 (setq count (1- count))))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
247 (setq benches (cdr benches))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
248 (run-hook-with-args 'bench-post-bench-hook test-name))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
249 ))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
250 (elp-results)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
251 (goto-char (point-min))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
252 (next-line 2)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
253 ; I can't figure out a good way to sort the lines numerically.
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
254 ; If someone comes up with a good way, let me know.
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
255 (sort-lines nil (point) (point-max))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
256 (goto-char (point-min))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
257 (let ((benches bench-mark-function-alist))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
258 (while benches
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
259 (goto-char (point-min))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
260 (let ((test-name (cdar benches))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
261 (test-func (caar benches)))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
262 (search-forward (symbol-name test-func))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
263 (end-of-line)
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
264 (insert " <= " test-name))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
265 (setq benches (cdr benches))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
266 ))
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
267 )
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
268
b9518feda344 Import from CVS: tag r20-0b31
cvs
parents:
diff changeset
269 ;;; bench.el ends here