Mercurial > hg > xemacs-beta

comparison src/profile.c @ 398:74fd4e045ea6 r21-2-29

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children 697ef44129c6
comparison
equal deleted inserted replaced
397:f4aeb21a5bad 398:74fd4e045ea6
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 struct hash_table *big_profile_table; 60 static 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 Lisp_Object QSin_redisplay; 71 static Lisp_Object QSin_redisplay;
72 Lisp_Object QSin_garbage_collection; 72 static Lisp_Object QSin_garbage_collection;
73 Lisp_Object QSprocessing_events_at_top_level; 73 static Lisp_Object QSprocessing_events_at_top_level;
74 Lisp_Object QSunknown; 74 static 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 (!GC_SYMBOLP (fun) && 122 if (!SYMBOLP (fun)
123 !GC_COMPILED_FUNCTIONP (fun) && 123 && !COMPILED_FUNCTIONP (fun)
124 !GC_SUBRP (fun)) 124 && !SUBRP (fun)
125 && !CONSP (fun))
125 fun = QSunknown; 126 fun = QSunknown;
126 } 127 }
127 else 128 else
128 fun = QSprocessing_events_at_top_level; 129 fun = QSprocessing_events_at_top_level;
129 130
132 Allocating memory in a signal handler is BAD BAD BAD. 133 Allocating memory in a signal handler is BAD BAD BAD.
133 If you are using the non-mmap rel-alloc code, you might 134 If you are using the non-mmap rel-alloc code, you might
134 lose because of this. Even worse, if the memory allocation 135 lose because of this. Even worse, if the memory allocation
135 fails, the `error' generated whacks everything hard. */ 136 fails, the `error' generated whacks everything hard. */
136 long count; 137 long count;
137 CONST void *vval; 138 const void *vval;
138 139
139 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval)) 140 if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval))
140 count = (long) vval; 141 count = (long) vval;
141 else 142 else
142 count = 0; 143 count = 0;
143 count++; 144 count++;
144 vval = (CONST void *) count; 145 vval = (const void *) count;
145 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table); 146 puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table);
146 } 147 }
147 148
148 inside_profiling = 0; 149 inside_profiling = 0;
149 } 150 }
223 { 224 {
224 Lisp_Object accum; 225 Lisp_Object accum;
225 }; 226 };
226 227
227 static int 228 static int
228 get_profiling_info_maphash (CONST void *void_key, 229 get_profiling_info_maphash (const void *void_key,
229 void *void_val, 230 void *void_val,
230 void *void_closure) 231 void *void_closure)
231 { 232 {
232 /* This function does not GC */ 233 /* This function does not GC */
233 Lisp_Object key; 234 Lisp_Object key;
260 unbind_to (count, Qnil); 261 unbind_to (count, Qnil);
261 } 262 }
262 return closure.accum; 263 return closure.accum;
263 } 264 }
264 265
265 struct mark_profiling_info_closure
266 {
267 void (*markfun) (Lisp_Object);
268 };
269
270 static int 266 static int
271 mark_profiling_info_maphash (CONST void *void_key, 267 mark_profiling_info_maphash (const void *void_key,
272 void *void_val, 268 void *void_val,
273 void *void_closure) 269 void *void_closure)
274 { 270 {
275 Lisp_Object key; 271 Lisp_Object key;
276 272
277 CVOID_TO_LISP (key, void_key); 273 CVOID_TO_LISP (key, void_key);
278 (((struct mark_profiling_info_closure *) void_closure)->markfun) (key); 274 mark_object (key);
279 return 0; 275 return 0;
280 } 276 }
281 277
282 void 278 void
283 mark_profiling_info (void (*markfun) (Lisp_Object)) 279 mark_profiling_info (void)
284 { 280 {
285 /* This function does not GC (if markfun doesn't) */ 281 /* This function does not GC */
286 struct mark_profiling_info_closure closure;
287
288 closure.markfun = markfun;
289 if (big_profile_table) 282 if (big_profile_table)
290 { 283 {
291 inside_profiling = 1; 284 inside_profiling = 1;
292 maphash (mark_profiling_info_maphash, big_profile_table, &closure); 285 maphash (mark_profiling_info_maphash, big_profile_table, 0);
293 inside_profiling = 0; 286 inside_profiling = 0;
294 } 287 }
295 } 288 }
296 289
297 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, "", /* 290 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, "", /*