Mercurial > hg > xemacs-beta
diff src/profile.c @ 116:9f59509498e1 r20-1b10
Import from CVS: tag r20-1b10
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:23:06 +0200 |
parents | 131b0175ea99 |
children | 538048ae2ab8 |
line wrap: on
line diff
--- a/src/profile.c Mon Aug 13 09:21:56 2007 +0200 +++ b/src/profile.c Mon Aug 13 09:23:06 2007 +0200 @@ -63,38 +63,63 @@ Lisp_Object QSprocessing_events_at_top_level; Lisp_Object QSunknown; +/* We use inside_profiling to prevent the handler from writing to + the table while another routine is operating on it. We also set + inside_profiling in case the timeout between signal calls is short + enough to catch us while we're already in there. */ +volatile static int inside_profiling; + static SIGTYPE sigprof_handler (int signo) { - Lisp_Object fun; + /* Don't do anything if we are shutting down, or are doing a maphash + or clrhash on the table. */ + if (!inside_profiling && !preparing_for_armageddon) + { + Lisp_Object fun; + + /* If something below causes an error to be signaled, we'll + not correctly reset this flag. But we'll be in worse shape + than that anyways, since we'll longjmp back to the last + condition case. */ + inside_profiling = 1; + + if (profiling_redisplay_flag) + fun = QSin_redisplay; + else if (gc_in_progress) + fun = QSin_garbage_collection; + else if (backtrace_list) + { + fun = *backtrace_list->function; - if (profiling_redisplay_flag) - fun = QSin_redisplay; - else if (gc_in_progress) - fun = QSin_garbage_collection; - else if (backtrace_list) - { - fun = *backtrace_list->function; + /* #### dmoore - why do we need to unmark it, we aren't in GC. */ + XUNMARK (fun); + if (!GC_SYMBOLP (fun) && !GC_COMPILED_FUNCTIONP (fun)) + fun = QSunknown; + } + else + fun = QSprocessing_events_at_top_level; - XUNMARK (fun); - if (!GC_SYMBOLP (fun) && !GC_COMPILED_FUNCTIONP (fun)) - fun = QSunknown; + { + /* #### see comment about memory allocation in start-profiling. + Allocating memory in a signal handler is BAD BAD BAD. + If you are using the non-mmap rel-alloc code, you might + lose because of this. Even worse, if the memory allocation + fails, the `error' generated whacks everything hard. */ + long count; + CONST void *vval; + + if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval)) + count = (long) vval; + else + count = 0; + count++; + vval = (CONST void *) count; + puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table); + } + + inside_profiling = 0; } - else - fun = QSprocessing_events_at_top_level; - - { - long count; - CONST void *vval; - - if (gethash (LISP_TO_VOID (fun), big_profile_table, &vval)) - count = (long) vval; - else - count = 0; - count++; - vval = (CONST void *) count; - puthash (LISP_TO_VOID (fun), (void *) vval, big_profile_table); - } } DEFUN ("start-profiling", Fstart_profiling, 0, 1, 0, /* @@ -110,6 +135,7 @@ */ (microsecs)) { + /* This function can GC */ int msecs; struct itimerval foo; @@ -136,6 +162,7 @@ EMACS_NORMALIZE_TIME (foo.it_value); foo.it_interval = foo.it_value; profiling_active = 1; + inside_profiling = 0; setitimer (ITIMER_PROF, &foo, 0); return Qnil; } @@ -145,6 +172,7 @@ */ ()) { + /* This function does not GC */ struct itimerval foo; foo.it_value.tv_sec = 0; @@ -156,6 +184,13 @@ return Qnil; } +static Lisp_Object +profile_lock_unwind (Lisp_Object ignore) +{ + inside_profiling = 0; + return Qnil; +} + struct get_profiling_info_closure { Lisp_Object accum; @@ -166,7 +201,7 @@ void *void_val, void *void_closure) { - /* This function can GC */ + /* This function does not GC */ Lisp_Object key; struct get_profiling_info_closure *closure = void_closure; EMACS_INT val; @@ -183,11 +218,18 @@ */ ()) { + /* This function does not GC */ struct get_profiling_info_closure closure; closure.accum = Qnil; if (big_profile_table) - maphash (get_profiling_info_maphash, big_profile_table, &closure); + { + int count = specpdl_depth (); + record_unwind_protect (profile_lock_unwind, Qnil); + inside_profiling = 1; + maphash (get_profiling_info_maphash, big_profile_table, &closure); + unbind_to (count, Qnil); + } return closure.accum; } @@ -201,7 +243,6 @@ void *void_val, void *void_closure) { - /* This function can GC */ Lisp_Object key; struct mark_profiling_info_closure *closure = void_closure; @@ -212,11 +253,16 @@ void mark_profiling_info (void (*markfun) (Lisp_Object)) { + /* This function does not GC (if markfun doesn't) */ struct mark_profiling_info_closure closure; closure.markfun = markfun; if (big_profile_table) - maphash (mark_profiling_info_maphash, big_profile_table, &closure); + { + inside_profiling = 1; + maphash (mark_profiling_info_maphash, big_profile_table, &closure); + inside_profiling = 0; + } } DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, 0, /* @@ -224,8 +270,13 @@ */ ()) { + /* This function does not GC */ if (big_profile_table) - clrhash (big_profile_table); + { + inside_profiling = 1; + clrhash (big_profile_table); + inside_profiling = 0; + } return Qnil; } @@ -258,6 +309,8 @@ */ ); default_profiling_interval = 1000; + inside_profiling = 0; + QSin_redisplay = build_string ("(in redisplay)"); staticpro (&QSin_redisplay); QSin_garbage_collection = build_string ("(in garbage collection)");