comparison src/profile.c @ 241:f955c73f5258 r20-5b19

Import from CVS: tag r20-5b19
author cvs
date Mon, 13 Aug 2007 10:16:16 +0200
parents e45d5e7c476e
children 8626e4521993
comparison
equal deleted inserted replaced
240:835e739f3c17 241:f955c73f5258
1 /* Why the hell is XEmacs so fucking slow? 1 /* Why the hell is XEmacs so fucking slow?
2 Copyright (C) 1996 Ben Wing. 2 Copyright (C) 1996 Ben Wing.
3 Copyright (C) 1998 Free Software Foundation, Inc.
3 4
4 This file is part of XEmacs. 5 This file is part of XEmacs.
5 6
6 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
7 under the terms of the GNU General Public License as published by the 8 under the terms of the GNU General Public License as published by the
26 #include "hash.h" 27 #include "hash.h"
27 28
28 #include "syssignal.h" 29 #include "syssignal.h"
29 #include "systime.h" 30 #include "systime.h"
30 31
31 /* 32 /* We implement our own profiling scheme so that we can determine
32 33 things like which Lisp functions are occupying the most time. Any
33 We implement our own profiling scheme so that we can determine things 34 standard OS-provided profiling works on C functions, which is
34 like which Lisp functions are occupying the most time. Any standard 35 somewhat useless.
35 OS-provided profiling works on C functions, which is somewhat useless. 36
36 37 The basic idea is simple. We set a profiling timer using setitimer
37 The basic idea is simple. We set a profiling timer using 38 (ITIMER_PROF), which generates a SIGPROF every so often. (This
38 setitimer (ITIMER_PROF), which generates a SIGPROF every so often. 39 runs not in real time but rather when the process is executing or
39 \(This runs not in real time but rather when the process is executing 40 the system is running on behalf of the process.) When the signal
40 or the system is running on behalf of the process.) When the signal 41 goes off, we see what we're in, and add by 1 the count associated
41 goes off, we see what we're in, and add by 1 the count associated with 42 with that function.
42 that function. 43
43 44 It would be nice to use the Lisp allocation mechanism etc. to keep
44 It would be nice to use the Lisp allocation mechanism etc. to keep 45 track of the profiling information, but we can't because that's not
45 track of the profiling information, but we can't because that's not 46 safe, and trying to make it safe would be much more work than is
46 safe, and trying to make it safe would be much more work than is 47 worth.
47 worth. 48
48 49
49 */ 50 Jan 1998: In addition to this, I have added code to remember call
51 counts of Lisp funcalls. The profile_increase_call_count()
52 function is called from funcall_recording_as(), and serves to add
53 data to Vcall_count_profile_table. This mechanism is much simpler
54 and independent of the SIGPROF-driven one. It uses the Lisp
55 allocation mechanism normally, since it is not called from a
56 handler. It may even be useful to provide a way to turn on only
57 one profiling mechanism, but I haven't done so yet. --hniksic */
50 58
51 c_hashtable big_profile_table; 59 c_hashtable big_profile_table;
60 Lisp_Object Vcall_count_profile_table;
52 61
53 int default_profiling_interval; 62 int default_profiling_interval;
54 63
55 int profiling_active; 64 int profiling_active;
56 65
66 /* We use inside_profiling to prevent the handler from writing to 75 /* We use inside_profiling to prevent the handler from writing to
67 the table while another routine is operating on it. We also set 76 the table while another routine is operating on it. We also set
68 inside_profiling in case the timeout between signal calls is short 77 inside_profiling in case the timeout between signal calls is short
69 enough to catch us while we're already in there. */ 78 enough to catch us while we're already in there. */
70 static volatile int inside_profiling; 79 static volatile int inside_profiling;
80
81 /* Increase the value of OBJ in Vcall_count_profile_table hashtable.
82 If hashtable is nil, create it first. */
83 void
84 profile_increase_call_count (Lisp_Object obj)
85 {
86 Lisp_Object count;
87
88 if (NILP (Vcall_count_profile_table))
89 Vcall_count_profile_table = Fmake_hashtable (make_int (100), Qeq);
90
91 count = Fgethash (obj, Vcall_count_profile_table, Qzero);
92 if (!INTP (count))
93 count = Qzero;
94 Fputhash (obj, make_int (1 + XINT (count)), Vcall_count_profile_table);
95 }
71 96
72 static SIGTYPE 97 static SIGTYPE
73 sigprof_handler (int signo) 98 sigprof_handler (int signo)
74 { 99 {
75 /* Don't do anything if we are shutting down, or are doing a maphash 100 /* Don't do anything if we are shutting down, or are doing a maphash
192 struct get_profiling_info_closure 217 struct get_profiling_info_closure
193 { 218 {
194 Lisp_Object accum; 219 Lisp_Object accum;
195 }; 220 };
196 221
197 static void 222 static int
198 get_profiling_info_maphash (CONST void *void_key, 223 get_profiling_info_maphash (CONST void *void_key,
199 void *void_val, 224 void *void_val,
200 void *void_closure) 225 void *void_closure)
201 { 226 {
202 /* This function does not GC */ 227 /* This function does not GC */
207 232
208 CVOID_TO_LISP (key, void_key); 233 CVOID_TO_LISP (key, void_key);
209 val = (EMACS_INT) void_val; 234 val = (EMACS_INT) void_val;
210 235
211 closure->accum = Fcons (Fcons (key, make_int (val)), closure->accum); 236 closure->accum = Fcons (Fcons (key, make_int (val)), closure->accum);
237 return 0;
212 } 238 }
213 239
214 DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /* 240 DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /*
215 Return the profiling info as an alist. 241 Return the profiling info as an alist.
216 */ 242 */
234 struct mark_profiling_info_closure 260 struct mark_profiling_info_closure
235 { 261 {
236 void (*markfun) (Lisp_Object); 262 void (*markfun) (Lisp_Object);
237 }; 263 };
238 264
239 static void 265 static int
240 mark_profiling_info_maphash (CONST void *void_key, 266 mark_profiling_info_maphash (CONST void *void_key,
241 void *void_val, 267 void *void_val,
242 void *void_closure) 268 void *void_closure)
243 { 269 {
244 Lisp_Object key; 270 Lisp_Object key;
245 271
246 CVOID_TO_LISP (key, void_key); 272 CVOID_TO_LISP (key, void_key);
247 (((struct mark_profiling_info_closure *) void_closure)->markfun) (key); 273 (((struct mark_profiling_info_closure *) void_closure)->markfun) (key);
274 return 0;
248 } 275 }
249 276
250 void 277 void
251 mark_profiling_info (void (*markfun) (Lisp_Object)) 278 mark_profiling_info (void (*markfun) (Lisp_Object))
252 { 279 {
272 { 299 {
273 inside_profiling = 1; 300 inside_profiling = 1;
274 clrhash (big_profile_table); 301 clrhash (big_profile_table);
275 inside_profiling = 0; 302 inside_profiling = 0;
276 } 303 }
304 if (!NILP(Vcall_count_profile_table))
305 Fclrhash (Vcall_count_profile_table);
277 return Qnil; 306 return Qnil;
278 } 307 }
279 308
280 DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /* 309 DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /*
281 Return non-nil if profiling information is currently being recorded. 310 Return non-nil if profiling information is currently being recorded.
303 Used when the argument to `start-profiling' is nil or omitted. 332 Used when the argument to `start-profiling' is nil or omitted.
304 Note that the time in question is CPU time (when the program is executing 333 Note that the time in question is CPU time (when the program is executing
305 or the kernel is executing on behalf of the program) and not real time. 334 or the kernel is executing on behalf of the program) and not real time.
306 */ ); 335 */ );
307 default_profiling_interval = 1000; 336 default_profiling_interval = 1000;
337
338 DEFVAR_LISP ("call-count-profile-table", &Vcall_count_profile_table /*
339 The table where call-count information is stored by the profiling primitives.
340 This is a hashtable whose keys are funcallable objects, and whose
341 values are their call counts (integers).
342 */ );
343 Vcall_count_profile_table = Qnil;
308 344
309 inside_profiling = 0; 345 inside_profiling = 0;
310 346
311 QSin_redisplay = build_string ("(in redisplay)"); 347 QSin_redisplay = build_string ("(in redisplay)");
312 staticpro (&QSin_redisplay); 348 staticpro (&QSin_redisplay);