diff options
| author | Stefan Monnier | 2011-01-26 15:02:07 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2011-01-26 15:02:07 -0500 |
| commit | e7f7fbaa11828658bfa7a47e07446d050dc0ad92 (patch) | |
| tree | c0f4b39a119341d02199a1d87af16d8af7409b9a /src/eval.c | |
| parent | 6608a7d8fb941119faeb8873df0f56eea0ac1764 (diff) | |
| download | emacs-e7f7fbaa11828658bfa7a47e07446d050dc0ad92.tar.gz emacs-e7f7fbaa11828658bfa7a47e07446d050dc0ad92.zip | |
Let the debugger continue to the normal handler.
* src/eval.c (maybe_call_debugger): Declare before new use.
(find_handler_clause): Don't call debugger any more.
Ignore Vstack_trace_on_error.
Use XCAR/XCDR.
(syms_of_eval): Remove Vstack_trace_on_error.
(Fsignal): Only modify handlerlist when we know we need to do it.
Call the debugger when necessary.
* src/globals.h (Vstack_trace_on_error): Remove.
Fixes: debbugs:7825
Diffstat (limited to 'src/eval.c')
| -rw-r--r-- | src/eval.c | 153 |
1 files changed, 49 insertions, 104 deletions
diff --git a/src/eval.c b/src/eval.c index 709366717da..d0effc755a2 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -1557,6 +1557,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (int, Lisp_Object*), | |||
| 1557 | 1557 | ||
| 1558 | static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object, | 1558 | static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object, |
| 1559 | Lisp_Object, Lisp_Object); | 1559 | Lisp_Object, Lisp_Object); |
| 1560 | static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, | ||
| 1561 | Lisp_Object data); | ||
| 1560 | 1562 | ||
| 1561 | DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, | 1563 | DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, |
| 1562 | doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. | 1564 | doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. |
| @@ -1577,10 +1579,12 @@ See also the function `condition-case'. */) | |||
| 1577 | /* When memory is full, ERROR-SYMBOL is nil, | 1579 | /* When memory is full, ERROR-SYMBOL is nil, |
| 1578 | and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). | 1580 | and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). |
| 1579 | That is a special case--don't do this in other situations. */ | 1581 | That is a special case--don't do this in other situations. */ |
| 1580 | register struct handler *allhandlers = handlerlist; | ||
| 1581 | Lisp_Object conditions; | 1582 | Lisp_Object conditions; |
| 1582 | Lisp_Object string; | 1583 | Lisp_Object string; |
| 1583 | Lisp_Object real_error_symbol; | 1584 | Lisp_Object real_error_symbol |
| 1585 | = (NILP (error_symbol) ? Fcar (data) : error_symbol); | ||
| 1586 | register Lisp_Object clause = Qnil; | ||
| 1587 | struct handler *h; | ||
| 1584 | struct backtrace *bp; | 1588 | struct backtrace *bp; |
| 1585 | 1589 | ||
| 1586 | immediate_quit = handling_signal = 0; | 1590 | immediate_quit = handling_signal = 0; |
| @@ -1588,11 +1592,6 @@ See also the function `condition-case'. */) | |||
| 1588 | if (gc_in_progress || waiting_for_input) | 1592 | if (gc_in_progress || waiting_for_input) |
| 1589 | abort (); | 1593 | abort (); |
| 1590 | 1594 | ||
| 1591 | if (NILP (error_symbol)) | ||
| 1592 | real_error_symbol = Fcar (data); | ||
| 1593 | else | ||
| 1594 | real_error_symbol = error_symbol; | ||
| 1595 | |||
| 1596 | #if 0 /* rms: I don't know why this was here, | 1595 | #if 0 /* rms: I don't know why this was here, |
| 1597 | but it is surely wrong for an error that is handled. */ | 1596 | but it is surely wrong for an error that is handled. */ |
| 1598 | #ifdef HAVE_WINDOW_SYSTEM | 1597 | #ifdef HAVE_WINDOW_SYSTEM |
| @@ -1631,49 +1630,49 @@ See also the function `condition-case'. */) | |||
| 1631 | Vsignaling_function = *bp->function; | 1630 | Vsignaling_function = *bp->function; |
| 1632 | } | 1631 | } |
| 1633 | 1632 | ||
| 1634 | for (; handlerlist; handlerlist = handlerlist->next) | 1633 | for (h = handlerlist; h; h = h->next) |
| 1635 | { | 1634 | { |
| 1636 | register Lisp_Object clause; | 1635 | clause = find_handler_clause (h->handler, conditions, |
| 1637 | |||
| 1638 | clause = find_handler_clause (handlerlist->handler, conditions, | ||
| 1639 | error_symbol, data); | 1636 | error_symbol, data); |
| 1640 | |||
| 1641 | if (EQ (clause, Qlambda)) | ||
| 1642 | { | ||
| 1643 | /* We can't return values to code which signaled an error, but we | ||
| 1644 | can continue code which has signaled a quit. */ | ||
| 1645 | if (EQ (real_error_symbol, Qquit)) | ||
| 1646 | return Qnil; | ||
| 1647 | else | ||
| 1648 | error ("Cannot return from the debugger in an error"); | ||
| 1649 | } | ||
| 1650 | |||
| 1651 | if (!NILP (clause)) | 1637 | if (!NILP (clause)) |
| 1652 | { | 1638 | break; |
| 1653 | Lisp_Object unwind_data; | ||
| 1654 | struct handler *h = handlerlist; | ||
| 1655 | |||
| 1656 | handlerlist = allhandlers; | ||
| 1657 | |||
| 1658 | if (NILP (error_symbol)) | ||
| 1659 | unwind_data = data; | ||
| 1660 | else | ||
| 1661 | unwind_data = Fcons (error_symbol, data); | ||
| 1662 | h->chosen_clause = clause; | ||
| 1663 | unwind_to_catch (h->tag, unwind_data); | ||
| 1664 | } | ||
| 1665 | } | 1639 | } |
| 1640 | |||
| 1641 | if (/* Don't run the debugger for a memory-full error. | ||
| 1642 | (There is no room in memory to do that!) */ | ||
| 1643 | !NILP (error_symbol) | ||
| 1644 | && (!NILP (Vdebug_on_signal) | ||
| 1645 | /* If no handler is present now, try to run the debugger. */ | ||
| 1646 | || NILP (clause) | ||
| 1647 | /* Special handler that means "print a message and run debugger | ||
| 1648 | if requested". */ | ||
| 1649 | || EQ (h->handler, Qerror))) | ||
| 1650 | { | ||
| 1651 | int debugger_called | ||
| 1652 | = maybe_call_debugger (conditions, error_symbol, data); | ||
| 1653 | /* We can't return values to code which signaled an error, but we | ||
| 1654 | can continue code which has signaled a quit. */ | ||
| 1655 | if (debugger_called && EQ (real_error_symbol, Qquit)) | ||
| 1656 | return Qnil; | ||
| 1657 | } | ||
| 1666 | 1658 | ||
| 1667 | handlerlist = allhandlers; | 1659 | if (!NILP (clause)) |
| 1668 | /* If no handler is present now, try to run the debugger, | 1660 | { |
| 1669 | and if that fails, throw to top level. */ | 1661 | Lisp_Object unwind_data |
| 1670 | find_handler_clause (Qerror, conditions, error_symbol, data); | 1662 | = (NILP (error_symbol) ? data : Fcons (error_symbol, data)); |
| 1671 | if (catchlist != 0) | 1663 | |
| 1672 | Fthrow (Qtop_level, Qt); | 1664 | h->chosen_clause = clause; |
| 1665 | unwind_to_catch (h->tag, unwind_data); | ||
| 1666 | } | ||
| 1667 | else | ||
| 1668 | { | ||
| 1669 | if (catchlist != 0) | ||
| 1670 | Fthrow (Qtop_level, Qt); | ||
| 1671 | } | ||
| 1673 | 1672 | ||
| 1674 | if (! NILP (error_symbol)) | 1673 | if (! NILP (error_symbol)) |
| 1675 | data = Fcons (error_symbol, data); | 1674 | data = Fcons (error_symbol, data); |
| 1676 | 1675 | ||
| 1677 | string = Ferror_message_string (data); | 1676 | string = Ferror_message_string (data); |
| 1678 | fatal ("%s", SDATA (string), 0); | 1677 | fatal ("%s", SDATA (string), 0); |
| 1679 | } | 1678 | } |
| @@ -1848,63 +1847,24 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions, | |||
| 1848 | Lisp_Object sig, Lisp_Object data) | 1847 | Lisp_Object sig, Lisp_Object data) |
| 1849 | { | 1848 | { |
| 1850 | register Lisp_Object h; | 1849 | register Lisp_Object h; |
| 1851 | register Lisp_Object tem; | ||
| 1852 | int debugger_called = 0; | ||
| 1853 | int debugger_considered = 0; | ||
| 1854 | 1850 | ||
| 1855 | /* t is used by handlers for all conditions, set up by C code. */ | 1851 | /* t is used by handlers for all conditions, set up by C code. */ |
| 1856 | if (EQ (handlers, Qt)) | 1852 | if (EQ (handlers, Qt)) |
| 1857 | return Qt; | 1853 | return Qt; |
| 1858 | 1854 | ||
| 1859 | /* Don't run the debugger for a memory-full error. | ||
| 1860 | (There is no room in memory to do that!) */ | ||
| 1861 | if (NILP (sig)) | ||
| 1862 | debugger_considered = 1; | ||
| 1863 | |||
| 1864 | /* error is used similarly, but means print an error message | 1855 | /* error is used similarly, but means print an error message |
| 1865 | and run the debugger if that is enabled. */ | 1856 | and run the debugger if that is enabled. */ |
| 1866 | if (EQ (handlers, Qerror) | 1857 | if (EQ (handlers, Qerror)) |
| 1867 | || !NILP (Vdebug_on_signal)) /* This says call debugger even if | 1858 | return Qt; |
| 1868 | there is a handler. */ | ||
| 1869 | { | ||
| 1870 | if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions)) | ||
| 1871 | { | ||
| 1872 | max_lisp_eval_depth += 15; | ||
| 1873 | max_specpdl_size++; | ||
| 1874 | if (noninteractive) | ||
| 1875 | Fbacktrace (); | ||
| 1876 | else | ||
| 1877 | internal_with_output_to_temp_buffer | ||
| 1878 | ("*Backtrace*", | ||
| 1879 | (Lisp_Object (*) (Lisp_Object)) Fbacktrace, | ||
| 1880 | Qnil); | ||
| 1881 | max_specpdl_size--; | ||
| 1882 | max_lisp_eval_depth -= 15; | ||
| 1883 | } | ||
| 1884 | |||
| 1885 | if (!debugger_considered) | ||
| 1886 | { | ||
| 1887 | debugger_considered = 1; | ||
| 1888 | debugger_called = maybe_call_debugger (conditions, sig, data); | ||
| 1889 | } | ||
| 1890 | |||
| 1891 | /* If there is no handler, return saying whether we ran the debugger. */ | ||
| 1892 | if (EQ (handlers, Qerror)) | ||
| 1893 | { | ||
| 1894 | if (debugger_called) | ||
| 1895 | return Qlambda; | ||
| 1896 | return Qt; | ||
| 1897 | } | ||
| 1898 | } | ||
| 1899 | 1859 | ||
| 1900 | for (h = handlers; CONSP (h); h = Fcdr (h)) | 1860 | for (h = handlers; CONSP (h); h = XCDR (h)) |
| 1901 | { | 1861 | { |
| 1902 | Lisp_Object handler, condit; | 1862 | Lisp_Object handler = XCAR (h); |
| 1863 | Lisp_Object condit, tem; | ||
| 1903 | 1864 | ||
| 1904 | handler = Fcar (h); | ||
| 1905 | if (!CONSP (handler)) | 1865 | if (!CONSP (handler)) |
| 1906 | continue; | 1866 | continue; |
| 1907 | condit = Fcar (handler); | 1867 | condit = XCAR (handler); |
| 1908 | /* Handle a single condition name in handler HANDLER. */ | 1868 | /* Handle a single condition name in handler HANDLER. */ |
| 1909 | if (SYMBOLP (condit)) | 1869 | if (SYMBOLP (condit)) |
| 1910 | { | 1870 | { |
| @@ -1918,15 +1878,9 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions, | |||
| 1918 | Lisp_Object tail; | 1878 | Lisp_Object tail; |
| 1919 | for (tail = condit; CONSP (tail); tail = XCDR (tail)) | 1879 | for (tail = condit; CONSP (tail); tail = XCDR (tail)) |
| 1920 | { | 1880 | { |
| 1921 | tem = Fmemq (Fcar (tail), conditions); | 1881 | tem = Fmemq (XCAR (tail), conditions); |
| 1922 | if (!NILP (tem)) | 1882 | if (!NILP (tem)) |
| 1923 | { | 1883 | return handler; |
| 1924 | /* This handler is going to apply. | ||
| 1925 | Does it allow the debugger to run first? */ | ||
| 1926 | if (! debugger_considered && !NILP (Fmemq (Qdebug, condit))) | ||
| 1927 | maybe_call_debugger (conditions, sig, data); | ||
| 1928 | return handler; | ||
| 1929 | } | ||
| 1930 | } | 1884 | } |
| 1931 | } | 1885 | } |
| 1932 | } | 1886 | } |
| @@ -1943,7 +1897,6 @@ verror (const char *m, va_list ap) | |||
| 1943 | EMACS_INT size = 200; | 1897 | EMACS_INT size = 200; |
| 1944 | int mlen; | 1898 | int mlen; |
| 1945 | char *buffer = buf; | 1899 | char *buffer = buf; |
| 1946 | char *args[3]; | ||
| 1947 | int allocated = 0; | 1900 | int allocated = 0; |
| 1948 | Lisp_Object string; | 1901 | Lisp_Object string; |
| 1949 | 1902 | ||
| @@ -3523,14 +3476,6 @@ before making `inhibit-quit' nil. */); | |||
| 3523 | Qdebug = intern_c_string ("debug"); | 3476 | Qdebug = intern_c_string ("debug"); |
| 3524 | staticpro (&Qdebug); | 3477 | staticpro (&Qdebug); |
| 3525 | 3478 | ||
| 3526 | DEFVAR_LISP ("stack-trace-on-error", Vstack_trace_on_error, | ||
| 3527 | doc: /* *Non-nil means errors display a backtrace buffer. | ||
| 3528 | More precisely, this happens for any error that is handled | ||
| 3529 | by the editor command loop. | ||
| 3530 | If the value is a list, an error only means to display a backtrace | ||
| 3531 | if one of its condition symbols appears in the list. */); | ||
| 3532 | Vstack_trace_on_error = Qnil; | ||
| 3533 | |||
| 3534 | DEFVAR_LISP ("debug-on-error", Vdebug_on_error, | 3479 | DEFVAR_LISP ("debug-on-error", Vdebug_on_error, |
| 3535 | doc: /* *Non-nil means enter debugger if an error is signaled. | 3480 | doc: /* *Non-nil means enter debugger if an error is signaled. |
| 3536 | Does not apply to errors handled by `condition-case' or those | 3481 | Does not apply to errors handled by `condition-case' or those |