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.
This commit is contained in:
Alan Mackenzie 2022-02-02 20:35:39 +00:00
parent b6a51e05c9
commit aa795a6223
3 changed files with 88 additions and 8 deletions

View file

@ -0,0 +1,77 @@
;;; debug-early.el --- Dump a Lisp backtrace without frills -*- lexical-binding: t; -*-
;; Copyright (C) 2022 Free Software Foundation, Inc.
;; Author: Alan Mackenzie <acm@muc.de>
;; Maintainer: emacs-devel@gnu.org
;; Keywords: internal, backtrace, bootstrap.
;; Package: emacs
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This file dumps a backtrace on stderr when an error is thrown.
;; It has no dependencies on any Lisp libraries and is thus suitable
;; for generating backtraces in the early parts of bootstrapping. It
;; is also good for generating backtraces in batch mode in general.
(defalias 'debug-early-backtrace
#'(lambda ()
"Print a trace of Lisp function calls currently active.
The output stream used is the value of `standard-output'.
This is a simplified version of the standard `backtrace'
function, intended for use in debugging the early parts
of the build process."
(princ "\n")
(mapbacktrace
#'(lambda (evald func args _flags)
(let ((args args))
(if evald
(progn
(princ " ")
(prin1 func)
(princ "(")
(while args
(prin1 (car args))
(setq args (cdr args))
(if args
(princ " ")))
(princ ")\n"))
(while args
(princ " ")
(prin1 (car args))
(princ "\n")
(setq args (cdr args)))))))))
(defalias 'debug-early
#'(lambda (&rest args)
"Print a trace of Lisp function calls currently active.
The output stream used is the value of `standard-output'.
There should be two ARGS, the symbol `error' and a cons of
the error symbol and its data.
This is a simplified version of `debug', intended for use
in debugging the early parts of the build process."
(princ "\nError: ")
(prin1 (car (car (cdr args)))) ; The error symbol.
(princ " ")
(prin1 (cdr (car (cdr args)))) ; The error data.
(debug-early-backtrace)))
;;; debug-early.el ends here.

View file

@ -128,6 +128,7 @@
(set-buffer "*scratch*") (set-buffer "*scratch*")
(setq buffer-undo-list t) (setq buffer-undo-list t)
(load "emacs-lisp/debug-early")
(load "emacs-lisp/byte-run") (load "emacs-lisp/byte-run")
(load "emacs-lisp/backquote") (load "emacs-lisp/backquote")
(load "subr") (load "subr")

View file

@ -1873,18 +1873,19 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit)
} }
/* If we're in batch mode, print a backtrace unconditionally to help /* If we're in batch mode, print a backtrace unconditionally to help
with debugging. Make sure to use `debug' unconditionally to not with debugging. Make sure to use `debug-early' unconditionally
interfere with ERT or other packages that install custom to not interfere with ERT or other packages that install custom
debuggers. Don't try to call the debugger while dumping or debuggers. */
bootstrapping, it wouldn't work anyway. */
if (!debugger_called && !NILP (error_symbol) if (!debugger_called && !NILP (error_symbol)
&& (NILP (clause) || EQ (h->tag_or_ch, Qerror)) && (NILP (clause) || EQ (h->tag_or_ch, Qerror))
&& noninteractive && backtrace_on_error_noninteractive && noninteractive && backtrace_on_error_noninteractive
&& !will_dump_p () && !will_bootstrap_p () && NILP (Vinhibit_debugger)
&& NILP (Vinhibit_debugger)) && !NILP (Ffboundp (Qdebug_early)))
{ {
max_ensure_room (&max_lisp_eval_depth, lisp_eval_depth, 100);
max_ensure_room (&max_specpdl_size, SPECPDL_INDEX (), 200);
ptrdiff_t count = SPECPDL_INDEX (); ptrdiff_t count = SPECPDL_INDEX ();
specbind (Qdebugger, Qdebug); specbind (Qdebugger, Qdebug_early);
call_debugger (list2 (Qerror, Fcons (error_symbol, data))); call_debugger (list2 (Qerror, Fcons (error_symbol, data)));
unbind_to (count, Qnil); unbind_to (count, Qnil);
} }
@ -4399,6 +4400,7 @@ before making `inhibit-quit' nil. */);
DEFSYM (Qclosure, "closure"); DEFSYM (Qclosure, "closure");
DEFSYM (QCdocumentation, ":documentation"); DEFSYM (QCdocumentation, ":documentation");
DEFSYM (Qdebug, "debug"); DEFSYM (Qdebug, "debug");
DEFSYM (Qdebug_early, "debug-early");
DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger, DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
doc: /* Non-nil means never enter the debugger. 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;
If due to error, args are `error' and a list of the args to `signal'. If due to error, args are `error' and a list of the args to `signal'.
If due to `apply' or `funcall' entry, one arg, `lambda'. If due to `apply' or `funcall' entry, one arg, `lambda'.
If due to `eval' entry, one arg, t. */); If due to `eval' entry, one arg, t. */);
Vdebugger = Qnil; Vdebugger = Qdebug_early;
DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function, DEFVAR_LISP ("signal-hook-function", Vsignal_hook_function,
doc: /* If non-nil, this is a function for `signal' to call. doc: /* If non-nil, this is a function for `signal' to call.