Mercurial > hg > xemacs-beta
annotate src/profile.c @ 5636:07256dcc0c8b
Add missing foreback specifier values to the GUI Element face.
They were missing for an unexplicable reason in my initial patch, leading to
nil color instances in the whole hierarchy of widget faces.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2012-01-03 Didier Verna <didier@xemacs.org>
* faces.c (complex_vars_of_faces): Add missing foreback specifier
values to the GUI Element face.
| author | Didier Verna <didier@lrde.epita.fr> |
|---|---|
| date | Tue, 03 Jan 2012 11:25:06 +0100 |
| parents | 56144c8593a8 |
| children | 3192994c49ca |
| rev | line source |
|---|---|
| 428 | 1 /* Why the hell is XEmacs so fucking slow? |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5038
diff
changeset
|
2 Copyright (C) 1996, 2002, 2003, 2004, 2010 Ben Wing. |
| 428 | 3 Copyright (C) 1998 Free Software Foundation, Inc. |
| 4 | |
| 5 This file is part of XEmacs. | |
| 6 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5191
diff
changeset
|
7 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 8 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5191
diff
changeset
|
9 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5191
diff
changeset
|
10 option) any later version. |
| 428 | 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5191
diff
changeset
|
18 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 19 |
| 20 #include <config.h> | |
| 21 #include "lisp.h" | |
| 22 | |
| 23 #include "backtrace.h" | |
| 24 #include "bytecode.h" | |
| 25 #include "elhash.h" | |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5038
diff
changeset
|
26 #include "gc.h" |
| 428 | 27 #include "hash.h" |
| 1315 | 28 #include "profile.h" |
| 428 | 29 |
| 30 #include "syssignal.h" | |
| 31 #include "systime.h" | |
| 32 | |
| 611 | 33 #ifndef HAVE_SETITIMER |
| 34 #error Sorry charlie. We need a scalpel and all we have is a lawnmower. | |
| 35 #endif | |
| 36 | |
| 1292 | 37 #ifdef WIN32_ANY |
| 38 int mswindows_is_blocking; | |
| 39 #endif | |
| 40 | |
| 2367 | 41 /* Written by Ben Wing. */ |
| 428 | 42 |
| 2367 | 43 /* |
| 428 | 44 |
| 2367 | 45 Documented in |
| 428 | 46 |
| 2367 | 47 (Info-goto-node "(internals)Profiling") |
| 1292 | 48 */ |
| 49 | |
| 50 /* We use a plain table here because we're recording inside of a signal | |
| 51 handler. */ | |
| 428 | 52 static struct hash_table *big_profile_table; |
| 1292 | 53 Lisp_Object Vtotal_timing_profile_table; |
| 428 | 54 Lisp_Object Vcall_count_profile_table; |
| 1292 | 55 Lisp_Object Vtotal_gc_usage_profile_table; |
| 56 Lisp_Object Vgc_usage_profile_table; | |
| 57 | |
| 58 extern int lisp_eval_depth; | |
| 59 | |
| 60 extern EMACS_UINT total_consing; | |
| 61 static volatile EMACS_UINT total_ticks; | |
| 428 | 62 |
| 458 | 63 Fixnum default_profiling_interval; |
| 428 | 64 |
| 65 int profiling_active; | |
| 66 | |
| 1292 | 67 static Lisp_Object QSprocessing_events_at_top_level; |
| 68 static Lisp_Object QSunknown, QSprofile_overhead; | |
| 69 | |
| 2514 | 70 #ifdef DEBUG_XEMACS |
| 71 /* For temporary profiling */ | |
| 72 Lisp_Object QSin_temp_spot_1; | |
| 73 Lisp_Object QSin_temp_spot_2; | |
| 74 Lisp_Object QSin_temp_spot_3; | |
| 75 Lisp_Object QSin_temp_spot_4; | |
| 76 Lisp_Object QSin_temp_spot_5; | |
| 77 #endif /* DEBUG_XEMACS */ | |
| 78 | |
| 1292 | 79 static Lisp_Object Qtiming, Qtotal_timing, Qcall_count; |
| 80 static Lisp_Object Qgc_usage, Qtotal_gc_usage; | |
| 81 | |
| 82 /* This needs to be >= the total number of defined internal sections, | |
| 83 plus 1 or 2?? Set it extra big just to be ultra-paranoid. */ | |
| 84 #define EXTRA_BREATHING_ROOM 100 | |
| 428 | 85 |
| 1292 | 86 /* We use profiling_lock to prevent the signal handler from writing to |
| 87 the table while another routine is operating on it. We also set | |
| 88 profiling_lock in case the timeout between signal calls is short | |
| 89 enough to catch us while we're already in there. */ | |
| 90 static volatile int profiling_lock; | |
| 428 | 91 |
| 1292 | 92 /* Whether we're in the process of doing *any* profiling-related stuff. |
| 93 Used to indicate amount of time spent profiling. */ | |
| 94 static int in_profiling; | |
| 95 | |
| 96 #if 0 /* #### for KKCC, eventually */ | |
| 1123 | 97 |
| 1292 | 98 static const struct memory_description hentry_description_1[] = { |
| 99 { XD_LISP_OBJECT, offsetof (hentry, key) }, | |
| 100 { XD_END } | |
| 101 }; | |
| 102 | |
| 103 static const struct sized_memory_description hentry_description = { | |
| 104 sizeof (hentry), | |
| 105 hentry_description_1 | |
| 106 }; | |
| 428 | 107 |
| 1292 | 108 static const struct memory_description plain_hash_table_description_1[] = { |
| 109 { XD_ELEMCOUNT, offsetof (struct hash_table, size) }, | |
| 2367 | 110 { XD_BLOCK_PTR, offsetof (struct hash_table, harray), XD_INDIRECT (0, 0), |
| 2551 | 111 { &hentry_description } }, |
| 1292 | 112 { XD_END } |
| 113 }; | |
| 114 | |
| 115 static const struct sized_memory_description plain_hash_table_description = { | |
| 116 sizeof (struct hash_table), | |
| 117 plain_hash_table_description_1 | |
| 118 }; | |
| 119 | |
| 120 #endif /* 0 */ | |
| 1123 | 121 |
| 122 static void | |
| 123 create_timing_profile_table (void) | |
| 124 { | |
| 1292 | 125 /* The hash code can safely be called from a signal handler except when |
| 126 it has to grow the hash table. In this case, it calls realloc(), | |
| 5038 | 127 which is not (in general) reentrant. The way we deal with this is |
| 1292 | 128 documented at the top of this file. */ |
| 1123 | 129 if (!big_profile_table) |
| 1292 | 130 big_profile_table = make_hash_table (2000); |
| 131 } | |
| 132 | |
| 133 static void | |
| 134 create_profile_tables (void) | |
| 135 { | |
| 136 create_timing_profile_table (); | |
| 137 if (NILP (Vtotal_timing_profile_table)) | |
| 138 Vtotal_timing_profile_table = | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
139 make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, Qeq); |
| 1292 | 140 if (NILP (Vcall_count_profile_table)) |
| 141 Vcall_count_profile_table = | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
142 make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, Qeq); |
| 1292 | 143 if (NILP (Vgc_usage_profile_table)) |
| 144 Vgc_usage_profile_table = | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
145 make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, Qeq); |
| 1292 | 146 if (NILP (Vtotal_gc_usage_profile_table)) |
| 147 Vtotal_gc_usage_profile_table = | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
148 make_lisp_hash_table (1000, HASH_TABLE_NON_WEAK, Qeq); |
| 1292 | 149 } |
| 150 | |
| 151 static Lisp_Object | |
| 152 current_profile_function (void) | |
| 153 { | |
| 154 Lisp_Object fun; | |
| 155 struct backtrace *bt = backtrace_list; | |
| 156 | |
| 157 /* 2 because we set in_profiling when we entered the current routine. */ | |
| 158 if (in_profiling >= 2) | |
| 159 return QSprofile_overhead; | |
| 160 | |
| 161 /* Find a function actually being called. Potentially (?) there could be | |
| 162 a number of non-calling funs -- calling foo autoloads, which tries to | |
| 163 call bar, but requires evalling its args first, which calls baz, ... | |
| 164 If profiling was not enabled when the function was called, just treat | |
| 165 the function as actually called, because the info about whether we've | |
| 166 finished the preamble will not have been recorded. */ | |
| 167 for (; bt && !bt->function_being_called; bt = bt->next) | |
| 168 ; | |
| 169 | |
| 170 if (bt) | |
| 171 { | |
| 172 fun = *bt->function; | |
| 173 | |
| 174 if (!SYMBOLP (fun) | |
| 175 && !COMPILED_FUNCTIONP (fun) | |
| 176 && !SUBRP (fun) | |
| 177 && !CONSP (fun) | |
| 178 && !STRINGP (fun)) | |
| 179 fun = QSunknown; | |
| 180 } | |
| 181 else | |
| 182 fun = QSprocessing_events_at_top_level; | |
| 183 return fun; | |
| 184 } | |
| 185 | |
| 186 void | |
| 187 profile_record_consing (EMACS_INT size) | |
| 188 { | |
| 189 in_profiling++; | |
| 2421 | 190 inchash_eq (current_profile_function (), Vgc_usage_profile_table, size); |
| 1292 | 191 in_profiling--; |
| 192 } | |
| 193 | |
| 194 void | |
| 195 profile_record_unconsing (EMACS_INT size) | |
| 196 { | |
| 197 /* If we don't want to record values less than 0, change this; but then | |
| 198 the totals won't be accurate. */ | |
| 199 profile_record_consing (-size); | |
| 1123 | 200 } |
| 201 | |
| 1292 | 202 inline static void |
| 203 profile_sow_backtrace (struct backtrace *bt) | |
| 428 | 204 { |
| 1292 | 205 bt->current_total_timing_val = |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
206 XFIXNUM (Fgethash (*bt->function, Vtotal_timing_profile_table, Qzero)); |
| 1292 | 207 bt->current_total_gc_usage_val = |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
208 XFIXNUM (Fgethash (*bt->function, Vtotal_gc_usage_profile_table, Qzero)); |
| 1292 | 209 bt->function_being_called = 1; |
| 210 /* Need to think carefully about the exact order of operations here | |
| 211 so that we don't end up with totals being less than function-only | |
| 212 values; */ | |
| 213 bt->total_consing_at_start = total_consing; | |
| 214 /* Order of operation is tricky here because we want the total function | |
| 215 time to be as close as possible to (and absolutely not less than) the | |
| 216 function-only time. From the sigprof-handler's perspective, the | |
| 217 function is "entered" the moment we finish executing the | |
| 218 in_profiling-- statement below, and ends the moment we finish | |
| 219 executing the in_profiling++ statement in | |
| 220 profile_record_just_called(). By recording the tick value as close as | |
| 221 possible to the "in-function" window but not in it, we satisfy the | |
| 222 conditions just mentioned. */ | |
| 223 bt->total_ticks_at_start = total_ticks; | |
| 224 } | |
| 428 | 225 |
| 1292 | 226 void |
| 227 profile_record_about_to_call (struct backtrace *bt) | |
| 228 { | |
| 229 in_profiling++; | |
| 230 profiling_lock = 1; | |
| 231 /* See comments in create_timing_profile_table(). */ | |
| 232 pregrow_hash_table_if_necessary (big_profile_table, EXTRA_BREATHING_ROOM); | |
| 233 profiling_lock = 0; | |
| 2421 | 234 inchash_eq (*bt->function, Vcall_count_profile_table, 1); |
| 1292 | 235 /* This may be set if the function was in its preamble at the time that |
| 236 `start-profiling' was called. If so, we shouldn't reset the values | |
| 237 because we may get inconsistent results, since we have already started | |
| 238 recording ticks and consing for the function. */ | |
| 239 if (!bt->function_being_called) | |
| 240 profile_sow_backtrace (bt); | |
| 241 in_profiling--; | |
| 242 } | |
| 428 | 243 |
| 1292 | 244 inline static void |
| 245 profile_reap_backtrace (struct backtrace *bt) | |
| 246 { | |
| 247 EMACS_UINT ticks; | |
| 248 /* The following statement *MUST* come directly after the preceding one! | |
| 249 See the comment above. */ | |
| 250 ticks = total_ticks; | |
| 251 /* We need to reset the "in-function" flag here. Otherwise the sigprof | |
| 252 handler will record more ticks for the function while the post-amble | |
| 253 is executing, and its value will be > our total value. */ | |
| 254 bt->function_being_called = 0; | |
| 255 Fputhash (*bt->function, | |
| 256 /* This works even when the total_ticks value has overwrapped. | |
| 257 Same for total_consing below. */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
258 make_fixnum ((EMACS_INT) (ticks - bt->total_ticks_at_start) |
| 1292 | 259 + bt->current_total_timing_val), |
| 260 Vtotal_timing_profile_table); | |
| 261 Fputhash (*bt->function, | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
262 make_fixnum ((EMACS_INT) |
| 1292 | 263 (total_consing - bt->total_consing_at_start) |
| 264 + bt->current_total_gc_usage_val), | |
| 265 Vtotal_gc_usage_profile_table); | |
| 266 } | |
| 267 | |
| 268 void | |
| 269 profile_record_just_called (struct backtrace *bt) | |
| 270 { | |
| 271 in_profiling++; | |
| 272 profile_reap_backtrace (bt); | |
| 273 in_profiling--; | |
| 274 } | |
| 275 | |
| 276 /* Called when unwinding the catch stack after a throw or signal, to | |
| 277 note that we are exiting the function. */ | |
| 278 void | |
| 279 profile_record_unwind (struct backtrace *bt) | |
| 280 { | |
| 281 /* We may have thrown while still in a function's preamble. */ | |
| 282 if (bt->function_being_called) | |
| 283 profile_record_just_called (bt); | |
| 428 | 284 } |
| 285 | |
| 286 static SIGTYPE | |
| 2286 | 287 sigprof_handler (int UNUSED (signo)) |
| 428 | 288 { |
| 1292 | 289 #ifdef WIN32_ANY |
| 290 /* Windows unfortunately does not have any such thing as setitimer | |
| 291 (ITIMER_PROF, ...), which runs in process time. Everything is real | |
| 292 time. So to get slightly more reasonable results, ignore completely | |
| 293 the times when we're blocking. Same applies, of course, to Cygwin. */ | |
| 294 if (mswindows_is_blocking) | |
| 295 return; | |
| 296 #endif | |
| 297 | |
| 298 in_profiling++; | |
| 299 total_ticks++; | |
| 300 | |
| 428 | 301 /* Don't do anything if we are shutting down, or are doing a maphash |
| 302 or clrhash on the table. */ | |
| 1292 | 303 if (!profiling_lock && !preparing_for_armageddon) |
| 428 | 304 { |
| 1292 | 305 Lisp_Object fun = current_profile_function (); |
| 428 | 306 |
| 307 /* If something below causes an error to be signaled, we'll | |
| 308 not correctly reset this flag. But we'll be in worse shape | |
| 309 than that anyways, since we'll longjmp back to the last | |
| 310 condition case. */ | |
| 1292 | 311 profiling_lock = 1; |
| 428 | 312 |
| 313 { | |
| 314 long count; | |
| 442 | 315 const void *vval; |
| 428 | 316 |
| 5013 | 317 if (gethash (STORE_LISP_IN_VOID (fun), big_profile_table, &vval)) |
| 428 | 318 count = (long) vval; |
| 319 else | |
| 320 count = 0; | |
| 321 count++; | |
| 442 | 322 vval = (const void *) count; |
| 5013 | 323 puthash (STORE_LISP_IN_VOID (fun), (void *) vval, big_profile_table); |
| 428 | 324 } |
| 325 | |
| 1292 | 326 profiling_lock = 0; |
| 428 | 327 } |
| 1292 | 328 in_profiling--; |
| 428 | 329 } |
| 330 | |
| 1292 | 331 DEFUN ("start-profiling", Fstart_profiling, 0, 1, "", /* |
| 428 | 332 Start profiling, with profile queries every MICROSECS. |
| 333 If MICROSECS is nil or omitted, the value of `default-profiling-interval' | |
| 334 is used. | |
| 335 | |
| 1123 | 336 Information on function timings and call counts is currently recorded. |
| 1292 | 337 You can retrieve the recorded profiling info using `get-profiling-info', |
| 338 or the higher-level function `profile-results'. | |
| 428 | 339 |
| 340 Starting and stopping profiling does not clear the currently recorded | |
| 341 info. Thus you can start and stop as many times as you want and everything | |
| 1292 | 342 will be properly accumulated. (To clear, use `clear-profiling-info'.) |
| 428 | 343 */ |
| 344 (microsecs)) | |
| 345 { | |
| 346 /* This function can GC */ | |
| 347 int msecs; | |
| 348 struct itimerval foo; | |
| 1292 | 349 int depth; |
| 428 | 350 |
| 1292 | 351 if (profiling_active) |
| 352 return Qnil; | |
| 353 depth = internal_bind_int (&in_profiling, 1 + in_profiling); | |
| 354 | |
| 355 create_profile_tables (); | |
| 356 /* See comments at top of file and in create_timing_profile_table(). | |
| 357 We ensure enough breathing room for all entries currently on the | |
| 358 stack. */ | |
| 359 pregrow_hash_table_if_necessary (big_profile_table, | |
| 360 EXTRA_BREATHING_ROOM + lisp_eval_depth); | |
| 428 | 361 |
| 362 if (NILP (microsecs)) | |
| 363 msecs = default_profiling_interval; | |
| 364 else | |
| 365 { | |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
366 #ifdef HAVE_BIGNUM |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
367 check_integer_range (microsecs, make_fixnum (1000), make_integer (INT_MAX)); |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
368 msecs = |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
369 BIGNUMP (microsecs) ? bignum_to_int (XBIGNUM_DATA (microsecs)) : |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
370 XFIXNUM (microsecs); |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
371 #else |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
372 check_integer_range (microsecs, make_fixnum (1000), |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
373 make_integer (MOST_POSITIVE_FIXNUM)); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
374 msecs = XFIXNUM (microsecs); |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
375 #endif |
| 428 | 376 } |
| 377 if (msecs <= 0) | |
| 378 msecs = 1000; | |
| 379 | |
| 613 | 380 set_timeout_signal (SIGPROF, sigprof_handler); |
| 1292 | 381 { |
| 382 struct backtrace *bt = backtrace_list; | |
| 383 | |
| 384 /* When we begin profiling, pretend like we just entered all the | |
| 385 functions currently on the stack. When we stop profiling, do the | |
| 386 opposite. This ensures consistent values being recorded for both | |
| 387 function-only and total in such cases. */ | |
| 388 for (; bt; bt = bt->next) | |
| 389 profile_sow_backtrace (bt); | |
| 390 } | |
| 391 profiling_active = 1; | |
| 392 profiling_lock = 0; | |
| 428 | 393 foo.it_value.tv_sec = 0; |
| 394 foo.it_value.tv_usec = msecs; | |
| 395 EMACS_NORMALIZE_TIME (foo.it_value); | |
| 396 foo.it_interval = foo.it_value; | |
| 611 | 397 qxe_setitimer (ITIMER_PROF, &foo, 0); |
| 1292 | 398 unbind_to (depth); |
| 428 | 399 return Qnil; |
| 400 } | |
| 401 | |
| 1292 | 402 DEFUN ("stop-profiling", Fstop_profiling, 0, 0, "", /* |
| 428 | 403 Stop profiling. |
| 404 */ | |
| 405 ()) | |
| 406 { | |
| 407 /* This function does not GC */ | |
| 408 struct itimerval foo; | |
| 409 | |
| 1292 | 410 if (!profiling_active) |
| 411 return Qnil; | |
| 412 in_profiling++; | |
| 428 | 413 foo.it_value.tv_sec = 0; |
| 414 foo.it_value.tv_usec = 0; | |
| 415 foo.it_interval = foo.it_value; | |
| 611 | 416 qxe_setitimer (ITIMER_PROF, &foo, 0); |
| 428 | 417 profiling_active = 0; |
| 1292 | 418 { |
| 419 struct backtrace *bt = backtrace_list; | |
| 420 | |
| 421 for (; bt; bt = bt->next) | |
| 422 profile_reap_backtrace (bt); | |
| 423 } | |
| 613 | 424 set_timeout_signal (SIGPROF, fatal_error_signal); |
| 1292 | 425 in_profiling--; |
| 428 | 426 return Qnil; |
| 427 } | |
| 428 | |
| 1123 | 429 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, "", /* |
| 430 Clear out the recorded profiling info. | |
| 431 This clears both the internal timing information and the call counts in | |
| 432 `call-count-profile-table'. | |
| 433 */ | |
| 434 ()) | |
| 435 { | |
| 1292 | 436 in_profiling++; |
| 1123 | 437 /* This function does not GC */ |
| 438 if (big_profile_table) | |
| 439 { | |
| 1292 | 440 profiling_lock = 1; |
| 1123 | 441 clrhash (big_profile_table); |
| 1292 | 442 profiling_lock = 0; |
| 1123 | 443 } |
| 1292 | 444 if (!NILP (Vtotal_timing_profile_table)) |
| 445 Fclrhash (Vtotal_timing_profile_table); | |
| 1123 | 446 if (!NILP (Vcall_count_profile_table)) |
| 447 Fclrhash (Vcall_count_profile_table); | |
| 1292 | 448 if (!NILP (Vgc_usage_profile_table)) |
| 449 Fclrhash (Vgc_usage_profile_table); | |
| 450 if (!NILP (Vtotal_gc_usage_profile_table)) | |
| 451 Fclrhash (Vtotal_gc_usage_profile_table); | |
| 452 in_profiling--; | |
| 453 | |
| 1123 | 454 return Qnil; |
| 455 } | |
| 456 | |
| 428 | 457 struct get_profiling_info_closure |
| 458 { | |
| 1123 | 459 Lisp_Object timing; |
| 428 | 460 }; |
| 461 | |
| 462 static int | |
| 1123 | 463 get_profiling_info_timing_maphash (const void *void_key, |
| 464 void *void_val, | |
| 465 void *void_closure) | |
| 428 | 466 { |
| 467 /* This function does not GC */ | |
| 468 Lisp_Object key; | |
| 469 struct get_profiling_info_closure *closure | |
| 470 = (struct get_profiling_info_closure *) void_closure; | |
| 471 EMACS_INT val; | |
| 472 | |
| 5013 | 473 key = GET_LISP_FROM_VOID (void_key); |
| 428 | 474 val = (EMACS_INT) void_val; |
| 475 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
476 Fputhash (key, make_fixnum (val), closure->timing); |
| 428 | 477 return 0; |
| 478 } | |
| 479 | |
| 1292 | 480 static Lisp_Object |
| 481 copy_hash_table_or_blank (Lisp_Object table) | |
| 482 { | |
| 483 return !NILP (table) ? Fcopy_hash_table (table) : | |
| 484 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
485 Qeq); |
| 1292 | 486 } |
| 487 | |
| 428 | 488 DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /* |
| 1123 | 489 Return the currently recorded profiling info. |
| 490 The format is a plist of symbols describing type of info recorded and | |
| 491 an associated type-specific entry. Currently, the following info types | |
| 492 are recorded | |
| 493 | |
| 494 `timing' | |
| 1292 | 495 A hash table of function descriptions (funcallable objects or strings |
| 496 describing internal processing operations -- redisplay, garbage | |
| 497 collection, etc.), along with associated tick counts (the frequency of | |
| 498 ticks is controlled by `default-profiling-interval' or the argument to | |
| 499 `start-profiling'). | |
| 500 | |
| 501 `total-timing' | |
| 502 A hash table of function descriptions and associated timing count for | |
| 503 the function and all descendants. | |
| 1123 | 504 |
| 505 `call-count' | |
| 1292 | 506 A hash table of function descriptions and associated call counts. |
| 507 | |
| 508 `gc-usage' | |
| 509 A hash table of function descriptions and associated amount of consing. | |
| 510 | |
| 511 `total-gc-usage' | |
| 512 A hash table of function descriptions and associated amount of consing | |
| 513 in the function and all descendants. | |
| 428 | 514 */ |
| 515 ()) | |
| 516 { | |
| 517 /* This function does not GC */ | |
| 518 struct get_profiling_info_closure closure; | |
| 1292 | 519 Lisp_Object retv; |
| 520 int depth = internal_bind_int (&in_profiling, 1 + in_profiling); | |
| 521 const void *overhead; | |
| 428 | 522 |
| 1123 | 523 closure.timing = |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
524 make_lisp_hash_table (100, HASH_TABLE_NON_WEAK, Qequal); |
| 1123 | 525 |
| 428 | 526 if (big_profile_table) |
| 527 { | |
| 1292 | 528 int count = internal_bind_int ((int *) &profiling_lock, 1); |
| 1123 | 529 maphash (get_profiling_info_timing_maphash, big_profile_table, &closure); |
| 1292 | 530 |
| 531 /* OK, OK ... the total-timing table is not going to have an entry | |
| 532 for profile overhead, and it looks strange for it to come out 0, | |
| 533 so make sure it looks reasonable. */ | |
| 5013 | 534 if (!gethash (STORE_LISP_IN_VOID (QSprofile_overhead), big_profile_table, |
| 1292 | 535 &overhead)) |
| 536 overhead = 0; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
537 Fputhash (QSprofile_overhead, make_fixnum ((EMACS_INT) overhead), |
| 1292 | 538 Vtotal_timing_profile_table); |
| 539 | |
| 771 | 540 unbind_to (count); |
| 428 | 541 } |
| 1123 | 542 |
|
5345
db326b8fe982
Use Ben's recently-introduced listu (), where appropriate.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
543 retv = listu (Qtiming, closure.timing, |
|
db326b8fe982
Use Ben's recently-introduced listu (), where appropriate.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
544 Qtotal_timing, |
|
db326b8fe982
Use Ben's recently-introduced listu (), where appropriate.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
545 copy_hash_table_or_blank (Vtotal_timing_profile_table), |
|
db326b8fe982
Use Ben's recently-introduced listu (), where appropriate.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
546 Qcall_count, |
|
db326b8fe982
Use Ben's recently-introduced listu (), where appropriate.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
547 copy_hash_table_or_blank (Vcall_count_profile_table), |
|
db326b8fe982
Use Ben's recently-introduced listu (), where appropriate.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
548 Qgc_usage, |
|
db326b8fe982
Use Ben's recently-introduced listu (), where appropriate.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
549 copy_hash_table_or_blank (Vgc_usage_profile_table), |
|
db326b8fe982
Use Ben's recently-introduced listu (), where appropriate.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
550 Qtotal_gc_usage, |
|
db326b8fe982
Use Ben's recently-introduced listu (), where appropriate.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
551 copy_hash_table_or_blank (Vtotal_gc_usage_profile_table), |
|
db326b8fe982
Use Ben's recently-introduced listu (), where appropriate.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
552 Qunbound); |
| 1292 | 553 unbind_to (depth); |
| 554 return retv; | |
| 1123 | 555 } |
| 556 | |
| 557 static int | |
| 558 set_profiling_info_timing_maphash (Lisp_Object key, | |
| 559 Lisp_Object val, | |
| 2286 | 560 void *UNUSED (void_closure)) |
| 1123 | 561 { |
| 562 /* This function does not GC */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
563 if (!FIXNUMP (val)) |
| 1123 | 564 invalid_argument_2 |
| 565 ("Function timing count is not an integer in given entry", | |
| 566 key, val); | |
| 567 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5470
diff
changeset
|
568 puthash (STORE_LISP_IN_VOID (key), (void *) XFIXNUM (val), big_profile_table); |
| 1123 | 569 |
| 570 return 0; | |
| 571 } | |
| 572 | |
| 573 DEFUN ("set-profiling-info", Fset_profiling_info, 1, 1, 0, /* | |
| 574 Set the currently recorded profiling info. | |
| 575 INFO should be in the same format returned by `get-profiling-info', | |
| 576 as described there. | |
| 577 */ | |
| 578 (info)) | |
| 579 { | |
| 1292 | 580 int depth; |
| 1123 | 581 /* This function does not GC */ |
| 582 Fclear_profiling_info (); | |
| 583 | |
| 1292 | 584 depth = internal_bind_int (&in_profiling, 1 + in_profiling); |
| 1123 | 585 { |
| 586 EXTERNAL_PROPERTY_LIST_LOOP_3 (key, value, info) | |
| 587 { | |
| 588 if (EQ (key, Qtiming)) | |
| 589 { | |
| 590 CHECK_HASH_TABLE (value); | |
| 591 create_timing_profile_table (); | |
| 1292 | 592 profiling_lock = 1; |
| 1123 | 593 elisp_maphash_unsafe (set_profiling_info_timing_maphash, value, |
| 594 NULL); | |
| 1292 | 595 profiling_lock = 0; |
| 1123 | 596 } |
| 597 else if (EQ (key, Qcall_count)) | |
| 1292 | 598 Vcall_count_profile_table = Fcopy_hash_table (value); |
| 599 else if (EQ (key, Qtotal_timing)) | |
| 600 Vtotal_timing_profile_table = Fcopy_hash_table (value); | |
| 601 else if (EQ (key, Qgc_usage)) | |
| 602 Vgc_usage_profile_table = Fcopy_hash_table (value); | |
| 603 else if (EQ (key, Qtotal_gc_usage)) | |
| 604 Vtotal_gc_usage_profile_table = Fcopy_hash_table (value); | |
| 1123 | 605 else |
| 606 invalid_constant ("Unrecognized profiling-info keyword", key); | |
| 607 } | |
| 608 } | |
| 609 | |
| 1292 | 610 unbind_to (depth); |
| 1123 | 611 return Qnil; |
| 428 | 612 } |
| 613 | |
| 614 static int | |
| 442 | 615 mark_profiling_info_maphash (const void *void_key, |
| 2286 | 616 void *UNUSED (void_val), |
| 617 void *UNUSED (void_closure)) | |
| 428 | 618 { |
| 1598 | 619 #ifdef USE_KKCC |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5038
diff
changeset
|
620 kkcc_gc_stack_push_lisp_object_0 (GET_LISP_FROM_VOID (void_key)); |
| 1598 | 621 #else /* NOT USE_KKCC */ |
| 5013 | 622 mark_object (GET_LISP_FROM_VOID (void_key)); |
| 1598 | 623 #endif /* NOT USE_KKCC */ |
| 428 | 624 return 0; |
| 625 } | |
| 626 | |
| 627 void | |
| 628 mark_profiling_info (void) | |
| 629 { | |
| 630 /* This function does not GC */ | |
| 631 if (big_profile_table) | |
| 632 { | |
| 1292 | 633 profiling_lock = 1; |
| 428 | 634 maphash (mark_profiling_info_maphash, big_profile_table, 0); |
| 1292 | 635 profiling_lock = 0; |
| 428 | 636 } |
| 637 } | |
| 638 | |
| 639 DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /* | |
| 640 Return non-nil if profiling information is currently being recorded. | |
| 641 */ | |
| 642 ()) | |
| 643 { | |
| 644 return profiling_active ? Qt : Qnil; | |
| 645 } | |
| 646 | |
| 647 void | |
| 648 syms_of_profile (void) | |
| 649 { | |
| 650 DEFSUBR (Fstart_profiling); | |
| 651 DEFSUBR (Fstop_profiling); | |
| 652 DEFSUBR (Fget_profiling_info); | |
| 1123 | 653 DEFSUBR (Fset_profiling_info); |
| 428 | 654 DEFSUBR (Fclear_profiling_info); |
| 655 DEFSUBR (Fprofiling_active_p); | |
| 656 } | |
| 657 | |
| 658 void | |
| 659 vars_of_profile (void) | |
| 660 { | |
| 661 DEFVAR_INT ("default-profiling-interval", &default_profiling_interval /* | |
| 662 Default CPU time in microseconds between profiling sampling. | |
| 663 Used when the argument to `start-profiling' is nil or omitted. | |
| 1346 | 664 Under Unix, the time in question is CPU time (when the program is executing |
| 665 or the kernel is executing on behalf of the program) and not real time. | |
| 666 Under MS Windows and Cygwin, the time is real time, but time spent blocking | |
| 667 while waiting for an event is ignored, to get more accurate results. | |
| 668 Note that there is usually a machine-dependent limit on how small this | |
| 669 value can be. | |
| 428 | 670 */ ); |
| 671 default_profiling_interval = 1000; | |
| 672 | |
| 1123 | 673 staticpro (&Vcall_count_profile_table); |
| 428 | 674 Vcall_count_profile_table = Qnil; |
| 675 | |
| 1292 | 676 staticpro (&Vgc_usage_profile_table); |
| 677 Vgc_usage_profile_table = Qnil; | |
| 678 | |
| 679 staticpro (&Vtotal_gc_usage_profile_table); | |
| 680 Vtotal_gc_usage_profile_table = Qnil; | |
| 681 | |
| 682 staticpro (&Vtotal_timing_profile_table); | |
| 683 Vtotal_timing_profile_table = Qnil; | |
| 428 | 684 |
| 1292 | 685 #if 0 |
| 686 /* #### This is supposed to be for KKCC but KKCC doesn't use this stuff | |
| 687 currently. */ | |
| 2367 | 688 dump_add_root_block_ptr (&big_profile_table, &plain_hash_table_description); |
| 1292 | 689 #endif /* 0 */ |
| 690 | |
| 691 profiling_lock = 0; | |
| 692 | |
| 2514 | 693 #ifdef DEBUG_XEMACS |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2645
diff
changeset
|
694 QSin_temp_spot_1 = build_defer_string ("(in temp spot 1)"); |
| 2514 | 695 staticpro (&QSin_temp_spot_1); |
| 696 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2645
diff
changeset
|
697 QSin_temp_spot_2 = build_defer_string ("(in temp spot 2)"); |
| 2514 | 698 staticpro (&QSin_temp_spot_2); |
| 699 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2645
diff
changeset
|
700 QSin_temp_spot_3 = build_defer_string ("(in temp spot 3)"); |
| 2514 | 701 staticpro (&QSin_temp_spot_3); |
| 702 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2645
diff
changeset
|
703 QSin_temp_spot_4 = build_defer_string ("(in temp spot 4)"); |
| 2514 | 704 staticpro (&QSin_temp_spot_4); |
| 705 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2645
diff
changeset
|
706 QSin_temp_spot_5 = build_defer_string ("(in temp spot 5)"); |
| 2514 | 707 staticpro (&QSin_temp_spot_5); |
| 708 #endif /* DEBUG_XEMACS */ | |
| 709 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2645
diff
changeset
|
710 QSunknown = build_defer_string ("(unknown)"); |
| 428 | 711 staticpro (&QSunknown); |
| 712 QSprocessing_events_at_top_level = | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2645
diff
changeset
|
713 build_defer_string ("(processing events at top level)"); |
| 428 | 714 staticpro (&QSprocessing_events_at_top_level); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
2645
diff
changeset
|
715 QSprofile_overhead = build_defer_string ("(profile overhead)"); |
| 1292 | 716 staticpro (&QSprofile_overhead); |
| 1123 | 717 |
| 718 DEFSYMBOL (Qtiming); | |
| 1292 | 719 DEFSYMBOL (Qtotal_timing); |
| 1123 | 720 DEFSYMBOL (Qcall_count); |
| 1292 | 721 DEFSYMBOL (Qgc_usage); |
| 722 DEFSYMBOL (Qtotal_gc_usage); | |
| 428 | 723 } |