Mercurial > hg > xemacs-beta

comparison src/eval.c @ 1123:37bdd24225ef

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[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
comparison
equal deleted inserted replaced
1122:7abc2b15a990 1123:37bdd24225ef
411 #ifdef DEFEND_AGAINST_THROW_RECURSION 411 #ifdef DEFEND_AGAINST_THROW_RECURSION
412 /* Used for error catching purposes by throw_or_bomb_out */ 412 /* Used for error catching purposes by throw_or_bomb_out */
413 static int throw_level; 413 static int throw_level;
414 #endif 414 #endif
415 415
416 static int warning_will_be_discarded (Lisp_Object level);
417 static void check_proper_critical_section_nonlocal_exit_protection (void);
418
416 419
417 /************************************************************************/ 420 /************************************************************************/
418 /* The subr object type */ 421 /* The subr object type */
419 /************************************************************************/ 422 /************************************************************************/
420 423
742 ? debug_on_quit 745 ? debug_on_quit
743 : wants_debugger (Vdebug_on_error, conditions)) 746 : wants_debugger (Vdebug_on_error, conditions))
744 && !skip_debugger (conditions, temp_data)) 747 && !skip_debugger (conditions, temp_data))
745 { 748 {
746 debug_on_quit &= ~2; /* reset critical bit */ 749 debug_on_quit &= ~2; /* reset critical bit */
750
751 #ifdef DEBUG_XEMACS
752 if (noninteractive)
753 Fforce_debugging_signal (Qt);
754 #endif
755
747 specbind (Qdebug_on_error, Qnil); 756 specbind (Qdebug_on_error, Qnil);
748 specbind (Qstack_trace_on_error, Qnil); 757 specbind (Qstack_trace_on_error, Qnil);
749 specbind (Qdebug_on_signal, Qnil); 758 specbind (Qdebug_on_signal, Qnil);
750 specbind (Qstack_trace_on_signal, Qnil); 759 specbind (Qstack_trace_on_signal, Qnil);
751 760
777 && (EQ (sig, Qquit) 786 && (EQ (sig, Qquit)
778 ? debug_on_quit 787 ? debug_on_quit
779 : wants_debugger (Vdebug_on_signal, conditions))) 788 : wants_debugger (Vdebug_on_signal, conditions)))
780 { 789 {
781 debug_on_quit &= ~2; /* reset critical bit */ 790 debug_on_quit &= ~2; /* reset critical bit */
791
792 #ifdef DEBUG_XEMACS
793 if (noninteractive)
794 Fforce_debugging_signal (Qt);
795 #endif
796
782 specbind (Qdebug_on_error, Qnil); 797 specbind (Qdebug_on_error, Qnil);
783 specbind (Qstack_trace_on_error, Qnil); 798 specbind (Qstack_trace_on_error, Qnil);
784 specbind (Qdebug_on_signal, Qnil); 799 specbind (Qdebug_on_signal, Qnil);
785 specbind (Qstack_trace_on_signal, Qnil); 800 specbind (Qstack_trace_on_signal, Qnil);
786 801
1590 /* die if we recurse more than is reasonable */ 1605 /* die if we recurse more than is reasonable */
1591 if (++throw_level > 20) 1606 if (++throw_level > 20)
1592 abort (); 1607 abort ();
1593 #endif 1608 #endif
1594 1609
1610 check_proper_critical_section_nonlocal_exit_protection ();
1611
1595 /* If bomb_out_p is t, this is being called from Fsignal as a 1612 /* If bomb_out_p is t, this is being called from Fsignal as a
1596 "last resort" when there is no handler for this error and 1613 "last resort" when there is no handler for this error and
1597 the debugger couldn't be invoked, so we are throwing to 1614 the debugger couldn't be invoked, so we are throwing to
1598 'top-level. If this tag doesn't exist (happens during the 1615 'top-level. If this tag doesn't exist (happens during the
1599 initialization stages) we would get in an infinite recursive 1616 initialization stages) we would get in an infinite recursive
2111 Qunbound); 2128 Qunbound);
2112 #endif 2129 #endif
2113 } 2130 }
2114 2131
2115 extern int in_display; 2132 extern int in_display;
2133 extern int gc_currently_forbidden;
2116 2134
2117 2135
2118 /************************************************************************/ 2136 /************************************************************************/
2119 /* the workhorse error-signaling function */ 2137 /* the workhorse error-signaling function */
2120 /************************************************************************/ 2138 /************************************************************************/
2127 void signal_1 (void); 2145 void signal_1 (void);
2128 2146
2129 void 2147 void
2130 signal_1 (void) 2148 signal_1 (void)
2131 { 2149 {
2150 }
2151
2152 static void
2153 check_proper_critical_section_gc_protection (void)
2154 {
2155 assert_with_message
2156 (!in_display || gc_currently_forbidden,
2157 "Potential GC from within redisplay without being properly wrapped");
2158 }
2159
2160 static void
2161 check_proper_critical_section_nonlocal_exit_protection (void)
2162 {
2163 assert_with_message
2164 (!in_display
2165 || ((get_inhibit_flags () & INTERNAL_INHIBIT_ERRORS)
2166 && (get_inhibit_flags () & INTERNAL_INHIBIT_THROWS)),
2167 "Attempted non-local exit from within redisplay without being properly wrapped");
2132 } 2168 }
2133 2169
2134 /* #### This function has not been synched with FSF. It diverges 2170 /* #### This function has not been synched with FSF. It diverges
2135 significantly. */ 2171 significantly. */
2136 2172
2179 just to bomb out immediately. */ 2215 just to bomb out immediately. */
2180 stderr_out ("Error before initialization is complete!\n"); 2216 stderr_out ("Error before initialization is complete!\n");
2181 abort (); 2217 abort ();
2182 } 2218 }
2183 2219
2184 if (gc_in_progress) 2220 assert (!gc_in_progress);
2185 /* We used to abort if in_display: 2221
2186 2222 /* We abort if in_display and we are not protected, as garbage
2187 [[This is one of many reasons why you can't run lisp code from 2223 collections and non-local exits will invariably be fatal, but in
2188 redisplay. There is no sensible way to handle errors there.]] 2224 messy, difficult-to-debug ways. See enter_redisplay_critical_section().
2189 2225 */
2190 The above comment is not correct. 2226
2191 2227 check_proper_critical_section_nonlocal_exit_protection ();
2192 Inhibit GC until the redisplay code is careful enough to properly
2193 GCPRO their structures;
2194
2195 Surround all calls to Lisp code with error-trapping wrappers that
2196 catch all errors. --ben */
2197 abort ();
2198 2228
2199 conditions = Fget (error_symbol, Qerror_conditions, Qnil); 2229 conditions = Fget (error_symbol, Qerror_conditions, Qnil);
2200 2230
2201 for (handlers = Vcondition_handlers; 2231 for (handlers = Vcondition_handlers;
2202 CONSP (handlers); 2232 CONSP (handlers);
3460 else 3490 else
3461 return form; 3491 return form;
3462 } 3492 }
3463 3493
3464 QUIT; 3494 QUIT;
3495 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS
3496 check_proper_critical_section_gc_protection ();
3497 #endif
3465 if (need_to_garbage_collect) 3498 if (need_to_garbage_collect)
3466 { 3499 {
3467 struct gcpro gcpro1; 3500 struct gcpro gcpro1;
3468 GCPRO1 (form); 3501 GCPRO1 (form);
3469 garbage_collect_1 (); 3502 garbage_collect_1 ();
3704 3737
3705 QUIT; 3738 QUIT;
3706 3739
3707 if (funcall_allocation_flag) 3740 if (funcall_allocation_flag)
3708 { 3741 {
3742 #ifdef ERROR_CHECK_TRAPPING_PROBLEMS
3743 check_proper_critical_section_gc_protection ();
3744 #endif
3709 if (need_to_garbage_collect) 3745 if (need_to_garbage_collect)
3710 /* Callers should gcpro lexpr args */ 3746 /* Callers should gcpro lexpr args */
3711 garbage_collect_1 (); 3747 garbage_collect_1 ();
3712 if (need_to_check_c_alloca) 3748 if (need_to_check_c_alloca)
3713 { 3749 {
4748 struct gcpro gcpro1; 4784 struct gcpro gcpro1;
4749 Lisp_Object lstream = Qnil; 4785 Lisp_Object lstream = Qnil;
4750 Lisp_Object errstr; 4786 Lisp_Object errstr;
4751 int speccount = specpdl_depth (); 4787 int speccount = specpdl_depth ();
4752 4788
4753 if (! (inhibit_flags & INHIBIT_WARNING_ISSUE)) 4789 if (!(inhibit_flags & INHIBIT_WARNING_ISSUE)
4790 && !warning_will_be_discarded (current_warning_level ()))
4754 { 4791 {
4755 /* We're no longer protected against errors or quit here, so at 4792 /* We're no longer protected against errors or quit here, so at
4756 least let's temporarily inhibit quit. We definitely do not 4793 least let's temporarily inhibit quit. We definitely do not
4757 want to inhibit quit during the calling of the function 4794 want to inhibit quit during the calling of the function
4758 itself!!!!!!!!!!! */ 4795 itself!!!!!!!!!!! */
4779 4816
4780 warn_when_safe_lispobj (p->warning_class, current_warning_level (), 4817 warn_when_safe_lispobj (p->warning_class, current_warning_level (),
4781 errstr); 4818 errstr);
4782 4819
4783 unbind_to (speccount); 4820 unbind_to (speccount);
4784
4785 } 4821 }
4786 else 4822 else
4787 p->backtrace = Qnil; 4823 p->backtrace = Qnil;
4788 4824
4789 p->error_conditions = error_conditions; 4825 p->error_conditions = error_conditions;
4845 trapped and reported as an error, unless NO_INHIBIT_ERRORS is 4881 trapped and reported as an error, unless NO_INHIBIT_ERRORS is
4846 given.) This is useful when QUIT checking has been turned off by a 4882 given.) This is useful when QUIT checking has been turned off by a
4847 higher-level caller. 4883 higher-level caller.
4848 4884
4849 If FLAGS contains INHIBIT_GC, garbage collection is inhibited. 4885 If FLAGS contains INHIBIT_GC, garbage collection is inhibited.
4850 This is useful for Lisp called within redisplay or inside of the 4886 This is useful for Lisp called within redisplay, for example.
4851 QUIT macro (where GC is generally not expected), for example.
4852 4887
4853 If FLAGS contains INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION, 4888 If FLAGS contains INHIBIT_EXISTING_PERMANENT_DISPLAY_OBJECT_DELETION,
4854 Lisp code is not allowed to delete any window, buffers, frames, devices, 4889 Lisp code is not allowed to delete any window, buffers, frames, devices,
4855 or consoles that were already in existence at the time this function 4890 or consoles that were already in existence at the time this function
4856 was called. (However, it's perfectly legal for code to create a new 4891 was called. (However, it's perfectly legal for code to create a new
5020 else 5055 else
5021 /* Nothing special. */ 5056 /* Nothing special. */
5022 tem = (fun) (arg); 5057 tem = (fun) (arg);
5023 5058
5024 if (thrown && !EQ (thrown_tag, package.catchtag) 5059 if (thrown && !EQ (thrown_tag, package.catchtag)
5025 && (!flags & INHIBIT_WARNING_ISSUE)) 5060 && (!flags & INHIBIT_WARNING_ISSUE)
5061 && !warning_will_be_discarded (current_warning_level ()))
5026 { 5062 {
5027 Lisp_Object errstr; 5063 Lisp_Object errstr;
5028 5064
5029 if (!(flags & INHIBIT_QUIT)) 5065 if (!(flags & INHIBIT_QUIT))
5030 /* We're no longer protected against errors or quit here, so at 5066 /* We're no longer protected against errors or quit here, so at
6184 6220
6185 /************************************************************************/ 6221 /************************************************************************/
6186 /* Warnings */ 6222 /* Warnings */
6187 /************************************************************************/ 6223 /************************************************************************/
6188 6224
6225 static int
6226 warning_will_be_discarded (Lisp_Object level)
6227 {
6228 /* Don't even generate debug warnings if they're going to be discarded,
6229 to avoid excessive consing. */
6230 return (EQ (level, Qdebug) && !NILP (Vlog_warning_minimum_level) &&
6231 !EQ (Vlog_warning_minimum_level, Qdebug));
6232 }
6233
6189 void 6234 void
6190 warn_when_safe_lispobj (Lisp_Object class, Lisp_Object level, 6235 warn_when_safe_lispobj (Lisp_Object class, Lisp_Object level,
6191 Lisp_Object obj) 6236 Lisp_Object obj)
6192 { 6237 {
6193 /* Don't even generate debug warnings if they're going to be discarded, 6238 if (warning_will_be_discarded (level))
6194 to avoid excessive consing. */
6195 if (EQ (level, Qdebug) && !NILP (Vlog_warning_minimum_level) &&
6196 !EQ (Vlog_warning_minimum_level, Qdebug))
6197 return; 6239 return;
6198 6240
6199 obj = list1 (list3 (class, level, obj)); 6241 obj = list1 (list3 (class, level, obj));
6200 if (NILP (Vpending_warnings)) 6242 if (NILP (Vpending_warnings))
6201 Vpending_warnings = Vpending_warnings_tail = obj; 6243 Vpending_warnings = Vpending_warnings_tail = obj;
6202 else 6244 else
6203 { 6245 {
6217 warn_when_safe (Lisp_Object class, Lisp_Object level, const CIbyte *fmt, ...) 6259 warn_when_safe (Lisp_Object class, Lisp_Object level, const CIbyte *fmt, ...)
6218 { 6260 {
6219 Lisp_Object obj; 6261 Lisp_Object obj;
6220 va_list args; 6262 va_list args;
6221 6263
6222 /* Don't even generate debug warnings if they're going to be discarded, 6264 if (warning_will_be_discarded (level))
6223 to avoid excessive consing. */
6224 if (EQ (level, Qdebug) && !NILP (Vlog_warning_minimum_level) &&
6225 !EQ (Vlog_warning_minimum_level, Qdebug))
6226 return; 6265 return;
6227 6266
6228 va_start (args, fmt); 6267 va_start (args, fmt);
6229 obj = emacs_vsprintf_string (CGETTEXT (fmt), args); 6268 obj = emacs_vsprintf_string (CGETTEXT (fmt), args);
6230 va_end (args); 6269 va_end (args);
6231 6270
6232 warn_when_safe_lispobj (class, level, obj); 6271 warn_when_safe_lispobj (class, level, obj);
6419 a `condition-case'. 6458 a `condition-case'.
6420 If the value is a list, an error only means to enter the debugger 6459 If the value is a list, an error only means to enter the debugger
6421 if one of its condition symbols appears in the list. 6460 if one of its condition symbols appears in the list.
6422 This variable is overridden by `debug-ignored-errors'. 6461 This variable is overridden by `debug-ignored-errors'.
6423 See also variables `debug-on-quit' and `debug-on-signal'. 6462 See also variables `debug-on-quit' and `debug-on-signal'.
6424 If this variable is set while XEmacs is running noninteractively, 6463
6425 an unhandled error will cause a backtrace to be output and the C 6464 If this variable is set while XEmacs is running noninteractively (using
6426 debugger entered using `force-debugging-signal'. This can be very 6465 `-batch'), and XEmacs was configured with `--debug' (#define XEMACS_DEBUG
6427 useful when debugging noninteractive errors in tricky situations, 6466 in the C code), instead of trying to invoke the Lisp debugger (which
6428 e.g. makefiles, since you can set this variable using an environment 6467 obviously won't work), XEmacs will break out to a C debugger using
6429 variable, like this: 6468 \(force-debugging-signal t). This is useful because debugging
6469 noninteractive runs of XEmacs is often very difficult, since they typically
6470 happen as part of sometimes large and complex make suites (e.g. rebuilding
6471 the XEmacs packages). NOTE: This runs abort()!!! (As well as and after
6472 executing INT 3 under MS Windows, which should invoke a debugger if it's
6473 active.) This is guaranteed to kill XEmacs! (But in this situation, XEmacs
6474 is about to die anyway, and if no debugger is present, this will usefully
6475 dump core.) The most useful way to set this flag when debugging
6476 noninteractive runs, especially in makefiles, is using the environment
6477 variable XEMACSDEBUG, like this:
6430 6478
6431 \(using csh) setenv XEMACSDEBUG '(setq debug-on-error t)' 6479 \(using csh) setenv XEMACSDEBUG '(setq debug-on-error t)'
6432 \(using bash) export XEMACSDEBUG='(setq debug-on-error t)' 6480 \(using bash) export XEMACSDEBUG='(setq debug-on-error t)'
6433 */ ); 6481 */ );
6434 Vdebug_on_error = Qnil; 6482 Vdebug_on_error = Qnil;
6438 The debugger will be entered whether or not the error is handled by 6486 The debugger will be entered whether or not the error is handled by
6439 a `condition-case'. 6487 a `condition-case'.
6440 If the value is a list, an error only means to enter the debugger 6488 If the value is a list, an error only means to enter the debugger
6441 if one of its condition symbols appears in the list. 6489 if one of its condition symbols appears in the list.
6442 See also variable `debug-on-quit'. 6490 See also variable `debug-on-quit'.
6491
6492 This will attempt to enter a C debugger when XEmacs is run noninteractively
6493 and under the same conditions as described in `debug-on-error'.
6443 */ ); 6494 */ );
6444 Vdebug_on_signal = Qnil; 6495 Vdebug_on_signal = Qnil;
6445 6496
6446 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit /* 6497 DEFVAR_BOOL ("debug-on-quit", &debug_on_quit /*
6447 *Non-nil means enter debugger if quit is signalled (C-G, for example). 6498 *Non-nil means enter debugger if quit is signalled (C-G, for example).