Mercurial > hg > xemacs-beta

comparison src/profile.c @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents 74fd4e045ea6
children 11054d720c21
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
55 independent of the SIGPROF-driven one. It uses the Lisp allocation 55 independent of the SIGPROF-driven one. It uses the Lisp allocation
56 mechanism normally, since it is not called from a handler. It may 56 mechanism normally, since it is not called from a handler. It may
57 even be useful to provide a way to turn on only one profiling 57 even be useful to provide a way to turn on only one profiling
58 mechanism, but I haven't done so yet. --hniksic */ 58 mechanism, but I haven't done so yet. --hniksic */
59 59
60 static struct hash_table *big_profile_table; 60 struct hash_table *big_profile_table;
61 Lisp_Object Vcall_count_profile_table; 61 Lisp_Object Vcall_count_profile_table;
62 62
63 int default_profiling_interval; 63 int default_profiling_interval;
64 64
65 int profiling_active; 65 int profiling_active;
66 66
67 /* The normal flag in_display is used as a critical-section flag 67 /* The normal flag in_display is used as a critical-section flag
68 and is not set the whole time we're in redisplay. */ 68 and is not set the whole time we're in redisplay. */
69 int profiling_redisplay_flag; 69 int profiling_redisplay_flag;
70 70
71 static Lisp_Object QSin_redisplay; 71 Lisp_Object QSin_redisplay;
72 static Lisp_Object QSin_garbage_collection; 72 Lisp_Object QSin_garbage_collection;
73 static Lisp_Object QSprocessing_events_at_top_level; 73 Lisp_Object QSprocessing_events_at_top_level;
74 static Lisp_Object QSunknown; 74 Lisp_Object QSunknown;
75 75
76 /* We use inside_profiling to prevent the handler from writing to 76 /* We use inside_profiling to prevent the handler from writing to
77 the table while another routine is operating on it. We also set 77 the table while another routine is operating on it. We also set
78 inside_profiling in case the timeout between signal calls is short 78 inside_profiling in case the timeout between signal calls is short
79 enough to catch us while we're already in there. */ 79 enough to catch us while we're already in there. */
117 fun = QSin_garbage_collection; 117 fun = QSin_garbage_collection;
118 else if (backtrace_list) 118 else if (backtrace_list)
119 { 119 {
120 fun = *backtrace_list->function; 120 fun = *backtrace_list->function;
121 121
122 if (!SYMBOLP (fun) 122 if (!GC_SYMBOLP (fun) &&
123 && !COMPILED_FUNCTIONP (fun) 123 !GC_COMPILED_FUNCTIONP (fun) &&
124 && !SUBRP (fun) 124 !GC_SUBRP (fun))
125 && !CONSP (fun))
126 fun = QSunknown; 125 fun = QSunknown;
127 } 126 }
128 else 127 else
129 fun = QSprocessing_events_at_top_level; 128 fun = QSprocessing_events_at_top_level;
130 129
133 Allocating memory in a signal handler is BAD BAD BAD. 132 Allocating memory in a signal handler is BAD BAD BAD.
134 If you are using the non-mmap rel-alloc code, you might 133 If you are using the non-mmap rel-alloc code, you might
135 lose because of this. Even worse, if the memory allocation 134 lose because of this. Even worse, if the memory allocation
136 fails, the `error' generated whacks everything hard. */ 135 fails, the `error' generated whacks everything hard. */
137 long count; 136 long count;
138 const void *vval; 137 CONST void *vval;
139 138
140 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval)) 139 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval))
141 count = (long) vval; 140 count = (long) vval;
142 else 141 else
143 count = 0; 142 count = 0;
144 count++; 143 count++;
145 vval = (const void *) count; 144 vval = (CONST void *) count;
146 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table); 145 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table);
147 } 146 }
148 147
149 inside_profiling = 0; 148 inside_profiling = 0;
150 } 149 }
224 { 223 {
225 Lisp_Object accum; 224 Lisp_Object accum;
226 }; 225 };
227 226
228 static int 227 static int
229 get_profiling_info_maphash (const void *void_key, 228 get_profiling_info_maphash (CONST void *void_key,
230 void *void_val, 229 void *void_val,
231 void *void_closure) 230 void *void_closure)
232 { 231 {
233 /* This function does not GC */ 232 /* This function does not GC */
234 Lisp_Object key; 233 Lisp_Object key;
261 unbind_to (count, Qnil); 260 unbind_to (count, Qnil);
262 } 261 }
263 return closure.accum; 262 return closure.accum;
264 } 263 }
265 264
265 struct mark_profiling_info_closure
266 {
267 void (*markfun) (Lisp_Object);
268 };
269
266 static int 270 static int
267 mark_profiling_info_maphash (const void *void_key, 271 mark_profiling_info_maphash (CONST void *void_key,
268 void *void_val, 272 void *void_val,
269 void *void_closure) 273 void *void_closure)
270 { 274 {
271 Lisp_Object key; 275 Lisp_Object key;
272 276
273 CVOID_TO_LISP (key, void_key); 277 CVOID_TO_LISP (key, void_key);
274 mark_object (key); 278 (((struct mark_profiling_info_closure *) void_closure)->markfun) (key);
275 return 0; 279 return 0;
276 } 280 }
277 281
278 void 282 void
279 mark_profiling_info (void) 283 mark_profiling_info (void (*markfun) (Lisp_Object))
280 { 284 {
281 /* This function does not GC */ 285 /* This function does not GC (if markfun doesn't) */
286 struct mark_profiling_info_closure closure;
287
288 closure.markfun = markfun;
282 if (big_profile_table) 289 if (big_profile_table)
283 { 290 {
284 inside_profiling = 1; 291 inside_profiling = 1;
285 maphash (mark_profiling_info_maphash, big_profile_table, 0); 292 maphash (mark_profiling_info_maphash, big_profile_table, &closure);
286 inside_profiling = 0; 293 inside_profiling = 0;
287 } 294 }
288 } 295 }
289 296
290 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, "", /* 297 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, "", /*