diff src/eval.c @ 1123:37bdd24225ef

[xemacs-hg @ 2002-11-27 07:15:02 by ben] bug fixes, profiling debugging improvements configure.in: Check for GCC version and only use -Wpacked in v3. .cvsignore: Add .idb, .ilk for MS Windows VC++. cl-macs.el: Document better. cmdloop.el: Removed. Remove nonworking breakpoint-on-error now that debug-on-error works as documented. help.el: Extract out with-displaying-help-buffer into a more general mechanism. lib-complete.el: Support thunks in find-library-source-path. startup.el: Don't catch errors when noninteractive, because that makes stack traces from stack-trace-on-error useless. .cvsignore: Windows shit. alloc.c: Better redisplay-related assert. elhash.c: Comment change. eval.c: Don't generate large warning strings (e.g. backtraces) when they will be discarded. Implement debug-on-error as documented -- it will enter the debugger and crash when an uncaught signal happens noninteractively and we are --debug. Better redisplay-related asserts. frame-msw.c, frame.c, lisp.h, redisplay.c, scrollbar-gtk.c, scrollbar-x.c, signal.c, sysdep.c: Fix up documentation related to QUIT (which CANNOT garbage-collect under any circumstances), and to redisplay critical sections. lread.c: Add load-ignore-out-of-date-elc-files, load-always-display-messages, load-show-full-path-in-messages for more robust package compilation and debugging. profile.c: Overhaul profile code. Change format to include call count and be extensible for further info. Remove call-count-profile-table. Add set-profiling-info. See related profile.el changes (which SHOULD ABSOLUTELY be in the core! Get rid of xemacs-devel and xemacs-base packages *yesterday*!).
author ben
date Wed, 27 Nov 2002 07:15:36 +0000
parents 184461bc8de4
children ccd0667b4764
line wrap: on
line diff
--- a/src/eval.c	Tue Nov 26 22:52:59 2002 +0000
+++ b/src/eval.c	Wed Nov 27 07:15:36 2002 +0000
@@ -413,6 +413,9 @@
 static int throw_level;
 #endif
 
+static int warning_will_be_discarded (Lisp_Object level);
+static void check_proper_critical_section_nonlocal_exit_protection (void);
+
 
 /************************************************************************/
 /*			The subr object type				*/
@@ -744,6 +747,12 @@
       && !skip_debugger (conditions, temp_data))
     {
       debug_on_quit &= ~2;	/* reset critical bit */
+
+#ifdef DEBUG_XEMACS
+      if (noninteractive)
+	Fforce_debugging_signal (Qt);
+#endif
+
       specbind (Qdebug_on_error,	Qnil);
       specbind (Qstack_trace_on_error,	Qnil);
       specbind (Qdebug_on_signal,	Qnil);
@@ -779,6 +788,12 @@
 	  : wants_debugger (Vdebug_on_signal, conditions)))
     {
       debug_on_quit &= ~2;	/* reset critical bit */
+
+#ifdef DEBUG_XEMACS
+      if (noninteractive)
+	Fforce_debugging_signal (Qt);
+#endif
+
       specbind (Qdebug_on_error,	Qnil);
       specbind (Qstack_trace_on_error,	Qnil);
       specbind (Qdebug_on_signal,	Qnil);
@@ -1592,6 +1607,8 @@
     abort ();
 #endif
 
+  check_proper_critical_section_nonlocal_exit_protection ();
+
   /* If bomb_out_p is t, this is being called from Fsignal as a
      "last resort" when there is no handler for this error and
       the debugger couldn't be invoked, so we are throwing to
@@ -2113,6 +2130,7 @@
 }
 
 extern int in_display;
+extern int gc_currently_forbidden;
 
 
 /************************************************************************/
@@ -2131,6 +2149,24 @@
 {
 }
 
+static void
+check_proper_critical_section_gc_protection (void)
+{
+  assert_with_message
+    (!in_display || gc_currently_forbidden,
+     "Potential GC from within redisplay without being properly wrapped");
+}
+
+static void
+check_proper_critical_section_nonlocal_exit_protection (void)
+{
+  assert_with_message
+    (!in_display
+     || ((get_inhibit_flags () & INTERNAL_INHIBIT_ERRORS)
+	 && (get_inhibit_flags () & INTERNAL_INHIBIT_THROWS)),
+     "Attempted non-local exit from within redisplay without being properly wrapped");
+}
+
 /* #### This function has not been synched with FSF.  It diverges
    significantly. */
 
@@ -2181,20 +2217,14 @@
       abort ();
     }
 
-  if (gc_in_progress)
-    /* We used to abort if in_display:
-
-       [[This is one of many reasons why you can't run lisp code from
-       redisplay.  There is no sensible way to handle errors there.]]
-
-       The above comment is not correct.
-
-       Inhibit GC until the redisplay code is careful enough to properly
-       GCPRO their structures;
-
-       Surround all calls to Lisp code with error-trapping wrappers that
-       catch all errors. --ben */
-    abort ();
+  assert (!gc_in_progress);
+
+  /* We abort if in_display and we are not protected, as garbage
+     collections and non-local exits will invariably be fatal, but in
+     messy, difficult-to-debug ways.  See enter_redisplay_critical_section().
+  */
+
+  check_proper_critical_section_nonlocal_exit_protection ();
 
   conditions = Fget (error_symbol, Qerror_conditions, Qnil);
 
@@ -3462,6 +3492,9 @@
     }
 
   QUIT;
+#ifdef ERROR_CHECK_TRAPPING_PROBLEMS
+  check_proper_critical_section_gc_protection ();
+#endif
   if (need_to_garbage_collect)
     {
       struct gcpro gcpro1;
@@ -3706,6 +3739,9 @@
 
   if (funcall_allocation_flag)
     {
+#ifdef ERROR_CHECK_TRAPPING_PROBLEMS
+      check_proper_critical_section_gc_protection ();
+#endif
       if (need_to_garbage_collect)
 	/* Callers should gcpro lexpr args */
 	garbage_collect_1 ();
@@ -4750,7 +4786,8 @@
   Lisp_Object errstr;
   int speccount = specpdl_depth ();
 
-  if (! (inhibit_flags & INHIBIT_WARNING_ISSUE))
+  if (!(inhibit_flags & INHIBIT_WARNING_ISSUE)
+      && !warning_will_be_discarded (current_warning_level ()))
     {
       /* We're no longer protected against errors or quit here, so at
 	 least let's temporarily inhibit quit.  We definitely do not
@@ -4781,7 +4818,6 @@
 			      errstr);
 
       unbind_to (speccount);
-
     }
   else
     p->backtrace = Qnil;
@@ -4847,8 +4883,7 @@
    higher-level caller.
 
    If FLAGS contains INHIBIT_GC, garbage collection is inhibited.
-   This is useful for Lisp called within redisplay or inside of the
-   QUIT macro (where GC is generally not expected), for example.
+   This is useful for Lisp called within redisplay, for example.
 
    If FLAGS contains INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION,
    Lisp code is not allowed to delete any window, buffers, frames, devices,
@@ -5022,7 +5057,8 @@
     tem = (fun) (arg);
 
   if (thrown && !EQ (thrown_tag, package.catchtag)
-      && (!flags & INHIBIT_WARNING_ISSUE))
+      && (!flags & INHIBIT_WARNING_ISSUE)
+      && !warning_will_be_discarded (current_warning_level ()))
     {
       Lisp_Object errstr;
 
@@ -6186,16 +6222,22 @@
 /*			      Warnings					*/
 /************************************************************************/
 
+static int
+warning_will_be_discarded (Lisp_Object level)
+{
+  /* Don't even generate debug warnings if they're going to be discarded,
+     to avoid excessive consing. */
+  return (EQ (level, Qdebug) && !NILP (Vlog_warning_minimum_level) &&
+	  !EQ (Vlog_warning_minimum_level, Qdebug));
+}
+
 void
 warn_when_safe_lispobj (Lisp_Object class, Lisp_Object level,
 			Lisp_Object obj)
 {
-  /* Don't even generate debug warnings if they're going to be discarded,
-     to avoid excessive consing. */
-  if (EQ (level, Qdebug) && !NILP (Vlog_warning_minimum_level) &&
-      !EQ (Vlog_warning_minimum_level, Qdebug))
+  if (warning_will_be_discarded (level))
     return;
-  
+
   obj = list1 (list3 (class, level, obj));
   if (NILP (Vpending_warnings))
     Vpending_warnings = Vpending_warnings_tail = obj;
@@ -6219,12 +6261,9 @@
   Lisp_Object obj;
   va_list args;
 
-  /* Don't even generate debug warnings if they're going to be discarded,
-     to avoid excessive consing. */
-  if (EQ (level, Qdebug) && !NILP (Vlog_warning_minimum_level) &&
-      !EQ (Vlog_warning_minimum_level, Qdebug))
+  if (warning_will_be_discarded (level))
     return;
-  
+
   va_start (args, fmt);
   obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
   va_end (args);
@@ -6421,12 +6460,21 @@
 if one of its condition symbols appears in the list.
 This variable is overridden by `debug-ignored-errors'.
 See also variables `debug-on-quit' and `debug-on-signal'.
-If this variable is set while XEmacs is running noninteractively,
-an unhandled error will cause a backtrace to be output and the C
-debugger entered using `force-debugging-signal'.  This can be very
-useful when debugging noninteractive errors in tricky situations,
-e.g. makefiles, since you can set this variable using an environment
-variable, like this:
+
+If this variable is set while XEmacs is running noninteractively (using
+`-batch'), and XEmacs was configured with `--debug' (#define XEMACS_DEBUG
+in the C code), instead of trying to invoke the Lisp debugger (which
+obviously won't work), XEmacs will break out to a C debugger using
+\(force-debugging-signal t).  This is useful because debugging
+noninteractive runs of XEmacs is often very difficult, since they typically
+happen as part of sometimes large and complex make suites (e.g. rebuilding
+the XEmacs packages).  NOTE: This runs abort()!!! (As well as and after
+executing INT 3 under MS Windows, which should invoke a debugger if it's
+active.) This is guaranteed to kill XEmacs! (But in this situation, XEmacs
+is about to die anyway, and if no debugger is present, this will usefully
+dump core.) The most useful way to set this flag when debugging
+noninteractive runs, especially in makefiles, is using the environment
+variable XEMACSDEBUG, like this:
 
 \(using csh)      setenv XEMACSDEBUG '(setq debug-on-error t)'
 \(using bash)     export XEMACSDEBUG='(setq debug-on-error t)'
@@ -6440,6 +6488,9 @@
 If the value is a list, an error only means to enter the debugger
 if one of its condition symbols appears in the list.
 See also variable `debug-on-quit'.
+
+This will attempt to enter a C debugger when XEmacs is run noninteractively
+and under the same conditions as described in `debug-on-error'.
 */ );
   Vdebug_on_signal = Qnil;