Mercurial > hg > xemacs-beta

comparison src/profile.c @ 44:8d2a9b52c682 r19-15prefinal

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