diff options
| author | Richard M. Stallman | 2007-07-14 18:43:58 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 2007-07-14 18:43:58 +0000 |
| commit | f01cbfdda1a3bc60da7b22d7ee19cc3ae2927f1d (patch) | |
| tree | f707be83dfc57630e0fa01ac27859e96c37fb790 /src/eval.c | |
| parent | be44b862badaad8cc0a498c0f5dc9cce2a352e61 (diff) | |
| download | emacs-f01cbfdda1a3bc60da7b22d7ee19cc3ae2927f1d.tar.gz emacs-f01cbfdda1a3bc60da7b22d7ee19cc3ae2927f1d.zip | |
(maybe_call_debugger): New function.
(find_handler_clause): Use maybe_call_debugger.
Call it when the handler says `debug'.
Eliminate DEBUGGER_VALUE_PTR.
(Fsignal): Eliminate debugger_value.
(Qdebug): New variable.
(syms_of_eval): Initialize it.
Diffstat (limited to 'src/eval.c')
| -rw-r--r-- | src/eval.c | 119 |
1 files changed, 69 insertions, 50 deletions
diff --git a/src/eval.c b/src/eval.c index 355ed30066a..cd0d0fc1c5c 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -97,6 +97,7 @@ Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag; | |||
| 97 | Lisp_Object Qand_rest, Qand_optional; | 97 | Lisp_Object Qand_rest, Qand_optional; |
| 98 | Lisp_Object Qdebug_on_error; | 98 | Lisp_Object Qdebug_on_error; |
| 99 | Lisp_Object Qdeclare; | 99 | Lisp_Object Qdeclare; |
| 100 | Lisp_Object Qdebug; | ||
| 100 | 101 | ||
| 101 | /* This holds either the symbol `run-hooks' or nil. | 102 | /* This holds either the symbol `run-hooks' or nil. |
| 102 | It is nil at an early stage of startup, and when Emacs | 103 | It is nil at an early stage of startup, and when Emacs |
| @@ -1585,8 +1586,7 @@ internal_condition_case_2 (bfun, nargs, args, handlers, hfun) | |||
| 1585 | 1586 | ||
| 1586 | 1587 | ||
| 1587 | static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object, | 1588 | static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object, |
| 1588 | Lisp_Object, Lisp_Object, | 1589 | Lisp_Object, Lisp_Object)); |
| 1589 | Lisp_Object *)); | ||
| 1590 | 1590 | ||
| 1591 | DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, | 1591 | DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0, |
| 1592 | doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. | 1592 | doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA. |
| @@ -1612,7 +1612,6 @@ See also the function `condition-case'. */) | |||
| 1612 | Lisp_Object conditions; | 1612 | Lisp_Object conditions; |
| 1613 | extern int gc_in_progress; | 1613 | extern int gc_in_progress; |
| 1614 | extern int waiting_for_input; | 1614 | extern int waiting_for_input; |
| 1615 | Lisp_Object debugger_value; | ||
| 1616 | Lisp_Object string; | 1615 | Lisp_Object string; |
| 1617 | Lisp_Object real_error_symbol; | 1616 | Lisp_Object real_error_symbol; |
| 1618 | struct backtrace *bp; | 1617 | struct backtrace *bp; |
| @@ -1670,7 +1669,7 @@ See also the function `condition-case'. */) | |||
| 1670 | register Lisp_Object clause; | 1669 | register Lisp_Object clause; |
| 1671 | 1670 | ||
| 1672 | clause = find_handler_clause (handlerlist->handler, conditions, | 1671 | clause = find_handler_clause (handlerlist->handler, conditions, |
| 1673 | error_symbol, data, &debugger_value); | 1672 | error_symbol, data); |
| 1674 | 1673 | ||
| 1675 | if (EQ (clause, Qlambda)) | 1674 | if (EQ (clause, Qlambda)) |
| 1676 | { | 1675 | { |
| @@ -1701,7 +1700,7 @@ See also the function `condition-case'. */) | |||
| 1701 | handlerlist = allhandlers; | 1700 | handlerlist = allhandlers; |
| 1702 | /* If no handler is present now, try to run the debugger, | 1701 | /* If no handler is present now, try to run the debugger, |
| 1703 | and if that fails, throw to top level. */ | 1702 | and if that fails, throw to top level. */ |
| 1704 | find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value); | 1703 | find_handler_clause (Qerror, conditions, error_symbol, data); |
| 1705 | if (catchlist != 0) | 1704 | if (catchlist != 0) |
| 1706 | Fthrow (Qtop_level, Qt); | 1705 | Fthrow (Qtop_level, Qt); |
| 1707 | 1706 | ||
| @@ -1853,75 +1852,54 @@ skip_debugger (conditions, data) | |||
| 1853 | = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). | 1852 | = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA). |
| 1854 | This is for memory-full errors only. | 1853 | This is for memory-full errors only. |
| 1855 | 1854 | ||
| 1856 | Store value returned from debugger into *DEBUGGER_VALUE_PTR. | ||
| 1857 | |||
| 1858 | We need to increase max_specpdl_size temporarily around | 1855 | We need to increase max_specpdl_size temporarily around |
| 1859 | anything we do that can push on the specpdl, so as not to get | 1856 | anything we do that can push on the specpdl, so as not to get |
| 1860 | a second error here in case we're handling specpdl overflow. */ | 1857 | a second error here in case we're handling specpdl overflow. */ |
| 1861 | 1858 | ||
| 1862 | static Lisp_Object | 1859 | static Lisp_Object |
| 1863 | find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) | 1860 | find_handler_clause (handlers, conditions, sig, data) |
| 1864 | Lisp_Object handlers, conditions, sig, data; | 1861 | Lisp_Object handlers, conditions, sig, data; |
| 1865 | Lisp_Object *debugger_value_ptr; | ||
| 1866 | { | 1862 | { |
| 1867 | register Lisp_Object h; | 1863 | register Lisp_Object h; |
| 1868 | register Lisp_Object tem; | 1864 | register Lisp_Object tem; |
| 1865 | int debugger_called = 0; | ||
| 1866 | int debugger_considered = 0; | ||
| 1869 | 1867 | ||
| 1870 | if (EQ (handlers, Qt)) /* t is used by handlers for all conditions, set up by C code. */ | 1868 | /* t is used by handlers for all conditions, set up by C code. */ |
| 1869 | if (EQ (handlers, Qt)) | ||
| 1871 | return Qt; | 1870 | return Qt; |
| 1871 | |||
| 1872 | /* Don't run the debugger for a memory-full error. | ||
| 1873 | (There is no room in memory to do that!) */ | ||
| 1874 | if (NILP (sig)) | ||
| 1875 | debugger_considered = 1; | ||
| 1876 | |||
| 1872 | /* error is used similarly, but means print an error message | 1877 | /* error is used similarly, but means print an error message |
| 1873 | and run the debugger if that is enabled. */ | 1878 | and run the debugger if that is enabled. */ |
| 1874 | if (EQ (handlers, Qerror) | 1879 | if (EQ (handlers, Qerror) |
| 1875 | || !NILP (Vdebug_on_signal)) /* This says call debugger even if | 1880 | || !NILP (Vdebug_on_signal)) /* This says call debugger even if |
| 1876 | there is a handler. */ | 1881 | there is a handler. */ |
| 1877 | { | 1882 | { |
| 1878 | int debugger_called = 0; | 1883 | if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions)) |
| 1879 | Lisp_Object sig_symbol, combined_data; | ||
| 1880 | /* This is set to 1 if we are handling a memory-full error, | ||
| 1881 | because these must not run the debugger. | ||
| 1882 | (There is no room in memory to do that!) */ | ||
| 1883 | int no_debugger = 0; | ||
| 1884 | |||
| 1885 | if (NILP (sig)) | ||
| 1886 | { | ||
| 1887 | combined_data = data; | ||
| 1888 | sig_symbol = Fcar (data); | ||
| 1889 | no_debugger = 1; | ||
| 1890 | } | ||
| 1891 | else | ||
| 1892 | { | ||
| 1893 | combined_data = Fcons (sig, data); | ||
| 1894 | sig_symbol = sig; | ||
| 1895 | } | ||
| 1896 | |||
| 1897 | if (wants_debugger (Vstack_trace_on_error, conditions)) | ||
| 1898 | { | 1884 | { |
| 1899 | max_specpdl_size++; | 1885 | max_specpdl_size++; |
| 1900 | #ifdef PROTOTYPES | 1886 | #ifdef PROTOTYPES |
| 1901 | internal_with_output_to_temp_buffer ("*Backtrace*", | 1887 | internal_with_output_to_temp_buffer ("*Backtrace*", |
| 1902 | (Lisp_Object (*) (Lisp_Object)) Fbacktrace, | 1888 | (Lisp_Object (*) (Lisp_Object)) Fbacktrace, |
| 1903 | Qnil); | 1889 | Qnil); |
| 1904 | #else | 1890 | #else |
| 1905 | internal_with_output_to_temp_buffer ("*Backtrace*", | 1891 | internal_with_output_to_temp_buffer ("*Backtrace*", |
| 1906 | Fbacktrace, Qnil); | 1892 | Fbacktrace, Qnil); |
| 1907 | #endif | 1893 | #endif |
| 1908 | max_specpdl_size--; | 1894 | max_specpdl_size--; |
| 1909 | } | 1895 | } |
| 1910 | if (! no_debugger | 1896 | |
| 1911 | /* Don't try to run the debugger with interrupts blocked. | 1897 | if (!debugger_considered) |
| 1912 | The editing loop would return anyway. */ | ||
| 1913 | && ! INPUT_BLOCKED_P | ||
| 1914 | && (EQ (sig_symbol, Qquit) | ||
| 1915 | ? debug_on_quit | ||
| 1916 | : wants_debugger (Vdebug_on_error, conditions)) | ||
| 1917 | && ! skip_debugger (conditions, combined_data) | ||
| 1918 | && when_entered_debugger < num_nonmacro_input_events) | ||
| 1919 | { | 1898 | { |
| 1920 | *debugger_value_ptr | 1899 | debugger_considered = 1; |
| 1921 | = call_debugger (Fcons (Qerror, | 1900 | debugger_called = maybe_call_debugger (conditions, sig, data); |
| 1922 | Fcons (combined_data, Qnil))); | ||
| 1923 | debugger_called = 1; | ||
| 1924 | } | 1901 | } |
| 1902 | |||
| 1925 | /* If there is no handler, return saying whether we ran the debugger. */ | 1903 | /* If there is no handler, return saying whether we ran the debugger. */ |
| 1926 | if (EQ (handlers, Qerror)) | 1904 | if (EQ (handlers, Qerror)) |
| 1927 | { | 1905 | { |
| @@ -1930,6 +1908,7 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) | |||
| 1930 | return Qt; | 1908 | return Qt; |
| 1931 | } | 1909 | } |
| 1932 | } | 1910 | } |
| 1911 | |||
| 1933 | for (h = handlers; CONSP (h); h = Fcdr (h)) | 1912 | for (h = handlers; CONSP (h); h = Fcdr (h)) |
| 1934 | { | 1913 | { |
| 1935 | Lisp_Object handler, condit; | 1914 | Lisp_Object handler, condit; |
| @@ -1948,18 +1927,55 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) | |||
| 1948 | /* Handle a list of condition names in handler HANDLER. */ | 1927 | /* Handle a list of condition names in handler HANDLER. */ |
| 1949 | else if (CONSP (condit)) | 1928 | else if (CONSP (condit)) |
| 1950 | { | 1929 | { |
| 1951 | while (CONSP (condit)) | 1930 | Lisp_Object tail; |
| 1931 | for (tail = condit; CONSP (tail); tail = XCDR (tail)) | ||
| 1952 | { | 1932 | { |
| 1953 | tem = Fmemq (Fcar (condit), conditions); | 1933 | tem = Fmemq (Fcar (tail), conditions); |
| 1954 | if (!NILP (tem)) | 1934 | if (!NILP (tem)) |
| 1955 | return handler; | 1935 | { |
| 1956 | condit = XCDR (condit); | 1936 | /* This handler is going to apply. |
| 1937 | Does it allow the debugger to run first? */ | ||
| 1938 | if (! debugger_considered && !NILP (Fmemq (Qdebug, condit))) | ||
| 1939 | maybe_call_debugger (conditions, sig, data); | ||
| 1940 | return handler; | ||
| 1941 | } | ||
| 1957 | } | 1942 | } |
| 1958 | } | 1943 | } |
| 1959 | } | 1944 | } |
| 1945 | |||
| 1960 | return Qnil; | 1946 | return Qnil; |
| 1961 | } | 1947 | } |
| 1962 | 1948 | ||
| 1949 | /* Call the debugger if calling it is currently enabled for CONDITIONS. | ||
| 1950 | SIG and DATA describe the signal, as in find_handler_clause. */ | ||
| 1951 | |||
| 1952 | int | ||
| 1953 | maybe_call_debugger (conditions, sig, data) | ||
| 1954 | Lisp_Object conditions, sig, data; | ||
| 1955 | { | ||
| 1956 | Lisp_Object combined_data; | ||
| 1957 | |||
| 1958 | combined_data = Fcons (sig, data); | ||
| 1959 | |||
| 1960 | if ( | ||
| 1961 | /* Don't try to run the debugger with interrupts blocked. | ||
| 1962 | The editing loop would return anyway. */ | ||
| 1963 | ! INPUT_BLOCKED_P | ||
| 1964 | /* Does user wants to enter debugger for this kind of error? */ | ||
| 1965 | && (EQ (sig, Qquit) | ||
| 1966 | ? debug_on_quit | ||
| 1967 | : wants_debugger (Vdebug_on_error, conditions)) | ||
| 1968 | && ! skip_debugger (conditions, combined_data) | ||
| 1969 | /* rms: what's this for? */ | ||
| 1970 | && when_entered_debugger < num_nonmacro_input_events) | ||
| 1971 | { | ||
| 1972 | call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil))); | ||
| 1973 | return 1; | ||
| 1974 | } | ||
| 1975 | |||
| 1976 | return 0; | ||
| 1977 | } | ||
| 1978 | |||
| 1963 | /* dump an error message; called like printf */ | 1979 | /* dump an error message; called like printf */ |
| 1964 | 1980 | ||
| 1965 | /* VARARGS 1 */ | 1981 | /* VARARGS 1 */ |
| @@ -3600,6 +3616,9 @@ before making `inhibit-quit' nil. */); | |||
| 3600 | Qand_optional = intern ("&optional"); | 3616 | Qand_optional = intern ("&optional"); |
| 3601 | staticpro (&Qand_optional); | 3617 | staticpro (&Qand_optional); |
| 3602 | 3618 | ||
| 3619 | Qdebug = intern ("debug"); | ||
| 3620 | staticpro (&Qdebug); | ||
| 3621 | |||
| 3603 | DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error, | 3622 | DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error, |
| 3604 | doc: /* *Non-nil means errors display a backtrace buffer. | 3623 | doc: /* *Non-nil means errors display a backtrace buffer. |
| 3605 | More precisely, this happens for any error that is handled | 3624 | More precisely, this happens for any error that is handled |