1 /* Why the hell is SXEmacs so fucking slow?
2 Copyright (C) 1996 Ben Wing.
3 Copyright (C) 1998 Free Software Foundation, Inc.
5 This file is part of SXEmacs
7 SXEmacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 SXEmacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
24 #include "backtrace.h"
29 #include "syssignal.h"
32 #ifndef HAVE_SETITIMER
33 #error Sorry charlie. We need a scalpel and all we have is a lawnmower.
36 /* We implement our own profiling scheme so that we can determine
37 things like which Lisp functions are occupying the most time. Any
38 standard OS-provided profiling works on C functions, which is
41 The basic idea is simple. We set a profiling timer using setitimer
42 (ITIMER_PROF), which generates a SIGPROF every so often. (This
43 runs not in real time but rather when the process is executing or
44 the system is running on behalf of the process.) When the signal
45 goes off, we see what we're in, and add 1 to the count associated
48 It would be nice to use the Lisp allocation mechanism etc. to keep
49 track of the profiling information, but we can't because that's not
50 safe, and trying to make it safe would be much more work than it's
53 Jan 1998: In addition to this, I have added code to remember call
54 counts of Lisp funcalls. The profile_increase_call_count()
55 function is called from Ffuncall(), and serves to add data to
56 Vcall_count_profile_table. This mechanism is much simpler and
57 independent of the SIGPROF-driven one. It uses the Lisp allocation
58 mechanism normally, since it is not called from a handler. It may
59 even be useful to provide a way to turn on only one profiling
60 mechanism, but I haven't done so yet. --hniksic */
62 static struct hash_table *big_profile_table;
63 Lisp_Object Vcall_count_profile_table;
65 Fixnum default_profiling_interval;
69 /* The normal flag in_display is used as a critical-section flag
70 and is not set the whole time we're in redisplay. */
71 int profiling_redisplay_flag;
73 static Lisp_Object QSin_redisplay;
74 static Lisp_Object QSin_garbage_collection;
75 static Lisp_Object QSprocessing_events_at_top_level;
76 static Lisp_Object QSunknown;
78 /* We use inside_profiling to prevent the handler from writing to
79 the table while another routine is operating on it. We also set
80 inside_profiling in case the timeout between signal calls is short
81 enough to catch us while we're already in there. */
82 static volatile int inside_profiling;
84 /* Increase the value of OBJ in Vcall_count_profile_table hash table.
85 If the hash table is nil, create it first. */
86 void profile_increase_call_count(Lisp_Object obj)
90 if (NILP(Vcall_count_profile_table))
91 Vcall_count_profile_table =
92 make_lisp_hash_table(100, HASH_TABLE_NON_WEAK,
95 count = Fgethash(obj, Vcall_count_profile_table, Qzero);
98 Fputhash(obj, make_int(1 + XINT(count)), Vcall_count_profile_table);
101 static SIGTYPE sigprof_handler(int signo)
103 /* Don't do anything if we are shutting down, or are doing a maphash
104 or clrhash on the table. */
105 if (!inside_profiling && !preparing_for_armageddon) {
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
112 inside_profiling = 1;
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 fun = *backtrace_list->function;
122 && !COMPILED_FUNCTIONP(fun)
127 fun = QSprocessing_events_at_top_level;
130 /* #### see comment about memory allocation in
131 #### 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
134 might lose because of this. Even worse, if the
135 memory allocation fails, the `error' generated whacks
140 if (gethash(LISP_TO_VOID(fun), big_profile_table,
147 vval = (void *)count;
148 puthash(LISP_TO_VOID(fun), vval, big_profile_table);
151 inside_profiling = 0;
155 DEFUN("start-profiling", Fstart_profiling, 0, 1, 0, /*
156 Start profiling, with profile queries every MICROSECS.
157 If MICROSECS is nil or omitted, the value of `default-profiling-interval'
160 You can retrieve the recorded profiling info using `get-profiling-info'.
162 Starting and stopping profiling does not clear the currently recorded
163 info. Thus you can start and stop as many times as you want and everything
164 will be properly accumulated.
168 /* This function can GC */
170 struct itimerval foo;
172 /* #### The hash code can safely be called from a signal handler
173 except when it has to grow the hash table. In this case, it calls
174 realloc(), which is not (in general) re-entrant. We'll just be
175 sleazy and make the table large enough that it (hopefully) won't
176 need to be realloc()ed. */
177 if (!big_profile_table)
178 big_profile_table = make_hash_table(10000);
181 msecs = default_profiling_interval;
183 CHECK_NATNUM(microsecs);
184 msecs = XINT(microsecs);
189 signal(SIGPROF, sigprof_handler);
190 foo.it_value.tv_sec = 0;
191 foo.it_value.tv_usec = msecs;
192 EMACS_NORMALIZE_TIME(foo.it_value);
193 foo.it_interval = foo.it_value;
194 profiling_active = 1;
195 inside_profiling = 0;
196 qxe_setitimer(ITIMER_PROF, &foo, 0);
200 DEFUN("stop-profiling", Fstop_profiling, 0, 0, 0, /*
205 /* This function does not GC */
206 struct itimerval foo;
208 foo.it_value.tv_sec = 0;
209 foo.it_value.tv_usec = 0;
210 foo.it_interval = foo.it_value;
211 qxe_setitimer(ITIMER_PROF, &foo, 0);
212 profiling_active = 0;
213 signal(SIGPROF, fatal_error_signal);
217 static Lisp_Object profile_lock_unwind(Lisp_Object ignore)
219 inside_profiling = 0;
223 struct get_profiling_info_closure {
228 get_profiling_info_maphash(const void *void_key,
229 void *void_val, void *void_closure)
231 /* This function does not GC */
233 struct get_profiling_info_closure *closure
234 = (struct get_profiling_info_closure *)void_closure;
237 CVOID_TO_LISP(key, void_key);
238 val = (EMACS_INT) void_val;
240 closure->accum = Fcons(Fcons(key, make_int(val)), closure->accum);
244 DEFUN("get-profiling-info", Fget_profiling_info, 0, 0, 0, /*
245 Return the profiling info as an alist.
249 /* This function does not GC */
250 struct get_profiling_info_closure closure;
252 closure.accum = Qnil;
253 if (big_profile_table) {
254 int count = specpdl_depth();
255 record_unwind_protect(profile_lock_unwind, Qnil);
256 inside_profiling = 1;
257 maphash(get_profiling_info_maphash, big_profile_table,
259 unbind_to(count, Qnil);
261 return closure.accum;
265 mark_profiling_info_maphash(const void *void_key,
266 void *void_val, void *void_closure)
270 CVOID_TO_LISP(key, void_key);
275 void mark_profiling_info(void)
277 /* This function does not GC */
278 if (big_profile_table) {
279 inside_profiling = 1;
280 maphash(mark_profiling_info_maphash, big_profile_table, 0);
281 inside_profiling = 0;
285 DEFUN("clear-profiling-info", Fclear_profiling_info, 0, 0, "", /*
286 Clear out the recorded profiling info.
290 /* This function does not GC */
291 if (big_profile_table) {
292 inside_profiling = 1;
293 clrhash(big_profile_table);
294 inside_profiling = 0;
296 if (!NILP(Vcall_count_profile_table))
297 Fclrhash(Vcall_count_profile_table);
301 DEFUN("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /*
302 Return non-nil if profiling information is currently being recorded.
306 return profiling_active ? Qt : Qnil;
309 void syms_of_profile(void)
311 DEFSUBR(Fstart_profiling);
312 DEFSUBR(Fstop_profiling);
313 DEFSUBR(Fget_profiling_info);
314 DEFSUBR(Fclear_profiling_info);
315 DEFSUBR(Fprofiling_active_p);
318 void vars_of_profile(void)
320 DEFVAR_INT("default-profiling-interval", &default_profiling_interval /*
321 Default CPU time in microseconds between profiling sampling.
322 Used when the argument to `start-profiling' is nil or omitted.
323 Note that the time in question is CPU time (when the program is executing
324 or the kernel is executing on behalf of the program) and not real time.
326 default_profiling_interval = 1000;
328 DEFVAR_LISP("call-count-profile-table", &Vcall_count_profile_table /*
329 The table where call-count information is stored by the profiling primitives.
330 This is a hash table whose keys are funcallable objects, and whose
331 values are their call counts (integers).
333 Vcall_count_profile_table = Qnil;
335 inside_profiling = 0;
337 QSin_redisplay = build_string("(in redisplay)");
338 staticpro(&QSin_redisplay);
339 QSin_garbage_collection = build_string("(in garbage collection)");
340 staticpro(&QSin_garbage_collection);
341 QSunknown = build_string("(unknown)");
342 staticpro(&QSunknown);
343 QSprocessing_events_at_top_level =
344 build_string("(processing events at top level)");
345 staticpro(&QSprocessing_events_at_top_level);