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