1 /* Why the hell is XEmacs so fucking slow?
2 Copyright (C) 1996 Ben Wing.
3 Copyright (C) 1998 Free Software Foundation, Inc.
5 This file is part of XEmacs.
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
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
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. */
25 #include "backtrace.h"
30 #include "syssignal.h"
33 #ifndef HAVE_SETITIMER
34 #error Sorry charlie. We need a scalpel and all we have is a lawnmower.
37 /* We implement our own profiling scheme so that we can determine
38 things like which Lisp functions are occupying the most time. Any
39 standard OS-provided profiling works on C functions, which is
42 The basic idea is simple. We set a profiling timer using setitimer
43 (ITIMER_PROF), which generates a SIGPROF every so often. (This
44 runs not in real time but rather when the process is executing or
45 the system is running on behalf of the process.) When the signal
46 goes off, we see what we're in, and add 1 to the count associated
49 It would be nice to use the Lisp allocation mechanism etc. to keep
50 track of the profiling information, but we can't because that's not
51 safe, and trying to make it safe would be much more work than it's
55 Jan 1998: In addition to this, I have added code to remember call
56 counts of Lisp funcalls. The profile_increase_call_count()
57 function is called from Ffuncall(), and serves to add data to
58 Vcall_count_profile_table. This mechanism is much simpler and
59 independent of the SIGPROF-driven one. It uses the Lisp allocation
60 mechanism normally, since it is not called from a handler. It may
61 even be useful to provide a way to turn on only one profiling
62 mechanism, but I haven't done so yet. --hniksic */
64 static struct hash_table *big_profile_table;
65 Lisp_Object Vcall_count_profile_table;
67 Fixnum default_profiling_interval;
71 /* The normal flag in_display is used as a critical-section flag
72 and is not set the whole time we're in redisplay. */
73 int profiling_redisplay_flag;
75 static Lisp_Object QSin_redisplay;
76 static Lisp_Object QSin_garbage_collection;
77 static Lisp_Object QSprocessing_events_at_top_level;
78 static Lisp_Object QSunknown;
80 /* We use inside_profiling to prevent the handler from writing to
81 the table while another routine is operating on it. We also set
82 inside_profiling in case the timeout between signal calls is short
83 enough to catch us while we're already in there. */
84 static volatile int inside_profiling;
86 /* Increase the value of OBJ in Vcall_count_profile_table hash table.
87 If the hash table is nil, create it first. */
89 profile_increase_call_count (Lisp_Object obj)
93 if (NILP (Vcall_count_profile_table))
94 Vcall_count_profile_table =
95 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
97 count = Fgethash (obj, Vcall_count_profile_table, Qzero);
100 Fputhash (obj, make_int (1 + XINT (count)), Vcall_count_profile_table);
104 sigprof_handler (int signo)
106 /* Don't do anything if we are shutting down, or are doing a maphash
107 or clrhash on the table. */
108 if (!inside_profiling && !preparing_for_armageddon)
112 /* If something below causes an error to be signaled, we'll
113 not correctly reset this flag. But we'll be in worse shape
114 than that anyways, since we'll longjmp back to the last
116 inside_profiling = 1;
118 if (profiling_redisplay_flag)
119 fun = QSin_redisplay;
120 else if (gc_in_progress)
121 fun = QSin_garbage_collection;
122 else if (backtrace_list)
124 fun = *backtrace_list->function;
127 && !COMPILED_FUNCTIONP (fun)
133 fun = QSprocessing_events_at_top_level;
136 /* #### see comment about memory allocation in start-profiling.
137 Allocating memory in a signal handler is BAD BAD BAD.
138 If you are using the non-mmap rel-alloc code, you might
139 lose because of this. Even worse, if the memory allocation
140 fails, the `error' generated whacks everything hard. */
144 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval))
149 vval = (const void *) count;
150 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table);
153 inside_profiling = 0;
157 DEFUN ("start-profiling", Fstart_profiling, 0, 1, 0, /*
158 Start profiling, with profile queries every MICROSECS.
159 If MICROSECS is nil or omitted, the value of `default-profiling-interval'
162 You can retrieve the recorded profiling info using `get-profiling-info'.
164 Starting and stopping profiling does not clear the currently recorded
165 info. Thus you can start and stop as many times as you want and everything
166 will be properly accumulated.
170 /* This function can GC */
172 struct itimerval foo;
174 /* #### The hash code can safely be called from a signal handler
175 except when it has to grow the hash table. In this case, it calls
176 realloc(), which is not (in general) re-entrant. We'll just be
177 sleazy and make the table large enough that it (hopefully) won't
178 need to be realloc()ed. */
179 if (!big_profile_table)
180 big_profile_table = make_hash_table (10000);
182 if (NILP (microsecs))
183 msecs = default_profiling_interval;
186 CHECK_NATNUM (microsecs);
187 msecs = XINT (microsecs);
192 signal (SIGPROF, sigprof_handler);
193 foo.it_value.tv_sec = 0;
194 foo.it_value.tv_usec = msecs;
195 EMACS_NORMALIZE_TIME (foo.it_value);
196 foo.it_interval = foo.it_value;
197 profiling_active = 1;
198 inside_profiling = 0;
199 qxe_setitimer (ITIMER_PROF, &foo, 0);
203 DEFUN ("stop-profiling", Fstop_profiling, 0, 0, 0, /*
208 /* This function does not GC */
209 struct itimerval foo;
211 foo.it_value.tv_sec = 0;
212 foo.it_value.tv_usec = 0;
213 foo.it_interval = foo.it_value;
214 qxe_setitimer (ITIMER_PROF, &foo, 0);
215 profiling_active = 0;
216 signal (SIGPROF, fatal_error_signal);
221 profile_lock_unwind (Lisp_Object ignore)
223 inside_profiling = 0;
227 struct get_profiling_info_closure
233 get_profiling_info_maphash (const void *void_key,
237 /* This function does not GC */
239 struct get_profiling_info_closure *closure
240 = (struct get_profiling_info_closure *) void_closure;
243 CVOID_TO_LISP (key, void_key);
244 val = (EMACS_INT) void_val;
246 closure->accum = Fcons (Fcons (key, make_int (val)), closure->accum);
250 DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /*
251 Return the profiling info as an alist.
255 /* This function does not GC */
256 struct get_profiling_info_closure closure;
258 closure.accum = Qnil;
259 if (big_profile_table)
261 int count = specpdl_depth ();
262 record_unwind_protect (profile_lock_unwind, Qnil);
263 inside_profiling = 1;
264 maphash (get_profiling_info_maphash, big_profile_table, &closure);
265 unbind_to (count, Qnil);
267 return closure.accum;
271 mark_profiling_info_maphash (const void *void_key,
277 CVOID_TO_LISP (key, void_key);
283 mark_profiling_info (void)
285 /* This function does not GC */
286 if (big_profile_table)
288 inside_profiling = 1;
289 maphash (mark_profiling_info_maphash, big_profile_table, 0);
290 inside_profiling = 0;
294 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, "", /*
295 Clear out the recorded profiling info.
299 /* This function does not GC */
300 if (big_profile_table)
302 inside_profiling = 1;
303 clrhash (big_profile_table);
304 inside_profiling = 0;
306 if (!NILP (Vcall_count_profile_table))
307 Fclrhash (Vcall_count_profile_table);
311 DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /*
312 Return non-nil if profiling information is currently being recorded.
316 return profiling_active ? Qt : Qnil;
320 syms_of_profile (void)
322 DEFSUBR (Fstart_profiling);
323 DEFSUBR (Fstop_profiling);
324 DEFSUBR (Fget_profiling_info);
325 DEFSUBR (Fclear_profiling_info);
326 DEFSUBR (Fprofiling_active_p);
330 vars_of_profile (void)
332 DEFVAR_INT ("default-profiling-interval", &default_profiling_interval /*
333 Default CPU time in microseconds between profiling sampling.
334 Used when the argument to `start-profiling' is nil or omitted.
335 Note that the time in question is CPU time (when the program is executing
336 or the kernel is executing on behalf of the program) and not real time.
338 default_profiling_interval = 1000;
340 DEFVAR_LISP ("call-count-profile-table", &Vcall_count_profile_table /*
341 The table where call-count information is stored by the profiling primitives.
342 This is a hash table whose keys are funcallable objects, and whose
343 values are their call counts (integers).
345 Vcall_count_profile_table = Qnil;
347 inside_profiling = 0;
349 QSin_redisplay = build_string ("(in redisplay)");
350 staticpro (&QSin_redisplay);
351 QSin_garbage_collection = build_string ("(in garbage collection)");
352 staticpro (&QSin_garbage_collection);
353 QSunknown = build_string ("(unknown)");
354 staticpro (&QSunknown);
355 QSprocessing_events_at_top_level =
356 build_string ("(processing events at top level)");
357 staticpro (&QSprocessing_events_at_top_level);