From xemacs-m  Mon Mar 24 14:56:18 1997
Received: from mailbox2.ucsd.edu (mailbox2.ucsd.edu [132.239.1.54])
	by xemacs.org (8.8.5/8.8.5) with ESMTP id OAA17155
	for <xemacs-beta@xemacs.org>; Mon, 24 Mar 1997 14:56:15 -0600 (CST)
Received: from sdnp5.ucsd.edu (sdnp5.ucsd.edu [132.239.79.10]) by mailbox2.ucsd.edu (8.8.5/8.6.9) with SMTP id MAA07530 for <xemacs-beta@xemacs.org>; Mon, 24 Mar 1997 12:56:12 -0800 (PST)
Received: by sdnp5.ucsd.edu (SMI-8.6/SMI-SVR4)
	id MAA07287; Mon, 24 Mar 1997 12:58:04 -0800
Sender: dmoore@sdnp5.ucsd.edu
To: xemacs-beta@xemacs.org
Subject: profile.c patch (was Re: Customize faces slow (known problem?) (b101))
References: <by3etq4vk9.fsf@math.ethz.ch> 	<QQchuk13982.199703210730@crystal.WonderWorks.COM> 	<rjlo7dqw8r.fsf@zuse.dina.kvl.dk> 	<QQcigx13600.199703241651@crystal.WonderWorks.COM> 	<rvohc99q14.fsf@sdnp5.ucsd.edu> <QQciha14479.199703241735@crystal.WonderWorks.COM>
X-Face: "oX;zS#-JU$-,WKSzG.1gGE]x^cIg!hW.dq>.f6pzS^A+(k!T|M:}5{_%>Io<>L&{hO7W4cicOQ|>/lZ1G(m%7iaCf,6Qgk0%%Bz7b2-W3jd0m_UG\Y;?]}4s0O-U)uox>P3JN)9cm]O\@,vy2e{`3pb!"pqmRy3peB90*2L
Mail-Copies-To: never
Mime-Version: 1.0 (generated by tm-edit 7.106)
Content-Type: multipart/mixed;
 boundary="Multipart_Mon_Mar_24_12:58:03_1997-1"
Content-Transfer-Encoding: 7bit
From: David Moore <dmoore@ucsd.edu>
Date: 24 Mar 1997 12:58:03 -0800
In-Reply-To: Kyle Jones's message of Mon, 24 Mar 1997 12:35:37 -0500 (EST)
Message-ID: <rvg1xl9fdw.fsf_-_@sdnp5.ucsd.edu>
Lines: 355
X-Mailer: Gnus v5.4.33/XEmacs 19.15(beta103)

--Multipart_Mon_Mar_24_12:58:03_1997-1
Content-Type: text/plain; charset=US-ASCII

Kyle Jones <kyle_jones@wonderworks.com> writes:

> David Moore writes:
>  > 
>  > >  > > start-profiling, stop-profiling and pretty-print-profiling-info
>  > >  > > are the functions to use if you want to do it yourself.
>  > 
>  > As a warning, turning on this profiling can cause crashes on some
>  > systems, the code is a bit buggy.
> 
> Which systems and why does it crash?

If you have bad timing in calls to clear-profiling-info or
get-profiling-info while still having profiling turned on, you can
corrupt things.  Also, the profiling handler isn't disabled during
shutdowns, so it can interefere with autosaving and panic dumps.  A bit
worse (although somewhat unlikely) it might allocate memory in a signal
handler which can wreak all sorts of bizarre damage (especially with
non-mmap rel-alloc).  There were some problems in eval.c in that not
every location which can place items onto the backtrace_list was doing
so in the correct order.  So it was possible for that variable to point
at uninitialized data.

This patch will make me a bit happier about suggesting it's use to
people.  It prevents changes to the table while it's being actively
used.  It also prevents the signal handler from doing anything during a
shutdown.  eval.c has been cleaned up to build backtrace_list in the
correct order.

No fix for the memory allocation problem, it can only happen once you've
gotten more than ~7600 functions in the profiling table.  So it's
probably rare.  Although if you reload a bytecompiled file, any lambda
in there will count as different from the original.  The memory from
these guys also hang around until you clear-profiling-info.


--Multipart_Mon_Mar_24_12:58:03_1997-1
Content-Type: application/octet-stream; type=patch
Content-Disposition: attachment; filename="profile.diff"
Content-Transfer-Encoding: 7bit

--- ChangeLog.orig	Mon Mar 24 12:45:10 1997
+++ ChangeLog	Mon Mar 24 12:49:07 1997
@@ -0,0 +1,19 @@
+Mon Mar 24 12:40:56 1997  David Moore  <dmoore@ucsd.edu>
+
+	* profile.c: Fixed some comments about GC status of functions.
+	
+	* profile.c (profile_table_locked): New variable to lock the
+	profiling table.
+	(sigprof_handler): Check it.
+	(Fget_profiling_info): Set it.
+	(mark_profiling_info): Set it.
+	(Fclear_profiling_info): Set it.
+
+	* eval.c (PUSH_BACKTRACE): New macro.
+	(POP_BACKTRACE): Ditto.
+
+	* eval.c (Fcommand_execute): Use them and fix problem with
+ 	backtrace_list build ordering requirements for profiling code.
+	(Feval): Ditto.
+	(funcall_recording_as): Ditto.
+
--- eval.c.orig	Mon Mar 24 12:44:54 1997
+++ eval.c	Mon Mar 24 12:44:25 1997
@@ -41,6 +41,16 @@
 
 struct backtrace *backtrace_list;
 
+/* Note you must always fill all of the fields in a backtrace structure
+   before pushing them on the backtrace_list.  The profiling code depends
+   on this. */
+
+#define PUSH_BACKTRACE(bt) \
+  do { (bt).next = backtrace_list; backtrace_list = &(bt); } while (0)
+
+#define POP_BACKTRACE(bt) \
+  do { backtrace_list = (bt).next; } while (0)
+
 /* This is the list of current catches (and also condition-cases).
    This is a stack: the most recent catch is at the head of the
    list.  Catches are created by declaring a 'struct catchtag'
@@ -2582,18 +2592,17 @@
 #ifdef EMACS_BTL
       backtrace.id_number = 0;
 #endif
-      backtrace.next = backtrace_list;
-      backtrace_list = &backtrace;
       backtrace.function = &Qcall_interactively;
       backtrace.args = &cmd;
       backtrace.nargs = 1;
       backtrace.evalargs = 0;
       backtrace.pdlcount = specpdl_depth ();
       backtrace.debug_on_exit = 0;
+      PUSH_BACKTRACE (backtrace);
 
       final = Fcall_interactively (cmd, record, keys);
 
-      backtrace_list = backtrace.next;
+      POP_BACKTRACE (backtrace);
       return (final);
     }
   else if (STRINGP (final) || VECTORP (final))
@@ -2917,13 +2926,12 @@
   backtrace.id_number = 0;
 #endif
   backtrace.pdlcount = specpdl_depth_counter;
-  backtrace.next = backtrace_list;
-  backtrace_list = &backtrace;
   backtrace.function = &original_fun; /* This also protects them from gc */
   backtrace.args = &original_args;
   backtrace.nargs = UNEVALLED;
   backtrace.evalargs = 1;
   backtrace.debug_on_exit = 0;
+  PUSH_BACKTRACE (backtrace);
 
   if (debug_on_next_call)
     do_debug_on_call (Qt);
@@ -2999,7 +3007,7 @@
 #endif
           if (backtrace.debug_on_exit)
             val = do_debug_on_exit (val);
-          backtrace_list = backtrace.next;
+	  POP_BACKTRACE (backtrace);
 	  UNGCPRO;
           return (val);
 	}
@@ -3072,7 +3080,7 @@
 #endif
   if (backtrace.debug_on_exit)
     val = do_debug_on_exit (val);
-  backtrace_list = backtrace.next;
+  POP_BACKTRACE (backtrace);
   return (val);
 }
 
@@ -3107,15 +3115,12 @@
   backtrace.id_number = 0;
 #endif
   backtrace.pdlcount = specpdl_depth_counter;
-  backtrace.next = backtrace_list;
   backtrace.function = &args[0];
   backtrace.args = &args[1];
   backtrace.nargs = nargs;
   backtrace.evalargs = 0;
   backtrace.debug_on_exit = 0;
-  /* XEmacs: make sure this is done last so we don't get race
-     conditions in the profiling code. */
-  backtrace_list = &backtrace;
+  PUSH_BACKTRACE (backtrace);
 
   if (debug_on_next_call)
     do_debug_on_call (Qlambda);
@@ -3204,7 +3209,7 @@
   lisp_eval_depth--;
   if (backtrace.debug_on_exit)
     val = do_debug_on_exit (val);
-  backtrace_list = backtrace.next;
+  POP_BACKTRACE (backtrace);
   return val;
 }
 
--- profile.c.orig	Mon Mar 24 12:10:20 1997
+++ profile.c	Mon Mar 24 12:09:46 1997
@@ -63,38 +63,50 @@
 Lisp_Object QSprocessing_events_at_top_level;
 Lisp_Object QSunknown;
 
+static Lisp_Object profile_table_locked;
+
 static SIGTYPE
 sigprof_handler (int signo)
 {
-  Lisp_Object fun;
-
-  if (profiling_redisplay_flag)
-    fun = QSin_redisplay;
-  else if (gc_in_progress)
-    fun = QSin_garbage_collection;
-  else if (backtrace_list)
+  /* Don't do anything if we are shutting down, or are doing a maphash
+     or clrhash on the table. */
+  if (!preparing_for_armageddon && NILP (profile_table_locked))
     {
-      fun = *backtrace_list->function;
-
-      XUNMARK (fun);
-      if (!GC_SYMBOLP (fun) && !GC_COMPILED_FUNCTIONP (fun))
-        fun = QSunknown;
-    }
-  else
-    fun = QSprocessing_events_at_top_level;
+      Lisp_Object fun;
 
-  {
-    long count;
-    CONST void *vval;
+      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;
+
+      {
+	/* #### 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. */
+	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);
-  }
+	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 +122,7 @@
 */
        (microsecs))
 {
+  /* This function can GC */
   int msecs;
   struct itimerval foo;
 
@@ -145,6 +158,7 @@
 */
        ())
 {
+  /* This function does not GC */
   struct itimerval foo;
 
   foo.it_value.tv_sec = 0;
@@ -156,6 +170,13 @@
   return Qnil;
 }
 
+static Lisp_Object
+profile_lock_unwind (Lisp_Object ignore)
+{
+  profile_table_locked = Qnil;
+  return Qnil;
+}
+
 struct get_profiling_info_closure
 {
   Lisp_Object accum;
@@ -166,7 +187,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 +204,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);
+      profile_table_locked = Qt;
+      maphash (get_profiling_info_maphash, big_profile_table, &closure);
+      unbind_to (count, Qnil);
+    }
   return closure.accum;
 }
 
@@ -201,7 +229,6 @@
 			     void *void_val,
 			     void *void_closure)
 {
-  /* This function can GC */
   Lisp_Object key;
   struct mark_profiling_info_closure *closure = void_closure;
 
@@ -212,11 +239,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);
+    {
+      profile_table_locked = Qt;
+      maphash (mark_profiling_info_maphash, big_profile_table, &closure);
+      profile_table_locked = Qnil;
+    }
 }
 
 DEFUN ("clear-profiling-info", Fclear_profiling_info, 0, 0, 0, /*
@@ -224,8 +256,13 @@
 */
        ())
 {
+  /* This function does not GC */
   if (big_profile_table)
-    clrhash (big_profile_table);
+    {
+      profile_table_locked = Qt;
+      clrhash (big_profile_table);
+      profile_table_locked = Qnil;
+    }
   return Qnil;
 }
 
@@ -257,6 +294,8 @@
 or the kernel is executing on behalf of the program) and not real time.
 */ );
   default_profiling_interval = 1000;
+
+  profile_table_locked = Qnil;
 
   QSin_redisplay = build_string ("(in redisplay)");
   staticpro (&QSin_redisplay);

--Multipart_Mon_Mar_24_12:58:03_1997-1--

