Mercurial > hg > xemacs-beta

comparison src/profile.c @ 428:3ecd8885ac67 r21-2-22

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-22
author cvs
date Mon, 13 Aug 2007 11:28:15 +0200
parents
children 9d177e8d4150
comparison
equal deleted inserted replaced
427:0a0253eac470 428:3ecd8885ac67
1 /* Why the hell is XEmacs so fucking slow?
2 Copyright (C) 1996 Ben Wing.
3 Copyright (C) 1998 Free Software Foundation, Inc.
4
5 This file is part of XEmacs.
6
7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the
9 Free Software Foundation; either version 2, or (at your option) any
10 later version.
11
12 XEmacs is distributed in the hope that it will be useful, but WITHOUT
13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
15 for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with XEmacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
21
22 #include <config.h>
23 #include "lisp.h"
24
25 #include "backtrace.h"
26 #include "bytecode.h"
27 #include "elhash.h"
28 #include "hash.h"
29
30 #include "syssignal.h"
31 #include "systime.h"
32
33 /* We implement our own profiling scheme so that we can determine
34 things like which Lisp functions are occupying the most time. Any
35 standard OS-provided profiling works on C functions, which is
36 somewhat useless.
37
38 The basic idea is simple. We set a profiling timer using setitimer
39 (ITIMER_PROF), which generates a SIGPROF every so often. (This
40 runs not in real time but rather when the process is executing or
41 the system is running on behalf of the process.) When the signal
42 goes off, we see what we're in, and add 1 to the count associated
43 with that function.
44
45 It would be nice to use the Lisp allocation mechanism etc. to keep
46 track of the profiling information, but we can't because that's not
47 safe, and trying to make it safe would be much more work than it's
48 worth.
49
50
51 Jan 1998: In addition to this, I have added code to remember call
52 counts of Lisp funcalls. The profile_increase_call_count()
53 function is called from Ffuncall(), and serves to add data to
54 Vcall_count_profile_table. This mechanism is much simpler and
55 independent of the SIGPROF-driven one. It uses the Lisp allocation
56 mechanism normally, since it is not called from a handler. It may
57 even be useful to provide a way to turn on only one profiling
58 mechanism, but I haven't done so yet. --hniksic */
59
60 static struct hash_table *big_profile_table;
61 Lisp_Object Vcall_count_profile_table;
62
63 int default_profiling_interval;
64
65 int profiling_active;
66
67 /* The normal flag in_display is used as a critical-section flag
68 and is not set the whole time we're in redisplay. */
69 int profiling_redisplay_flag;
70
71 static Lisp_Object QSin_redisplay;
72 static Lisp_Object QSin_garbage_collection;
73 static Lisp_Object QSprocessing_events_at_top_level;
74 static Lisp_Object QSunknown;
75
76 /* We use inside_profiling to prevent the handler from writing to
77 the table while another routine is operating on it. We also set
78 inside_profiling in case the timeout between signal calls is short
79 enough to catch us while we're already in there. */
80 static volatile int inside_profiling;
81
82 /* Increase the value of OBJ in Vcall_count_profile_table hash table.
83 If the hash table is nil, create it first. */
84 void
85 profile_increase_call_count (Lisp_Object obj)
86 {
87 Lisp_Object count;
88
89 if (NILP (Vcall_count_profile_table))
90 Vcall_count_profile_table =
91 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
92
93 count = Fgethash (obj, Vcall_count_profile_table, Qzero);
94 if (!INTP (count))
95 count = Qzero;
96 Fputhash (obj, make_int (1 + XINT (count)), Vcall_count_profile_table);
97 }
98
99 static SIGTYPE
100 sigprof_handler (int signo)
101 {
102 /* Don't do anything if we are shutting down, or are doing a maphash
103 or clrhash on the table. */
104 if (!inside_profiling && !preparing_for_armageddon)
105 {
106 Lisp_Object fun;
107
108 /* If something below causes an error to be signaled, we'll
109 not correctly reset this flag. But we'll be in worse shape
110 than that anyways, since we'll longjmp back to the last
111 condition case. */
112 inside_profiling = 1;
113
114 if (profiling_redisplay_flag)
115 fun = QSin_redisplay;
116 else if (gc_in_progress)
117 fun = QSin_garbage_collection;
118 else if (backtrace_list)
119 {
120 fun = *backtrace_list->function;
121
122 if (!SYMBOLP (fun) &&
123 !COMPILED_FUNCTIONP (fun) &&
124 !SUBRP (fun))
125 fun = QSunknown;
126 }
127 else
128 fun = QSprocessing_events_at_top_level;
129
130 {
131 /* #### see comment about memory allocation in start-profiling.
132 Allocating memory in a signal handler is BAD BAD BAD.
133 If you are using the non-mmap rel-alloc code, you might
134 lose because of this. Even worse, if the memory allocation
135 fails, the `error' generated whacks everything hard. */
136 long count;
137 CONST void *vval;
138
139 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval))
140 count = (long) vval;
141 else
142 count = 0;
143 count++;
144 vval = (CONST void *) count;
145 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table);
146 }
147
148 inside_profiling = 0;
149 }
150 }
151
152 DEFUN ("start-profiling", Fstart_profiling, 0, 1, 0, /*
153 Start profiling, with profile queries every MICROSECS.
154 If MICROSECS is nil or omitted, the value of `default-profiling-interval'
155 is used.
156
157 You can retrieve the recorded profiling info using `get-profiling-info'.
158
159 Starting and stopping profiling does not clear the currently recorded
160 info. Thus you can start and stop as many times as you want and everything
161 will be properly accumulated.
162 */
163 (microsecs))
164 {
165 /* This function can GC */
166 int msecs;
167 struct itimerval foo;
168
169 /* #### The hash code can safely be called from a signal handler
170 except when it has to grow the hash table. In this case, it calls
171 realloc(), which is not (in general) re-entrant. We'll just be
172 sleazy and make the table large enough that it (hopefully) won't
173 need to be realloc()ed. */
174 if (!big_profile_table)
175 big_profile_table = make_hash_table (10000);
176
177 if (NILP (microsecs))
178 msecs = default_profiling_interval;
179 else
180 {
181 CHECK_NATNUM (microsecs);
182 msecs = XINT (microsecs);
183 }
184 if (msecs <= 0)
185 msecs = 1000;
186
187 signal (SIGPROF, sigprof_handler);
188 foo.it_value.tv_sec = 0;
189 foo.it_value.tv_usec = msecs;
190 EMACS_NORMALIZE_TIME (foo.it_value);
191 foo.it_interval = foo.it_value;
192 profiling_active = 1;
193 inside_profiling = 0;
194 setitimer (ITIMER_PROF, &foo, 0);
195 return Qnil;
196 }
197
198 DEFUN ("stop-profiling", Fstop_profiling, 0, 0, 0, /*
199 Stop profiling.
200 */
201 ())
202 {
203 /* This function does not GC */
204 struct itimerval foo;
205
206 foo.it_value.tv_sec = 0;
207 foo.it_value.tv_usec = 0;
208 foo.it_interval = foo.it_value;
209 setitimer (ITIMER_PROF, &foo, 0);
210 profiling_active = 0;
211 signal (SIGPROF, fatal_error_signal);
212 return Qnil;
213 }
214
215 static Lisp_Object
216 profile_lock_unwind (Lisp_Object ignore)
217 {
218 inside_profiling = 0;
219 return Qnil;
220 }
221
222 struct get_profiling_info_closure
223 {
224 Lisp_Object accum;
225 };
226
227 static int
228 get_profiling_info_maphash (CONST void *void_key,
229 void *void_val,
230 void *void_closure)
231 {
232 /* This function does not GC */
233 Lisp_Object key;
234 struct get_profiling_info_closure *closure
235 = (struct get_profiling_info_closure *) void_closure;
236 EMACS_INT val;
237
238 CVOID_TO_LISP (key, void_key);
239 val = (EMACS_INT) void_val;
240
241 closure->accum = Fcons (Fcons (key, make_int (val)), closure->accum);
242 return 0;
243 }
244
245 DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /*
246 Return the profiling info as an alist.
247 */
248 ())
249 {
250 /* This function does not GC */
251 struct get_profiling_info_closure closure;
252
253 closure.accum = Qnil;
254 if (big_profile_table)
255 {
256 int count = specpdl_depth ();
257 record_unwind_protect (profile_lock_unwind, Qnil);
258 inside_profiling = 1;
259 maphash (get_profiling_info_maphash, big_profile_table, &closure);
260 unbind_to (count, Qnil);
261 }
262 return closure.accum;
263 }
264
265 static int
266 mark_profiling_info_maphash (CONST void *void_key,
267 void *void_val,
268 void *void_closure)
269 {
270 Lisp_Object key;
271
272 CVOID_TO_LISP (key, void_key);
273 mark_object (key);
274 return 0;
275 }
276
277 void
278 mark_profiling_info (void)
279 {
280 /* This function does not GC */
281 if (big_profile_table)
282 {
283 inside_profiling = 1;
284 maphash (mark_profiling_info_maphash, big_profile_table, 0);
285 inside_profiling = 0;
286 }
287 }
288
289 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, "", /*
290 Clear out the recorded profiling info.
291 */
292 ())
293 {
294 /* This function does not GC */
295 if (big_profile_table)
296 {
297 inside_profiling = 1;
298 clrhash (big_profile_table);
299 inside_profiling = 0;
300 }
301 if (!NILP (Vcall_count_profile_table))
302 Fclrhash (Vcall_count_profile_table);
303 return Qnil;
304 }
305
306 DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /*
307 Return non-nil if profiling information is currently being recorded.
308 */
309 ())
310 {
311 return profiling_active ? Qt : Qnil;
312 }
313
314 void
315 syms_of_profile (void)
316 {
317 DEFSUBR (Fstart_profiling);
318 DEFSUBR (Fstop_profiling);
319 DEFSUBR (Fget_profiling_info);
320 DEFSUBR (Fclear_profiling_info);
321 DEFSUBR (Fprofiling_active_p);
322 }
323
324 void
325 vars_of_profile (void)
326 {
327 DEFVAR_INT ("default-profiling-interval", &default_profiling_interval /*
328 Default CPU time in microseconds between profiling sampling.
329 Used when the argument to `start-profiling' is nil or omitted.
330 Note that the time in question is CPU time (when the program is executing
331 or the kernel is executing on behalf of the program) and not real time.
332 */ );
333 default_profiling_interval = 1000;
334
335 DEFVAR_LISP ("call-count-profile-table", &Vcall_count_profile_table /*
336 The table where call-count information is stored by the profiling primitives.
337 This is a hash table whose keys are funcallable objects, and whose
338 values are their call counts (integers).
339 */ );
340 Vcall_count_profile_table = Qnil;
341
342 inside_profiling = 0;
343
344 QSin_redisplay = build_string ("(in redisplay)");
345 staticpro (&QSin_redisplay);
346 QSin_garbage_collection = build_string ("(in garbage collection)");
347 staticpro (&QSin_garbage_collection);
348 QSunknown = build_string ("(unknown)");
349 staticpro (&QSunknown);
350 QSprocessing_events_at_top_level =
351 build_string ("(processing events at top level)");
352 staticpro (&QSprocessing_events_at_top_level);
353 }