Mercurial > hg > xemacs-beta

comparison src/profile.c @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 859a2309aef8
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 /* Why the hell is XEmacs so fucking slow?
2 Copyright (C) 1996 Ben Wing.
3
4 This file is part of XEmacs.
5
6 XEmacs is free software; you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation; either version 2, or (at your option) any
9 later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs; see the file COPYING. If not, write to
18 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
19 Boston, MA 02111-1307, USA. */
20
21 #include <config.h>
22 #include "lisp.h"
23
24 #include "backtrace.h"
25 #include "bytecode.h"
26 #include "hash.h"
27
28 #include "syssignal.h"
29 #include "systime.h"
30
31 /*
32
33 We implement our own profiling scheme so that we can determine things
34 like which Lisp functions are occupying the most time. Any standard
35 OS-provided profiling works on C functions, which is somewhat useless.
36
37 The basic idea is simple. We set a profiling timer using
38 setitimer (ITIMER_PROF), which generates a SIGPROF every so often.
39 \(This runs not in real time but rather when the process is executing
40 or the system is running on behalf of the process.) When the signal
41 goes off, we see what we're in, and add by 1 the count associated with
42 that function.
43
44 It would be nice to use the Lisp allocation mechanism etc. to keep
45 track of the profiling information, but we can't because that's not
46 safe, and trying to make it safe would be much more work than is
47 worth.
48
49 */
50
51 c_hashtable big_profile_table;
52
53 int default_profiling_interval;
54
55 int profiling_active;
56
57 /* The normal flag in_display is used as a critical-section flag
58 and is not set the whole time we're in redisplay. */
59 int profiling_redisplay_flag;
60
61 Lisp_Object QSin_redisplay;
62 Lisp_Object QSin_garbage_collection;
63 Lisp_Object QSprocessing_events_at_top_level;
64 Lisp_Object QSunknown;
65
66 static SIGTYPE
67 sigprof_handler (int signo)
68 {
69 Lisp_Object fun;
70
71 if (profiling_redisplay_flag)
72 fun = QSin_redisplay;
73 else if (gc_in_progress)
74 fun = QSin_garbage_collection;
75 else if (backtrace_list)
76 {
77 fun = *backtrace_list->function;
78
79 XUNMARK (fun);
80 if (!GC_SYMBOLP (fun) && !GC_COMPILED_FUNCTIONP (fun))
81 fun = QSunknown;
82 }
83 else
84 fun = QSprocessing_events_at_top_level;
85
86 {
87 long count;
88 CONST void *vval;
89
90 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval))
91 count = (long) vval;
92 else
93 count = 0;
94 count++;
95 vval = (CONST void *) count;
96 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table);
97 }
98 }
99
100 DEFUN ("start-profiling", Fstart_profiling, Sstart_profiling, 0, 1, 0 /*
101 Start profiling, with profile queries every MICROSECS.
102 If MICROSECS is nil or omitted, the value of `default-profiling-interval'
103 is used.
104
105 You can retrieve the recorded profiling info using `get-profiling-info'.
106
107 Starting and stopping profiling does not clear the currently recorded
108 info. Thus you can start and stop as many times as you want and everything
109 will be properly accumulated.
110 */ )
111 (microsecs)
112 Lisp_Object microsecs;
113 {
114 int msecs;
115 struct itimerval foo;
116
117 /* #### The hash code can safely be called from a signal handler
118 except when it has to grow the hashtable. In this case, it calls
119 realloc(), which is not (in general) re-entrant. We just be
120 sleazy and make the table large enough that it (hopefully) won't
121 need to be realloc()ed. */
122 if (!big_profile_table)
123 big_profile_table = make_hashtable (10000);
124 if (NILP (microsecs))
125 msecs = default_profiling_interval;
126 else
127 {
128 CHECK_NATNUM (microsecs);
129 msecs = XINT (microsecs);
130 }
131 if (msecs <= 0)
132 msecs = 1000;
133
134 signal (SIGPROF, sigprof_handler);
135 foo.it_value.tv_sec = 0;
136 foo.it_value.tv_usec = msecs;
137 EMACS_NORMALIZE_TIME (foo.it_value);
138 foo.it_interval = foo.it_value;
139 profiling_active = 1;
140 setitimer (ITIMER_PROF, &foo, 0);
141 return Qnil;
142 }
143
144 DEFUN ("stop-profiling", Fstop_profiling, Sstop_profiling, 0, 0, 0 /*
145 Stop profiling.
146 */ )
147 ()
148 {
149 struct itimerval foo;
150
151 foo.it_value.tv_sec = 0;
152 foo.it_value.tv_usec = 0;
153 foo.it_interval = foo.it_value;
154 setitimer (ITIMER_PROF, &foo, 0);
155 profiling_active = 0;
156 signal (SIGPROF, fatal_error_signal);
157 return Qnil;
158 }
159
160 struct get_profiling_info_closure
161 {
162 Lisp_Object accum;
163 };
164
165 static void
166 get_profiling_info_maphash (CONST void *void_key,
167 void *void_val,
168 void *void_closure)
169 {
170 /* This function can GC */
171 Lisp_Object key;
172 struct get_profiling_info_closure *closure = void_closure;
173 EMACS_INT val;
174
175 CVOID_TO_LISP (key, void_key);
176 val = (EMACS_INT) void_val;
177
178 closure->accum = Fcons (Fcons (key, make_int (val)),
179 closure->accum);
180 }
181
182 DEFUN ("get-profiling-info", Fget_profiling_info, Sget_profiling_info,
183 0, 0, 0 /*
184 Return the profiling info as an alist.
185 */ )
186 ()
187 {
188 struct get_profiling_info_closure closure;
189
190 closure.accum = Qnil;
191 if (big_profile_table)
192 maphash (get_profiling_info_maphash, big_profile_table, &closure);
193 return closure.accum;
194 }
195
196 struct mark_profiling_info_closure
197 {
198 void (*markfun) (Lisp_Object);
199 };
200
201 static void
202 mark_profiling_info_maphash (CONST void *void_key,
203 void *void_val,
204 void *void_closure)
205 {
206 /* This function can GC */
207 Lisp_Object key;
208 struct mark_profiling_info_closure *closure = void_closure;
209
210 CVOID_TO_LISP (key, void_key);
211 (closure->markfun) (key);
212 }
213
214 void
215 mark_profiling_info (void (*markfun) (Lisp_Object))
216 {
217 struct mark_profiling_info_closure closure;
218
219 closure.markfun = markfun;
220 if (big_profile_table)
221 maphash (mark_profiling_info_maphash, big_profile_table, &closure);
222 }
223
224 DEFUN ("clear-profiling-info", Fclear_profiling_info, Sclear_profiling_info,
225 0, 0, 0 /*
226 Clear out the recorded profiling info.
227 */ )
228 ()
229 {
230 if (big_profile_table)
231 clrhash (big_profile_table);
232 return Qnil;
233 }
234
235 DEFUN ("profiling-active-p", Fprofiling_active_p, Sprofiling_active_p,
236 0, 0, 0 /*
237 Return non-nil if profiling information is currently being recorded.
238 */ )
239 ()
240 {
241 return profiling_active ? Qt : Qnil;
242 }
243
244 void
245 syms_of_profile (void)
246 {
247 defsubr (&Sstart_profiling);
248 defsubr (&Sstop_profiling);
249 defsubr (&Sget_profiling_info);
250 defsubr (&Sclear_profiling_info);
251 defsubr (&Sprofiling_active_p);
252 }
253
254 void
255 vars_of_profile (void)
256 {
257 DEFVAR_INT ("default-profiling-interval", &default_profiling_interval /*
258 Default time in microseconds between profiling queries.
259 Used when the argument to `start-profiling' is nil or omitted.
260 Note that the time in question is CPU time (when the program is executing
261 or the kernel is executing on behalf of the program) and not real time.
262 */ );
263 default_profiling_interval = 1000;
264
265 QSin_redisplay = build_string ("(in redisplay)");
266 staticpro (&QSin_redisplay);
267 QSin_garbage_collection = build_string ("(in garbage collection)");
268 staticpro (&QSin_garbage_collection);
269 QSunknown = build_string ("(unknown)");
270 staticpro (&QSunknown);
271 QSprocessing_events_at_top_level =
272 build_string ("(processing events at top level)");
273 staticpro (&QSprocessing_events_at_top_level);
274 }