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