diff options
| author | Alan Mackenzie | 2022-02-02 20:35:39 +0000 |
|---|---|---|
| committer | Alan Mackenzie | 2022-02-02 20:35:39 +0000 |
| commit | aa795a6223c31ec8804f2824c435dba3091c115f (patch) | |
| tree | 3ab30ccf54019c835d584ae9ae72ec6341e2b123 | |
| parent | b6a51e05c9714827737708ce7fb2068f285005ce (diff) | |
| download | emacs-aa795a6223c31ec8804f2824c435dba3091c115f.tar.gz emacs-aa795a6223c31ec8804f2824c435dba3091c115f.zip | |
New file lisp/emacs-lisp/debug-early.el for backtraces in early bootstrap
This is also used in batch mode in general.
* lisp/debug-early.el (debug-early-backtrace, debug-early): New functions.
* lisp/loadup.el (top level): Load debug-early.el as first file.
* src/eval.c (signal_or_quit): Remove the condition in the batch mode section
of not being in dumping or bootstrap, since it is no longer needed. Test that
'debug-early's symbol-function is bound. Ensure there is enough working space
in specpdl and eval_depth.
(syms_of_eval): New DEFSYM for Qdebug_early. Initialise Vdebugger to
Qdebug_early rather than Qnil.
| -rw-r--r-- | lisp/emacs-lisp/debug-early.el | 77 | ||||
| -rw-r--r-- | lisp/loadup.el | 1 | ||||
| -rw-r--r-- | src/eval.c | 18 |
3 files changed, 88 insertions, 8 deletions
diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el new file mode 100644 index 00000000000..718000bfa4c --- /dev/null +++ b/lisp/emacs-lisp/debug-early.el | |||
| @@ -0,0 +1,77 @@ | |||
| 1 | ;;; debug-early.el --- Dump a Lisp backtrace without frills -*- lexical-binding: t; -*- | ||
| 2 | |||
| 3 | ;; Copyright (C) 2022 Free Software Foundation, Inc. | ||
| 4 | |||
| 5 | ;; Author: Alan Mackenzie <acm@muc.de> | ||
| 6 | ;; Maintainer: emacs-devel@gnu.org | ||
| 7 | ;; Keywords: internal, backtrace, bootstrap. | ||
| 8 | ;; Package: emacs | ||
| 9 | |||
| 10 | ;; This file is part of GNU Emacs. | ||
| 11 | |||
| 12 | ;; GNU Emacs is free software: you can redistribute it and/or modify | ||
| 13 | ;; it under the terms of the GNU General Public License as published by | ||
| 14 | ;; the Free Software Foundation, either version 3 of the License, or | ||
| 15 | ;; (at your option) any later version. | ||
| 16 | |||
| 17 | ;; GNU Emacs is distributed in the hope that it will be useful, | ||
| 18 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 19 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 20 | ;; GNU General Public License for more details. | ||
| 21 | |||
| 22 | ;; You should have received a copy of the GNU General Public License | ||
| 23 | ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. | ||
| 24 | |||
| 25 | ;;; Commentary: | ||
| 26 | |||
| 27 | ;; This file dumps a backtrace on stderr when an error is thrown. | ||
| 28 | ;; It has no dependencies on any Lisp libraries and is thus suitable | ||
| 29 | ;; for generating backtraces in the early parts of bootstrapping. It | ||
| 30 | ;; is also good for generating backtraces in batch mode in general. | ||
| 31 | |||
| 32 | (defalias 'debug-early-backtrace | ||
| 33 | #'(lambda () | ||
| 34 | "Print a trace of Lisp function calls currently active. | ||
| 35 | The output stream used is the value of `standard-output'. | ||
| 36 | |||
| 37 | This is a simplified version of the standard `backtrace' | ||
| 38 | function, intended for use in debugging the early parts | ||
| 39 | of the build process." | ||
| 40 | (princ "\n") | ||
| 41 | (mapbacktrace | ||
| 42 | #'(lambda (evald func args _flags) | ||
| 43 | (let ((args args)) | ||
| 44 | (if evald | ||
| 45 | (progn | ||
| 46 | (princ " ") | ||
| 47 | (prin1 func) | ||
| 48 | (princ "(") | ||
| 49 | (while args | ||
| 50 | (prin1 (car args)) | ||
| 51 | (setq args (cdr args)) | ||
| 52 | (if args | ||
| 53 | (princ " "))) | ||
| 54 | (princ ")\n")) | ||
| 55 | (while args | ||
| 56 | (princ " ") | ||
| 57 | (prin1 (car args)) | ||
| 58 | (princ "\n") | ||
| 59 | (setq args (cdr args))))))))) | ||
| 60 | |||
| 61 | (defalias 'debug-early | ||
| 62 | #'(lambda (&rest args) | ||
| 63 | "Print a trace of Lisp function calls currently active. | ||
| 64 | The output stream used is the value of `standard-output'. | ||
| 65 | |||
| 66 | There should be two ARGS, the symbol `error' and a cons of | ||
| 67 | the error symbol and its data. | ||
| 68 | |||
| 69 | This is a simplified version of `debug', intended for use | ||
| 70 | in debugging the early parts of the build process." | ||
| 71 | (princ "\nError: ") | ||
| 72 | (prin1 (car (car (cdr args)))) ; The error symbol. | ||
| 73 | (princ " ") | ||
| 74 | (prin1 (cdr (car (cdr args)))) ; The error data. | ||
| 75 | (debug-early-backtrace))) | ||
| 76 | |||
| 77 | ;;; debug-early.el ends here. | ||
diff --git a/lisp/loadup.el b/lisp/loadup.el index 1be73a2090d..81172c584d7 100644 --- a/lisp/loadup.el +++ b/lisp/loadup.el | |||
| @@ -128,6 +128,7 @@ | |||
| 128 | (set-buffer "*scratch*") | 128 | (set-buffer "*scratch*") |
| 129 | (setq buffer-undo-list t) | 129 | (setq buffer-undo-list t) |
| 130 | 130 | ||
| 131 | (load "emacs-lisp/debug-early") | ||
| 131 | (load "emacs-lisp/byte-run") | 132 | (load "emacs-lisp/byte-run") |
| 132 | (load "emacs-lisp/backquote") | 133 | (load "emacs-lisp/backquote") |
| 133 | (load "subr") | 134 | (load "subr") |
diff --git a/src/eval.c b/src/eval.c index 3e648ed6216..c87b1bc704c 100644 --- a/src/eval.c +++ b/src/eval.c | |||
| @@ -1873,18 +1873,19 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) | |||
| 1873 | } | 1873 | } |
| 1874 | 1874 | ||
| 1875 | /* If we're in batch mode, print a backtrace unconditionally to help | 1875 | /* If we're in batch mode, print a backtrace unconditionally to help |
| 1876 | with debugging. Make sure to use `debug' unconditionally to not | 1876 | with debugging. Make sure to use `debug-early' unconditionally |
| 1877 | interfere with ERT or other packages that install custom | 1877 | to not interfere with ERT or other packages that install custom |
| 1878 | debuggers. Don't try to call the debugger while dumping or | 1878 | debuggers. */ |
| 1879 | bootstrapping, it wouldn't work anyway. */ | ||
| 1880 | if (!debugger_called && !NILP (error_symbol) | 1879 | if (!debugger_called && !NILP (error_symbol) |
| 1881 | && (NILP (clause) || EQ (h->tag_or_ch, Qerror)) | 1880 | && (NILP (clause) || EQ (h->tag_or_ch, Qerror)) |
| 1882 | && noninteractive && backtrace_on_error_noninteractive | 1881 | && noninteractive && backtrace_on_error_noninteractive |
| 1883 | && !will_dump_p () && !will_bootstrap_p () | 1882 | && NILP (Vinhibit_debugger) |
| 1884 | && NILP (Vinhibit_debugger)) | 1883 | && !NILP (Ffboundp (Qdebug_early))) |
| 1885 | { | 1884 | { |
| 1885 | max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100); | ||
| 1886 | max_ensure_room (&max_specpdl_size, SPECPDL_INDEX (), 200); | ||
| 1886 | ptrdiff_t count = SPECPDL_INDEX (); | 1887 | ptrdiff_t count = SPECPDL_INDEX (); |
| 1887 | specbind (Qdebugger, Qdebug); | 1888 | specbind (Qdebugger, Qdebug_early); |
| 1888 | call_debugger (list2 (Qerror, Fcons (error_symbol, data))); | 1889 | call_debugger (list2 (Qerror, Fcons (error_symbol, data))); |
| 1889 | unbind_to (count, Qnil); | 1890 | unbind_to (count, Qnil); |
| 1890 | } | 1891 | } |
| @@ -4399,6 +4400,7 @@ before making `inhibit-quit' nil. */); | |||
| 4399 | DEFSYM (Qclosure, "closure"); | 4400 | DEFSYM (Qclosure, "closure"); |
| 4400 | DEFSYM (QCdocumentation, ":documentation"); | 4401 | DEFSYM (QCdocumentation, ":documentation"); |
| 4401 | DEFSYM (Qdebug, "debug"); | 4402 | DEFSYM (Qdebug, "debug"); |
| 4403 | DEFSYM (Qdebug_early, "debug-early"); | ||
| 4402 | 4404 | ||
| 4403 | DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, | 4405 | DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, |
| 4404 | doc: /* Non-nil means never enter the debugger. | 4406 | doc: /* Non-nil means never enter the debugger. |
| @@ -4453,7 +4455,7 @@ If due to frame exit, args are `exit' and the value being returned; | |||
| 4453 | If due to error, args are `error' and a list of the args to `signal'. | 4455 | If due to error, args are `error' and a list of the args to `signal'. |
| 4454 | If due to `apply' or `funcall' entry, one arg, `lambda'. | 4456 | If due to `apply' or `funcall' entry, one arg, `lambda'. |
| 4455 | If due to `eval' entry, one arg, t. */); | 4457 | If due to `eval' entry, one arg, t. */); |
| 4456 | Vdebugger = Qnil; | 4458 | Vdebugger = Qdebug_early; |
| 4457 | 4459 | ||
| 4458 | DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function, | 4460 | DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function, |
| 4459 | doc: /* If non-nil, this is a function for `signal' to call. | 4461 | doc: /* If non-nil, this is a function for `signal' to call. |