Mercurial > hg > xemacs-beta

comparison src/profile.c @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents c0965ff3b039
children 9f59509498e1
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
61 Lisp_Object QSin_redisplay; 61 Lisp_Object QSin_redisplay;
62 Lisp_Object QSin_garbage_collection; 62 Lisp_Object QSin_garbage_collection;
63 Lisp_Object QSprocessing_events_at_top_level; 63 Lisp_Object QSprocessing_events_at_top_level;
64 Lisp_Object QSunknown; 64 Lisp_Object QSunknown;
65 65
66 /* We use inside_profiling to prevent the handler from writing to
67 the table while another routine is operating on it. We also set
68 inside_profiling in case the timeout between signal calls is short
69 enough to catch us while we're already in there. */
70 static volatile int inside_profiling;
71
72 static SIGTYPE 66 static SIGTYPE
73 sigprof_handler (int signo) 67 sigprof_handler (int signo)
74 { 68 {
75 /* Don't do anything if we are shutting down, or are doing a maphash 69 Lisp_Object fun;
76 or clrhash on the table. */ 70
77 if (!inside_profiling && !preparing_for_armageddon) 71 if (profiling_redisplay_flag)
72 fun = QSin_redisplay;
73 else if (gc_in_progress)
74 fun = QSin_garbage_collection;
75 else if (backtrace_list)
78 { 76 {
79 Lisp_Object fun; 77 fun = *backtrace_list->function;
80 78
81 /* If something below causes an error to be signaled, we'll 79 XUNMARK (fun);
82 not correctly reset this flag. But we'll be in worse shape 80 if (!GC_SYMBOLP (fun) && !GC_COMPILED_FUNCTIONP (fun))
83 than that anyways, since we'll longjmp back to the last 81 fun = QSunknown;
84 condition case. */ 82 }
85 inside_profiling = 1; 83 else
86 84 fun = QSprocessing_events_at_top_level;
87 if (profiling_redisplay_flag) 85
88 fun = QSin_redisplay; 86 {
89 else if (gc_in_progress) 87 long count;
90 fun = QSin_garbage_collection; 88 CONST void *vval;
91 else if (backtrace_list)
92 {
93 fun = *backtrace_list->function;
94
95 /* #### dmoore - why do we need to unmark it, we aren't in GC. */
96 XUNMARK (fun);
97 if (!GC_SYMBOLP (fun) && !GC_COMPILED_FUNCTIONP (fun))
98 fun = QSunknown;
99 }
100 else
101 fun = QSprocessing_events_at_top_level;
102
103 {
104 /* #### see comment about memory allocation in start-profiling.
105 Allocating memory in a signal handler is BAD BAD BAD.
106 If you are using the non-mmap rel-alloc code, you might
107 lose because of this. Even worse, if the memory allocation
108 fails, the `error' generated whacks everything hard. */
109 long count;
110 CONST void *vval;
111 89
112 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval)) 90 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval))
113 count = (long) vval; 91 count = (long) vval;
114 else 92 else
115 count = 0; 93 count = 0;
116 count++; 94 count++;
117 vval = (CONST void *) count; 95 vval = (CONST void *) count;
118 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table); 96 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table);
119 } 97 }
120
121 inside_profiling = 0;
122 }
123 } 98 }
124 99
125 DEFUN ("start-profiling", Fstart_profiling, 0, 1, 0, /* 100 DEFUN ("start-profiling", Fstart_profiling, 0, 1, 0, /*
126 Start profiling, with profile queries every MICROSECS. 101 Start profiling, with profile queries every MICROSECS.
127 If MICROSECS is nil or omitted, the value of `default-profiling-interval' 102 If MICROSECS is nil or omitted, the value of `default-profiling-interval'
133 info. Thus you can start and stop as many times as you want and everything 108 info. Thus you can start and stop as many times as you want and everything
134 will be properly accumulated. 109 will be properly accumulated.
135 */ 110 */
136 (microsecs)) 111 (microsecs))
137 { 112 {
138 /* This function can GC */
139 int msecs; 113 int msecs;
140 struct itimerval foo; 114 struct itimerval foo;
141 115
142 /* #### The hash code can safely be called from a signal handler 116 /* #### The hash code can safely be called from a signal handler
143 except when it has to grow the hashtable. In this case, it calls 117 except when it has to grow the hashtable. In this case, it calls
160 foo.it_value.tv_sec = 0; 134 foo.it_value.tv_sec = 0;
161 foo.it_value.tv_usec = msecs; 135 foo.it_value.tv_usec = msecs;
162 EMACS_NORMALIZE_TIME (foo.it_value); 136 EMACS_NORMALIZE_TIME (foo.it_value);
163 foo.it_interval = foo.it_value; 137 foo.it_interval = foo.it_value;
164 profiling_active = 1; 138 profiling_active = 1;
165 inside_profiling = 0;
166 setitimer (ITIMER_PROF, &foo, 0); 139 setitimer (ITIMER_PROF, &foo, 0);
167 return Qnil; 140 return Qnil;
168 } 141 }
169 142
170 DEFUN ("stop-profiling", Fstop_profiling, 0, 0, 0, /* 143 DEFUN ("stop-profiling", Fstop_profiling, 0, 0, 0, /*
171 Stop profiling. 144 Stop profiling.
172 */ 145 */
173 ()) 146 ())
174 { 147 {
175 /* This function does not GC */
176 struct itimerval foo; 148 struct itimerval foo;
177 149
178 foo.it_value.tv_sec = 0; 150 foo.it_value.tv_sec = 0;
179 foo.it_value.tv_usec = 0; 151 foo.it_value.tv_usec = 0;
180 foo.it_interval = foo.it_value; 152 foo.it_interval = foo.it_value;
182 profiling_active = 0; 154 profiling_active = 0;
183 signal (SIGPROF, fatal_error_signal); 155 signal (SIGPROF, fatal_error_signal);
184 return Qnil; 156 return Qnil;
185 } 157 }
186 158
187 static Lisp_Object
188 profile_lock_unwind (Lisp_Object ignore)
189 {
190 inside_profiling = 0;
191 return Qnil;
192 }
193
194 struct get_profiling_info_closure 159 struct get_profiling_info_closure
195 { 160 {
196 Lisp_Object accum; 161 Lisp_Object accum;
197 }; 162 };
198 163
199 static void 164 static void
200 get_profiling_info_maphash (CONST void *void_key, 165 get_profiling_info_maphash (CONST void *void_key,
201 void *void_val, 166 void *void_val,
202 void *void_closure) 167 void *void_closure)
203 { 168 {
204 /* This function does not GC */ 169 /* This function can GC */
205 Lisp_Object key; 170 Lisp_Object key;
206 struct get_profiling_info_closure *closure = void_closure; 171 struct get_profiling_info_closure *closure = void_closure;
207 EMACS_INT val; 172 EMACS_INT val;
208 173
209 CVOID_TO_LISP (key, void_key); 174 CVOID_TO_LISP (key, void_key);
216 DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /* 181 DEFUN ("get-profiling-info", Fget_profiling_info, 0, 0, 0, /*
217 Return the profiling info as an alist. 182 Return the profiling info as an alist.
218 */ 183 */
219 ()) 184 ())
220 { 185 {
221 /* This function does not GC */
222 struct get_profiling_info_closure closure; 186 struct get_profiling_info_closure closure;
223 187
224 closure.accum = Qnil; 188 closure.accum = Qnil;
225 if (big_profile_table) 189 if (big_profile_table)
226 { 190 maphash (get_profiling_info_maphash, big_profile_table, &closure);
227 int count = specpdl_depth ();
228 record_unwind_protect (profile_lock_unwind, Qnil);
229 inside_profiling = 1;
230 maphash (get_profiling_info_maphash, big_profile_table, &closure);
231 unbind_to (count, Qnil);
232 }
233 return closure.accum; 191 return closure.accum;
234 } 192 }
235 193
236 struct mark_profiling_info_closure 194 struct mark_profiling_info_closure
237 { 195 {
241 static void 199 static void
242 mark_profiling_info_maphash (CONST void *void_key, 200 mark_profiling_info_maphash (CONST void *void_key,
243 void *void_val, 201 void *void_val,
244 void *void_closure) 202 void *void_closure)
245 { 203 {
204 /* This function can GC */
246 Lisp_Object key; 205 Lisp_Object key;
247 struct mark_profiling_info_closure *closure = void_closure; 206 struct mark_profiling_info_closure *closure = void_closure;
248 207
249 CVOID_TO_LISP (key, void_key); 208 CVOID_TO_LISP (key, void_key);
250 (closure->markfun) (key); 209 (closure->markfun) (key);
251 } 210 }
252 211
253 void 212 void
254 mark_profiling_info (void (*markfun) (Lisp_Object)) 213 mark_profiling_info (void (*markfun) (Lisp_Object))
255 { 214 {
256 /* This function does not GC (if markfun doesn't) */
257 struct mark_profiling_info_closure closure; 215 struct mark_profiling_info_closure closure;
258 216
259 closure.markfun = markfun; 217 closure.markfun = markfun;
260 if (big_profile_table) 218 if (big_profile_table)
261 { 219 maphash (mark_profiling_info_maphash, big_profile_table, &closure);
262 inside_profiling = 1;
263 maphash (mark_profiling_info_maphash, big_profile_table, &closure);
264 inside_profiling = 0;
265 }
266 } 220 }
267 221
268 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, 0, /* 222 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, 0, /*
269 Clear out the recorded profiling info. 223 Clear out the recorded profiling info.
270 */ 224 */
271 ()) 225 ())
272 { 226 {
273 /* This function does not GC */
274 if (big_profile_table) 227 if (big_profile_table)
275 { 228 clrhash (big_profile_table);
276 inside_profiling = 1;
277 clrhash (big_profile_table);
278 inside_profiling = 0;
279 }
280 return Qnil; 229 return Qnil;
281 } 230 }
282 231
283 DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /* 232 DEFUN ("profiling-active-p", Fprofiling_active_p, 0, 0, 0, /*
284 Return non-nil if profiling information is currently being recorded. 233 Return non-nil if profiling information is currently being recorded.
306 Used when the argument to `start-profiling' is nil or omitted. 255 Used when the argument to `start-profiling' is nil or omitted.
307 Note that the time in question is CPU time (when the program is executing 256 Note that the time in question is CPU time (when the program is executing
308 or the kernel is executing on behalf of the program) and not real time. 257 or the kernel is executing on behalf of the program) and not real time.
309 */ ); 258 */ );
310 default_profiling_interval = 1000; 259 default_profiling_interval = 1000;
311
312 inside_profiling = 0;
313 260
314 QSin_redisplay = build_string ("(in redisplay)"); 261 QSin_redisplay = build_string ("(in redisplay)");
315 staticpro (&QSin_redisplay); 262 staticpro (&QSin_redisplay);
316 QSin_garbage_collection = build_string ("(in garbage collection)"); 263 QSin_garbage_collection = build_string ("(in garbage collection)");
317 staticpro (&QSin_garbage_collection); 264 staticpro (&QSin_garbage_collection);