Mercurial > hg > xemacs-beta

comparison src/profile.c @ 1292:f3437b56874d

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2003-02-13 09:57:04 by ben] profile updates profile.c: Major reworking. Keep track of new information -- total function timing (includes descendants), GC usage, total GC usage (includes descendants). New functions to be called appropriately from eval.c, alloc.c to keep track of this information. Keep track of when we're actually in a function vs. in its profile, for more accurate timing counts. Track profile overhead separately. Create new mechanism for specifying "internal sections" that are tracked just like regular Lisp functions and even appear in the backtrace if `backtrace-with-internal-sections' is non-nil (t by default for error-checking builds). Add some KKCC information for the straight (non-Elisp) hash table used by profile, which contains Lisp objects in its keys -- but not used yet. Remove old ad-hoc methods for tracking garbage collection, redisplay (which was incorrect anyway when Lisp was called within these sections). Don't record any tick info when blocking under MS Windows, since the timer there is in real time rather than in process time. Make `start-profiling', `stop-profiling' interactive. Be consistent wrt. recursive functions and functions currently on the stack when starting or stopping -- together these make implementing the `total' values extremely difficult. When we start profiling, we act as if we just entered all the functions currently on the stack. Likewise when exiting. Create vars in_profile for tracking time spent inside of profiling, and profiling_lock for setting exclusive access to the main hash table when reading from it or modifying it. (protects against getting screwed up by the signal handle going off at the same time. profile.h: New file. Create macros for declaring internal profiling sections. lisp.h: Move profile-related stuff to profile.h. alloc.c: Keep track of total consing, for profile. Tell profile when we are consing. Use new profile-section method for noting garbage-collection. alloc.c: Abort if we attempt to call the allocator reentrantly. backtrace.h, eval.c: Add info for use by profile in the backtrace frame and transfer PUSH_BACKTRACE/POP_BACKTRACE from eval.c, for use with profile. elhash.c: Author comment. eval.c, lisp.h: New Lisp var `backtrace-with-internal-sections'. Set to t when error-checking is on. eval.c: When unwinding, eval.c: Report to profile when we are about-to-call and just-called wrt. a function. alloc.c, eval.c: Allow for "fake" backtrace frames, for internal sections (used by profile and `backtrace-with-internal-sections'. event-Xt.c, event-gtk.c, event-msw.c, event-tty.c: Record when we are actually blocking on an event, for profile's sake. event-stream.c: Record internal profiling sections for getting, dispatching events. extents.c: Record internal profiling sections for map_extents. hash.c, hash.h: Add pregrow_hash_table_if_necessary(). (Used in profile code since the signal handler is the main grower but can't allow a realloc(). We make sure, at critical points, that the table is large enough.) lread.c: Create internal profiling sections for `load' (which may be triggered internally by autoload, etc.). redisplay.c: Remove old profile_redisplay_flag. Use new macros to declare internal profiling section for redisplay. text.c: Use new macros to declare internal profiling sections for char-byte conversion and internal-external conversion. SEMI-UNRELATED CHANGES: ----------------------- text.c: Update the long comments.
author ben
date Thu, 13 Feb 2003 09:57:08 +0000
parents 37bdd24225ef
children 70921960b980
comparison
equal deleted inserted replaced
1291:3d99b5e6c6ec 1292:f3437b56874d
1 /* Why the hell is XEmacs so fucking slow? 1 /* Why the hell is XEmacs so fucking slow?
2 Copyright (C) 1996, 2002 Ben Wing. 2 Copyright (C) 1996, 2002, 2003 Ben Wing.
3 Copyright (C) 1998 Free Software Foundation, Inc. 3 Copyright (C) 1998 Free Software Foundation, Inc.
4 4
5 This file is part of XEmacs. 5 This file is part of XEmacs.
6 6
7 XEmacs is free software; you can redistribute it and/or modify it 7 XEmacs is free software; you can redistribute it and/or modify it
32 32
33 #ifndef HAVE_SETITIMER 33 #ifndef HAVE_SETITIMER
34 #error Sorry charlie. We need a scalpel and all we have is a lawnmower. 34 #error Sorry charlie. We need a scalpel and all we have is a lawnmower.
35 #endif 35 #endif
36 36
37 /* We implement our own profiling scheme so that we can determine 37 #ifdef WIN32_ANY
38 int mswindows_is_blocking;
39 #endif
40
41 /* Written by Ben Wing.
42
43 We implement our own profiling scheme so that we can determine
38 things like which Lisp functions are occupying the most time. Any 44 things like which Lisp functions are occupying the most time. Any
39 standard OS-provided profiling works on C functions, which is 45 standard OS-provided profiling works on C functions, which is
40 somewhat useless. 46 not always that useful -- and inconvenient, since it requires compiling
47 with profile info and can't be retrieved dynamically, as XEmacs is
48 running.
41 49
42 The basic idea is simple. We set a profiling timer using setitimer 50 The basic idea is simple. We set a profiling timer using setitimer
43 (ITIMER_PROF), which generates a SIGPROF every so often. (This 51 (ITIMER_PROF), which generates a SIGPROF every so often. (This runs not
44 runs not in real time but rather when the process is executing or 52 in real time but rather when the process is executing or the system is
45 the system is running on behalf of the process.) When the signal 53 running on behalf of the process.) When the signal goes off, we see what
46 goes off, we see what we're in, and add 1 to the count associated 54 we're in, and add 1 to the count associated with that function.
47 with that function. 55
48 56 It would be nice to use the Lisp allocation mechanism etc. to keep track
49 It would be nice to use the Lisp allocation mechanism etc. to keep 57 of the profiling information (i.e. to use Lisp hash tables), but we
50 track of the profiling information, but we can't because that's not 58 can't because that's not safe -- updating the timing information happens
51 safe, and trying to make it safe would be much more work than it's 59 inside of a signal handler, so we can't rely on not being in the middle
52 worth. 60 of Lisp allocation, garbage collection, malloc(), etc. Trying to make
53 61 it work would be much more work than it's worth. Instead we use a basic
54 Jan 1998: In addition to this, I have added code to remember call 62 (non-Lisp) hash table, which will not conflict with garbage collection
63 or anything else as long as it doesn't try to resize itself. Resizing
64 itself, however (which happens as a result of a puthash()), could be
65 deadly. To avoid this, we make sure, at points where it's safe
66 (e.g. profile_record_about_to_call() -- recording the entry into a
67 function call), that the table always has some breathing room in it so
68 that no resizes will occur until at least that many items are added.
69 This is safe because any new item to be added in the sigprof would
70 likely have the profile_record_about_to_call() called just before it,
71 and the breathing room is checked.
72
73 In general: any entry that the sigprof handler puts into the table comes
74 from a backtrace frame (except "Processing Events at Top Level", and
75 there's only one of those). Either that backtrace frame was added when
76 profiling was on (in which case profile_record_about_to_call() was
77 called and the breathing space updated), or when it was off -- and in
78 this case, no such frames can have been added since the last time
79 `start-profile' was called, so when `start-profile' is called we make
80 sure there is sufficient breathing room to account for all entries
81 currently on the stack.
82
83 Jan 1998: In addition to timing info, I have added code to remember call
55 counts of Lisp funcalls. The profile_increase_call_count() 84 counts of Lisp funcalls. The profile_increase_call_count()
56 function is called from Ffuncall(), and serves to add data to 85 function is called from Ffuncall(), and serves to add data to
57 Vcall_count_profile_table. This mechanism is much simpler and 86 Vcall_count_profile_table. This mechanism is much simpler and
58 independent of the SIGPROF-driven one. It uses the Lisp allocation 87 independent of the SIGPROF-driven one. It uses the Lisp allocation
59 mechanism normally, since it is not called from a handler. It may 88 mechanism normally, since it is not called from a handler. It may
60 even be useful to provide a way to turn on only one profiling 89 even be useful to provide a way to turn on only one profiling
61 mechanism, but I haven't done so yet. --hniksic */ 90 mechanism, but I haven't done so yet. --hniksic
62 91
92 Dec 2002: Total overhaul of the interface, making it sane and easier to
93 use. --ben
94
95 Feb 2003: Lots of rewriting of the internal code. Add GC-consing-usage,
96 total GC usage, and total timing to the information tracked. Track
97 profiling overhead and allow the ability to have internal sections
98 (e.g. internal-external conversion, byte-char conversion) that are
99 treated like Lisp functions for the purpose of profiling. --ben
100
101 BEWARE: If you are modifying this file, be *very* careful. Correctly
102 implementing the "total" values is very tricky due to the possibility of
103 recursion and of functions already on the stack when starting to
104 profile/still on the stack when stopping.
105 */
106
107 /* We use a plain table here because we're recording inside of a signal
108 handler. */
63 static struct hash_table *big_profile_table; 109 static struct hash_table *big_profile_table;
110 Lisp_Object Vtotal_timing_profile_table;
64 Lisp_Object Vcall_count_profile_table; 111 Lisp_Object Vcall_count_profile_table;
112 Lisp_Object Vtotal_gc_usage_profile_table;
113 Lisp_Object Vgc_usage_profile_table;
114
115 extern int lisp_eval_depth;
116
117 extern EMACS_UINT total_consing;
118 static volatile EMACS_UINT total_ticks;
65 119
66 Fixnum default_profiling_interval; 120 Fixnum default_profiling_interval;
67 121
68 int profiling_active; 122 int profiling_active;
69 123
70 /* The normal flag in_display is used as a critical-section flag
71 and is not set the whole time we're in redisplay. */
72 int profiling_redisplay_flag;
73
74 static Lisp_Object QSin_redisplay;
75 static Lisp_Object QSin_garbage_collection;
76 static Lisp_Object QSprocessing_events_at_top_level; 124 static Lisp_Object QSprocessing_events_at_top_level;
77 static Lisp_Object QSunknown; 125 static Lisp_Object QSunknown, QSprofile_overhead;
78 126
79 static Lisp_Object Qtiming, Qcall_count; 127 static Lisp_Object Qtiming, Qtotal_timing, Qcall_count;
80 128 static Lisp_Object Qgc_usage, Qtotal_gc_usage;
81 /* We use inside_profiling to prevent the handler from writing to 129
130 /* This needs to be >= the total number of defined internal sections,
131 plus 1 or 2?? Set it extra big just to be ultra-paranoid. */
132 #define EXTRA_BREATHING_ROOM 100
133
134 /* We use profiling_lock to prevent the signal handler from writing to
82 the table while another routine is operating on it. We also set 135 the table while another routine is operating on it. We also set
83 inside_profiling in case the timeout between signal calls is short 136 profiling_lock in case the timeout between signal calls is short
84 enough to catch us while we're already in there. */ 137 enough to catch us while we're already in there. */
85 static volatile int inside_profiling; 138 static volatile int profiling_lock;
139
140 /* Whether we're in the process of doing *any* profiling-related stuff.
141 Used to indicate amount of time spent profiling. */
142 static int in_profiling;
143
144 #if 0 /* #### for KKCC, eventually */
145
146 static const struct memory_description hentry_description_1[] = {
147 { XD_LISP_OBJECT, offsetof (hentry, key) },
148 { XD_END }
149 };
150
151 static const struct sized_memory_description hentry_description = {
152 sizeof (hentry),
153 hentry_description_1
154 };
155
156 static const struct memory_description plain_hash_table_description_1[] = {
157 { XD_ELEMCOUNT, offsetof (struct hash_table, size) },
158 { XD_STRUCT_PTR, offsetof (struct hash_table, harray), XD_INDIRECT (0, 0),
159 &hentry_description },
160 { XD_END }
161 };
162
163 static const struct sized_memory_description plain_hash_table_description = {
164 sizeof (struct hash_table),
165 plain_hash_table_description_1
166 };
167
168 #endif /* 0 */
86 169
87 static void 170 static void
88 create_call_count_profile_table (void) 171 create_timing_profile_table (void)
89 { 172 {
173 /* The hash code can safely be called from a signal handler except when
174 it has to grow the hash table. In this case, it calls realloc(),
175 which is not (in general) re-entrant. The way we deal with this is
176 documented at the top of this file. */
177 if (!big_profile_table)
178 big_profile_table = make_hash_table (2000);
179 }
180
181 static void
182 create_profile_tables (void)
183 {
184 create_timing_profile_table ();
185 if (NILP (Vtotal_timing_profile_table))
186 Vtotal_timing_profile_table =
187 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
90 if (NILP (Vcall_count_profile_table)) 188 if (NILP (Vcall_count_profile_table))
91 Vcall_count_profile_table = 189 Vcall_count_profile_table =
92 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); 190 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
93 } 191 if (NILP (Vgc_usage_profile_table))
94 192 Vgc_usage_profile_table =
95 static void 193 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
96 create_timing_profile_table (void) 194 if (NILP (Vtotal_gc_usage_profile_table))
97 { 195 Vtotal_gc_usage_profile_table =
98 /* #### The hash code can safely be called from a signal handler 196 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ);
99 except when it has to grow the hash table. In this case, it calls 197 }
100 realloc(), which is not (in general) re-entrant. We'll just be 198
101 sleazy and make the table large enough that it (hopefully) won't 199 static Lisp_Object
102 need to be realloc()ed. */ 200 current_profile_function (void)
103 if (!big_profile_table) 201 {
104 big_profile_table = make_hash_table (10000); 202 Lisp_Object fun;
105 } 203 struct backtrace *bt = backtrace_list;
106 204
107 /* Increase the value of OBJ in Vcall_count_profile_table hash table. 205 /* 2 because we set in_profiling when we entered the current routine. */
108 If the hash table is nil, create it first. */ 206 if (in_profiling >= 2)
207 return QSprofile_overhead;
208
209 /* Find a function actually being called. Potentially (?) there could be
210 a number of non-calling funs -- calling foo autoloads, which tries to
211 call bar, but requires evalling its args first, which calls baz, ...
212 If profiling was not enabled when the function was called, just treat
213 the function as actually called, because the info about whether we've
214 finished the preamble will not have been recorded. */
215 for (; bt && !bt->function_being_called; bt = bt->next)
216 ;
217
218 if (bt)
219 {
220 fun = *bt->function;
221
222 if (!SYMBOLP (fun)
223 && !COMPILED_FUNCTIONP (fun)
224 && !SUBRP (fun)
225 && !CONSP (fun)
226 && !STRINGP (fun))
227 fun = QSunknown;
228 }
229 else
230 fun = QSprocessing_events_at_top_level;
231 return fun;
232 }
233
109 void 234 void
110 profile_increase_call_count (Lisp_Object obj) 235 profile_record_consing (EMACS_INT size)
111 { 236 {
237 Lisp_Object fun;
112 Lisp_Object count; 238 Lisp_Object count;
113 239
114 create_call_count_profile_table (); 240 in_profiling++;
115 241 fun = current_profile_function ();
116 count = Fgethash (obj, Vcall_count_profile_table, Qzero); 242 count = Fgethash (fun, Vgc_usage_profile_table, Qzero);
117 if (!INTP (count)) 243 Fputhash (fun, make_int (size + XINT (count)), Vgc_usage_profile_table);
118 count = Qzero; 244 in_profiling--;
119 Fputhash (obj, make_int (1 + XINT (count)), Vcall_count_profile_table); 245 }
246
247 void
248 profile_record_unconsing (EMACS_INT size)
249 {
250 /* If we don't want to record values less than 0, change this; but then
251 the totals won't be accurate. */
252 profile_record_consing (-size);
253 }
254
255 inline static void
256 profile_sow_backtrace (struct backtrace *bt)
257 {
258 bt->current_total_timing_val =
259 XINT (Fgethash (*bt->function, Vtotal_timing_profile_table, Qzero));
260 bt->current_total_gc_usage_val =
261 XINT (Fgethash (*bt->function, Vtotal_gc_usage_profile_table, Qzero));
262 bt->function_being_called = 1;
263 /* Need to think carefully about the exact order of operations here
264 so that we don't end up with totals being less than function-only
265 values; */
266 bt->total_consing_at_start = total_consing;
267 /* Order of operation is tricky here because we want the total function
268 time to be as close as possible to (and absolutely not less than) the
269 function-only time. From the sigprof-handler's perspective, the
270 function is "entered" the moment we finish executing the
271 in_profiling-- statement below, and ends the moment we finish
272 executing the in_profiling++ statement in
273 profile_record_just_called(). By recording the tick value as close as
274 possible to the "in-function" window but not in it, we satisfy the
275 conditions just mentioned. */
276 bt->total_ticks_at_start = total_ticks;
277 }
278
279 void
280 profile_record_about_to_call (struct backtrace *bt)
281 {
282 in_profiling++;
283 profiling_lock = 1;
284 /* See comments in create_timing_profile_table(). */
285 pregrow_hash_table_if_necessary (big_profile_table, EXTRA_BREATHING_ROOM);
286 profiling_lock = 0;
287 Fputhash (*bt->function,
288 make_int (1 + XINT (Fgethash (*bt->function,
289 Vcall_count_profile_table,
290 Qzero))),
291 Vcall_count_profile_table);
292 /* This may be set if the function was in its preamble at the time that
293 `start-profiling' was called. If so, we shouldn't reset the values
294 because we may get inconsistent results, since we have already started
295 recording ticks and consing for the function. */
296 if (!bt->function_being_called)
297 profile_sow_backtrace (bt);
298 in_profiling--;
299 }
300
301 inline static void
302 profile_reap_backtrace (struct backtrace *bt)
303 {
304 EMACS_UINT ticks;
305 /* The following statement *MUST* come directly after the preceding one!
306 See the comment above. */
307 ticks = total_ticks;
308 /* We need to reset the "in-function" flag here. Otherwise the sigprof
309 handler will record more ticks for the function while the post-amble
310 is executing, and its value will be > our total value. */
311 bt->function_being_called = 0;
312 Fputhash (*bt->function,
313 /* This works even when the total_ticks value has overwrapped.
314 Same for total_consing below. */
315 make_int ((EMACS_INT) (ticks - bt->total_ticks_at_start)
316 + bt->current_total_timing_val),
317 Vtotal_timing_profile_table);
318 Fputhash (*bt->function,
319 make_int ((EMACS_INT)
320 (total_consing - bt->total_consing_at_start)
321 + bt->current_total_gc_usage_val),
322 Vtotal_gc_usage_profile_table);
323 }
324
325 void
326 profile_record_just_called (struct backtrace *bt)
327 {
328 in_profiling++;
329 profile_reap_backtrace (bt);
330 in_profiling--;
331 }
332
333 /* Called when unwinding the catch stack after a throw or signal, to
334 note that we are exiting the function. */
335 void
336 profile_record_unwind (struct backtrace *bt)
337 {
338 /* We may have thrown while still in a function's preamble. */
339 if (bt->function_being_called)
340 profile_record_just_called (bt);
120 } 341 }
121 342
122 static SIGTYPE 343 static SIGTYPE
123 sigprof_handler (int signo) 344 sigprof_handler (int signo)
124 { 345 {
346 #ifdef WIN32_ANY
347 /* Windows unfortunately does not have any such thing as setitimer
348 (ITIMER_PROF, ...), which runs in process time. Everything is real
349 time. So to get slightly more reasonable results, ignore completely
350 the times when we're blocking. Same applies, of course, to Cygwin. */
351 if (mswindows_is_blocking)
352 return;
353 #endif
354
355 in_profiling++;
356 total_ticks++;
357
125 /* Don't do anything if we are shutting down, or are doing a maphash 358 /* Don't do anything if we are shutting down, or are doing a maphash
126 or clrhash on the table. */ 359 or clrhash on the table. */
127 if (!inside_profiling && !preparing_for_armageddon) 360 if (!profiling_lock && !preparing_for_armageddon)
128 { 361 {
129 Lisp_Object fun; 362 Lisp_Object fun = current_profile_function ();
130 363
131 /* If something below causes an error to be signaled, we'll 364 /* If something below causes an error to be signaled, we'll
132 not correctly reset this flag. But we'll be in worse shape 365 not correctly reset this flag. But we'll be in worse shape
133 than that anyways, since we'll longjmp back to the last 366 than that anyways, since we'll longjmp back to the last
134 condition case. */ 367 condition case. */
135 inside_profiling = 1; 368 profiling_lock = 1;
136
137 if (profiling_redisplay_flag)
138 fun = QSin_redisplay;
139 else if (gc_in_progress)
140 fun = QSin_garbage_collection;
141 else if (backtrace_list)
142 {
143 fun = *backtrace_list->function;
144
145 if (!SYMBOLP (fun)
146 && !COMPILED_FUNCTIONP (fun)
147 && !SUBRP (fun)
148 && !CONSP (fun))
149 fun = QSunknown;
150 }
151 else
152 fun = QSprocessing_events_at_top_level;
153 369
154 { 370 {
155 /* #### see comment about memory allocation in start-profiling.
156 Allocating memory in a signal handler is BAD BAD BAD.
157 If you are using the non-mmap rel-alloc code, you might
158 lose because of this. Even worse, if the memory allocation
159 fails, the `error' generated whacks everything hard. */
160 long count; 371 long count;
161 const void *vval; 372 const void *vval;
162 373
163 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval)) 374 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval))
164 count = (long) vval; 375 count = (long) vval;
167 count++; 378 count++;
168 vval = (const void *) count; 379 vval = (const void *) count;
169 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table); 380 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table);
170 } 381 }
171 382
172 inside_profiling = 0; 383 profiling_lock = 0;
173 } 384 }
174 } 385 in_profiling--;
175 386 }
176 DEFUN ("start-profiling", Fstart_profiling, 0, 1, 0, /* 387
388 DEFUN ("start-profiling", Fstart_profiling, 0, 1, "", /*
177 Start profiling, with profile queries every MICROSECS. 389 Start profiling, with profile queries every MICROSECS.
178 If MICROSECS is nil or omitted, the value of `default-profiling-interval' 390 If MICROSECS is nil or omitted, the value of `default-profiling-interval'
179 is used. 391 is used.
180 392
181 Information on function timings and call counts is currently recorded. 393 Information on function timings and call counts is currently recorded.
182 You can retrieve the recorded profiling info using `get-profiling-info'. 394 You can retrieve the recorded profiling info using `get-profiling-info',
395 or the higher-level function `profile-results'.
183 396
184 Starting and stopping profiling does not clear the currently recorded 397 Starting and stopping profiling does not clear the currently recorded
185 info. Thus you can start and stop as many times as you want and everything 398 info. Thus you can start and stop as many times as you want and everything
186 will be properly accumulated. 399 will be properly accumulated. (To clear, use `clear-profiling-info'.)
187 */ 400 */
188 (microsecs)) 401 (microsecs))
189 { 402 {
190 /* This function can GC */ 403 /* This function can GC */
191 int msecs; 404 int msecs;
192 struct itimerval foo; 405 struct itimerval foo;
193 406 int depth;
194 /* #### The hash code can safely be called from a signal handler 407
195 except when it has to grow the hash table. In this case, it calls 408 if (profiling_active)
196 realloc(), which is not (in general) re-entrant. We'll just be 409 return Qnil;
197 sleazy and make the table large enough that it (hopefully) won't 410 depth = internal_bind_int (&in_profiling, 1 + in_profiling);
198 need to be realloc()ed. */ 411
199 create_timing_profile_table (); 412 create_profile_tables ();
413 /* See comments at top of file and in create_timing_profile_table().
414 We ensure enough breathing room for all entries currently on the
415 stack. */
416 pregrow_hash_table_if_necessary (big_profile_table,
417 EXTRA_BREATHING_ROOM + lisp_eval_depth);
200 418
201 if (NILP (microsecs)) 419 if (NILP (microsecs))
202 msecs = default_profiling_interval; 420 msecs = default_profiling_interval;
203 else 421 else
204 { 422 {
207 } 425 }
208 if (msecs <= 0) 426 if (msecs <= 0)
209 msecs = 1000; 427 msecs = 1000;
210 428
211 set_timeout_signal (SIGPROF, sigprof_handler); 429 set_timeout_signal (SIGPROF, sigprof_handler);
430 {
431 struct backtrace *bt = backtrace_list;
432
433 /* When we begin profiling, pretend like we just entered all the
434 functions currently on the stack. When we stop profiling, do the
435 opposite. This ensures consistent values being recorded for both
436 function-only and total in such cases. */
437 for (; bt; bt = bt->next)
438 profile_sow_backtrace (bt);
439 }
440 profiling_active = 1;
441 profiling_lock = 0;
212 foo.it_value.tv_sec = 0; 442 foo.it_value.tv_sec = 0;
213 foo.it_value.tv_usec = msecs; 443 foo.it_value.tv_usec = msecs;
214 EMACS_NORMALIZE_TIME (foo.it_value); 444 EMACS_NORMALIZE_TIME (foo.it_value);
215 foo.it_interval = foo.it_value; 445 foo.it_interval = foo.it_value;
216 profiling_active = 1;
217 inside_profiling = 0;
218 qxe_setitimer (ITIMER_PROF, &foo, 0); 446 qxe_setitimer (ITIMER_PROF, &foo, 0);
447 unbind_to (depth);
219 return Qnil; 448 return Qnil;
220 } 449 }
221 450
222 DEFUN ("stop-profiling", Fstop_profiling, 0, 0, 0, /* 451 DEFUN ("stop-profiling", Fstop_profiling, 0, 0, "", /*
223 Stop profiling. 452 Stop profiling.
224 */ 453 */
225 ()) 454 ())
226 { 455 {
227 /* This function does not GC */ 456 /* This function does not GC */
228 struct itimerval foo; 457 struct itimerval foo;
229 458
459 if (!profiling_active)
460 return Qnil;
461 in_profiling++;
230 foo.it_value.tv_sec = 0; 462 foo.it_value.tv_sec = 0;
231 foo.it_value.tv_usec = 0; 463 foo.it_value.tv_usec = 0;
232 foo.it_interval = foo.it_value; 464 foo.it_interval = foo.it_value;
233 qxe_setitimer (ITIMER_PROF, &foo, 0); 465 qxe_setitimer (ITIMER_PROF, &foo, 0);
234 profiling_active = 0; 466 profiling_active = 0;
467 {
468 struct backtrace *bt = backtrace_list;
469
470 for (; bt; bt = bt->next)
471 profile_reap_backtrace (bt);
472 }
235 set_timeout_signal (SIGPROF, fatal_error_signal); 473 set_timeout_signal (SIGPROF, fatal_error_signal);
474 in_profiling--;
236 return Qnil; 475 return Qnil;
237 } 476 }
238 477
239 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, "", /* 478 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, "", /*
240 Clear out the recorded profiling info. 479 Clear out the recorded profiling info.
241 This clears both the internal timing information and the call counts in 480 This clears both the internal timing information and the call counts in
242 `call-count-profile-table'. 481 `call-count-profile-table'.
243 */ 482 */
244 ()) 483 ())
245 { 484 {
485 in_profiling++;
246 /* This function does not GC */ 486 /* This function does not GC */
247 if (big_profile_table) 487 if (big_profile_table)
248 { 488 {
249 inside_profiling = 1; 489 profiling_lock = 1;
250 clrhash (big_profile_table); 490 clrhash (big_profile_table);
251 inside_profiling = 0; 491 profiling_lock = 0;
252 } 492 }
493 if (!NILP (Vtotal_timing_profile_table))
494 Fclrhash (Vtotal_timing_profile_table);
253 if (!NILP (Vcall_count_profile_table)) 495 if (!NILP (Vcall_count_profile_table))
254 Fclrhash (Vcall_count_profile_table); 496 Fclrhash (Vcall_count_profile_table);
497 if (!NILP (Vgc_usage_profile_table))
498 Fclrhash (Vgc_usage_profile_table);
499 if (!NILP (Vtotal_gc_usage_profile_table))
500 Fclrhash (Vtotal_gc_usage_profile_table);
501 in_profiling--;
502
255 return Qnil; 503 return Qnil;
256 } 504 }
257 505
258 struct get_profiling_info_closure 506 struct get_profiling_info_closure
259 { 507 {
276 524
277 Fputhash (key, make_int (val), closure->timing); 525 Fputhash (key, make_int (val), closure->timing);
278 return 0; 526 return 0;
279 } 527 }
280 528
529 static Lisp_Object
530 copy_hash_table_or_blank (Lisp_Object table)
531 {
532 return !NILP (table) ? Fcopy_hash_table (table) :
533 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK,
534 HASH_TABLE_EQ);
535 }
536
281 DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /* 537 DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /*
282 Return the currently recorded profiling info. 538 Return the currently recorded profiling info.
283 The format is a plist of symbols describing type of info recorded and 539 The format is a plist of symbols describing type of info recorded and
284 an associated type-specific entry. Currently, the following info types 540 an associated type-specific entry. Currently, the following info types
285 are recorded 541 are recorded
286 542
287 `timing' 543 `timing'
288 A hash table of funcallable objects or strings describing internal processing 544 A hash table of function descriptions (funcallable objects or strings
289 operations \(redisplay, garbage collection, etc.), along with associated 545 describing internal processing operations -- redisplay, garbage
290 tick counts (the frequency of ticks is controlled by 546 collection, etc.), along with associated tick counts (the frequency of
291 `default-profiling-interval' or the argument to `start-profiling'). 547 ticks is controlled by `default-profiling-interval' or the argument to
548 `start-profiling').
549
550 `total-timing'
551 A hash table of function descriptions and associated timing count for
552 the function and all descendants.
292 553
293 `call-count' 554 `call-count'
294 A hash table of funcallable objects and associated call counts. 555 A hash table of function descriptions and associated call counts.
556
557 `gc-usage'
558 A hash table of function descriptions and associated amount of consing.
559
560 `total-gc-usage'
561 A hash table of function descriptions and associated amount of consing
562 in the function and all descendants.
295 */ 563 */
296 ()) 564 ())
297 { 565 {
298 /* This function does not GC */ 566 /* This function does not GC */
299 struct get_profiling_info_closure closure; 567 struct get_profiling_info_closure closure;
568 Lisp_Object retv;
569 int depth = internal_bind_int (&in_profiling, 1 + in_profiling);
570 const void *overhead;
300 571
301 closure.timing = 572 closure.timing =
302 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL); 573 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, HASH_TABLE_EQUAL);
303 574
304 if (big_profile_table) 575 if (big_profile_table)
305 { 576 {
306 int count = internal_bind_int ((int *) &inside_profiling, 1); 577 int count = internal_bind_int ((int *) &profiling_lock, 1);
307 maphash (get_profiling_info_timing_maphash, big_profile_table, &closure); 578 maphash (get_profiling_info_timing_maphash, big_profile_table, &closure);
579
580 /* OK, OK ... the total-timing table is not going to have an entry
581 for profile overhead, and it looks strange for it to come out 0,
582 so make sure it looks reasonable. */
583 if (!gethash (LISP_TO_VOID (QSprofile_overhead), big_profile_table,
584 &overhead))
585 overhead = 0;
586 Fputhash (QSprofile_overhead, make_int ((EMACS_INT) overhead),
587 Vtotal_timing_profile_table);
588
308 unbind_to (count); 589 unbind_to (count);
309 } 590 }
310 591
311 return list4 (Qtiming, closure.timing, Qcall_count, 592 retv = nconc2 (list6 (Qtiming, closure.timing, Qtotal_timing,
312 !NILP (Vcall_count_profile_table) ? 593 copy_hash_table_or_blank (Vtotal_timing_profile_table),
313 Fcopy_hash_table (Vcall_count_profile_table) : 594 Qcall_count,
314 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, 595 copy_hash_table_or_blank (Vcall_count_profile_table)),
315 HASH_TABLE_EQ)); 596 list4 (Qgc_usage,
316 } 597 copy_hash_table_or_blank (Vgc_usage_profile_table),
317 598 Qtotal_gc_usage,
318 struct set_profiling_info_closure 599 copy_hash_table_or_blank (Vtotal_gc_usage_profile_table
319 { 600 )));
320 Lisp_Object timing; 601 unbind_to (depth);
321 }; 602 return retv;
603 }
322 604
323 static int 605 static int
324 set_profiling_info_timing_maphash (Lisp_Object key, 606 set_profiling_info_timing_maphash (Lisp_Object key,
325 Lisp_Object val, 607 Lisp_Object val,
326 void *void_closure) 608 void *void_closure)
341 INFO should be in the same format returned by `get-profiling-info', 623 INFO should be in the same format returned by `get-profiling-info',
342 as described there. 624 as described there.
343 */ 625 */
344 (info)) 626 (info))
345 { 627 {
628 int depth;
346 /* This function does not GC */ 629 /* This function does not GC */
347 Fclear_profiling_info (); 630 Fclear_profiling_info ();
348 631
632 depth = internal_bind_int (&in_profiling, 1 + in_profiling);
349 { 633 {
350 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, info) 634 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, info)
351 { 635 {
352 if (EQ (key, Qtiming)) 636 if (EQ (key, Qtiming))
353 { 637 {
354 CHECK_HASH_TABLE (value); 638 CHECK_HASH_TABLE (value);
355 create_timing_profile_table (); 639 create_timing_profile_table ();
640 profiling_lock = 1;
356 elisp_maphash_unsafe (set_profiling_info_timing_maphash, value, 641 elisp_maphash_unsafe (set_profiling_info_timing_maphash, value,
357 NULL); 642 NULL);
643 profiling_lock = 0;
358 } 644 }
359 else if (EQ (key, Qcall_count)) 645 else if (EQ (key, Qcall_count))
360 { 646 Vcall_count_profile_table = Fcopy_hash_table (value);
361 Vcall_count_profile_table = Fcopy_hash_table (value); 647 else if (EQ (key, Qtotal_timing))
362 } 648 Vtotal_timing_profile_table = Fcopy_hash_table (value);
649 else if (EQ (key, Qgc_usage))
650 Vgc_usage_profile_table = Fcopy_hash_table (value);
651 else if (EQ (key, Qtotal_gc_usage))
652 Vtotal_gc_usage_profile_table = Fcopy_hash_table (value);
363 else 653 else
364 invalid_constant ("Unrecognized profiling-info keyword", key); 654 invalid_constant ("Unrecognized profiling-info keyword", key);
365 } 655 }
366 } 656 }
367 657
658 unbind_to (depth);
368 return Qnil; 659 return Qnil;
369 } 660 }
370 661
371 static int 662 static int
372 mark_profiling_info_maphash (const void *void_key, 663 mark_profiling_info_maphash (const void *void_key,
373 void *void_val, 664 void *void_val,
374 void *void_closure) 665 void *void_closure)
375 { 666 {
376 Lisp_Object key; 667 mark_object (VOID_TO_LISP (void_key));
377
378 key = VOID_TO_LISP (void_key);
379 mark_object (key);
380 return 0; 668 return 0;
381 } 669 }
382 670
383 void 671 void
384 mark_profiling_info (void) 672 mark_profiling_info (void)
385 { 673 {
386 /* This function does not GC */ 674 /* This function does not GC */
387 if (big_profile_table) 675 if (big_profile_table)
388 { 676 {
389 inside_profiling = 1; 677 profiling_lock = 1;
390 maphash (mark_profiling_info_maphash, big_profile_table, 0); 678 maphash (mark_profiling_info_maphash, big_profile_table, 0);
391 inside_profiling = 0; 679 profiling_lock = 0;
392 } 680 }
393 } 681 }
394 682
395 DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /* 683 DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /*
396 Return non-nil if profiling information is currently being recorded. 684 Return non-nil if profiling information is currently being recorded.
424 default_profiling_interval = 1000; 712 default_profiling_interval = 1000;
425 713
426 staticpro (&Vcall_count_profile_table); 714 staticpro (&Vcall_count_profile_table);
427 Vcall_count_profile_table = Qnil; 715 Vcall_count_profile_table = Qnil;
428 716
429 inside_profiling = 0; 717 staticpro (&Vgc_usage_profile_table);
430 718 Vgc_usage_profile_table = Qnil;
431 QSin_redisplay = build_msg_string ("(in redisplay)"); 719
432 staticpro (&QSin_redisplay); 720 staticpro (&Vtotal_gc_usage_profile_table);
433 QSin_garbage_collection = build_msg_string ("(in garbage collection)"); 721 Vtotal_gc_usage_profile_table = Qnil;
434 staticpro (&QSin_garbage_collection); 722
723 staticpro (&Vtotal_timing_profile_table);
724 Vtotal_timing_profile_table = Qnil;
725
726 #if 0
727 /* #### This is supposed to be for KKCC but KKCC doesn't use this stuff
728 currently. */
729 dump_add_root_struct_ptr (&big_profile_table, &plain_hash_table_description);
730 #endif /* 0 */
731
732 profiling_lock = 0;
733
435 QSunknown = build_msg_string ("(unknown)"); 734 QSunknown = build_msg_string ("(unknown)");
436 staticpro (&QSunknown); 735 staticpro (&QSunknown);
437 QSprocessing_events_at_top_level = 736 QSprocessing_events_at_top_level =
438 build_msg_string ("(processing events at top level)"); 737 build_msg_string ("(processing events at top level)");
439 staticpro (&QSprocessing_events_at_top_level); 738 staticpro (&QSprocessing_events_at_top_level);
739 QSprofile_overhead = build_msg_string ("(profile overhead)");
740 staticpro (&QSprofile_overhead);
440 741
441 DEFSYMBOL (Qtiming); 742 DEFSYMBOL (Qtiming);
743 DEFSYMBOL (Qtotal_timing);
442 DEFSYMBOL (Qcall_count); 744 DEFSYMBOL (Qcall_count);
443 } 745 DEFSYMBOL (Qgc_usage);
746 DEFSYMBOL (Qtotal_gc_usage);
747 }