From: "Clément Pit--Claudel" <clement.pit@gmail.com>
To: emacs-devel@gnu.org
Subject: Re: Lisp-friendly backtraces [was: Lispy backtraces]
Date: Mon, 5 Dec 2016 11:31:03 -0500 [thread overview]
Message-ID: <e2ab0ea3-da80-233a-7f64-559aed4de06e@gmail.com> (raw)
In-Reply-To: <jwvr35mmohg.fsf-monnier+gmane.emacs.devel@gnu.org>
[-- Attachment #1.1.1: Type: text/plain, Size: 680 bytes --]
On 2016-12-05 09:37, Stefan Monnier wrote:
>> Removing `backtrace' from eval.c makes the patch much harder to read,
>> so I'll do that later.
>
> M-x diff-unified->context RET
>
> should solve this apparent problem.
Neat! I've attached a cleaner patch, including documentation and a Changelog entry.
Help with the following warning would be much appreciated:
eval.c:3436:1: warning: no previous prototype for ‘backtrace_frame_apply’ [-Wmissing-prototypes]
backtrace_frame_apply (Lisp_Object function, union specbinding *pdl)
^
(why does this specific function cause this warning, while other newly introduced functions don't?)
Thanks,
Clément.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.1.2: 0001-Move-backtrace-to-ELisp-using-a-new-mapbacktrace-pri.patch --]
[-- Type: text/x-diff; name="0001-Move-backtrace-to-ELisp-using-a-new-mapbacktrace-pri.patch", Size: 13696 bytes --]
From 185736cd23be13677ef3528cf83ef4a4f3039c72 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Cl=C3=A9ment=20Pit--Claudel?= <clement.pitclaudel@live.com>
Date: Mon, 5 Dec 2016 00:52:14 -0500
Subject: [PATCH] Move backtrace to ELisp using a new mapbacktrace primitive
* src/eval.c (get_backtrace_starting_at, backtrace_frame_apply)
(Fmapbacktrace, Fbacktrace_frame_internal): New functions.
(get_backtrace_frame, Fbacktrace_debug): Use `get_backtrace_starting_at'.
* lisp/subr.el (backtrace--print-frame): New function.
(backtrace): Reimplement using `backtrace--print-frame' and `mapbacktrace'.
(backtrace-frame): Reimplement using `backtrace-frame--internal'.
* lisp/emacs-lisp/debug.el (debugger-setup-buffer): Pass a
base to `mapbacktrace' instead of searching for "(debug" in
the output of `backtrace'.
* doc/lispref/debugging.texi (Internals of Debugger): Document
`mapbacktrace' and missing argument BASE of `backtrace-frame'.
---
doc/lispref/debugging.texi | 24 ++++++-
etc/NEWS | 4 ++
lisp/emacs-lisp/debug.el | 11 ++--
lisp/subr.el | 36 ++++++++++
src/eval.c | 160 ++++++++++++++++++++-------------------------
5 files changed, 140 insertions(+), 95 deletions(-)
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index c80b0f9..35ff9af 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -727,7 +727,7 @@ Internals of Debugger
This variable is obsolete and will be removed in future versions.
@end defvar
-@defun backtrace-frame frame-number
+@defun backtrace-frame frame-number &optional base
The function @code{backtrace-frame} is intended for use in Lisp
debuggers. It returns information about what computation is happening
in the stack frame @var{frame-number} levels down.
@@ -744,10 +744,32 @@ Internals of Debugger
case of a macro call. If the function has a @code{&rest} argument, that
is represented as the tail of the list @var{arg-values}.
+If @var{base} is specified, @var{frame-number} counts relative to
+the topmost frame whose @var{function} is @var{base}.
+
If @var{frame-number} is out of range, @code{backtrace-frame} returns
@code{nil}.
@end defun
+@defun mapbacktrace function &optional base
+The function @code{mapbacktrace} calls @var{function} once for each
+frame in the backtrace, starting at the first frame whose
+@var{function} is base (or from the top if @var{base} is omitted or
+@code{nil}).
+
+@var{function} is called with four arguments @var{evald} @var{func}
+@var{args} @var{flags}.
+
+If a frame has not evaluated its arguments yet or is a special form,
+@var{evald} is @code{nil} and @var{args} is a list of forms.
+
+If a frame has evaluated its arguments and called its function
+already, @var{evald} is @code{t} and @var{args} is a list of values.
+@var{flags} is a plist of properties of the current frame: currently,
+the only supported property is @code{:debug-on-exit}, which is t if
+the frame's debug-on-exit flag is set.
+@end defun
+
@include edebug.texi
@node Syntax Errors
diff --git a/etc/NEWS b/etc/NEWS
index a62668a..72bef06 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -74,6 +74,10 @@ for '--daemon'.
* Changes in Emacs 26.1
+++
+** The new function 'mapbacktrace' applies a function to all frames of
+the current stack trace.
+
++++
** The new function 'file-name-case-insensitive-p' tests whether a
given file is on a case-insensitive filesystem.
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
index 5430b72..5a4b097 100644
--- a/lisp/emacs-lisp/debug.el
+++ b/lisp/emacs-lisp/debug.el
@@ -274,15 +274,14 @@ debugger-setup-buffer
(let ((standard-output (current-buffer))
(print-escape-newlines t)
(print-level 8)
- (print-length 50))
- (backtrace))
+ (print-length 50))
+ ;; FIXME the debugger could pass a custom callback to mapbacktrace
+ ;; instead of manipulating printed results.
+ (mapbacktrace #'backtrace--print-frame 'debug))
(goto-char (point-min))
(delete-region (point)
(progn
- (search-forward (if debugger-stack-frame-as-list
- "\n (debug "
- "\n debug("))
- (forward-line (if (eq (car args) 'debug)
+ (forward-line (if (eq (car args) 'debug)
;; Remove debug--implement-debug-on-entry
;; and the advice's `apply' frame.
3
diff --git a/lisp/subr.el b/lisp/subr.el
index 5da5bf8..cb32e66 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4333,6 +4333,42 @@ define-mail-user-agent
(put symbol 'sendfunc sendfunc)
(put symbol 'abortfunc (or abortfunc 'kill-buffer))
(put symbol 'hookvar (or hookvar 'mail-send-hook)))
+
+\f
+(defun backtrace--print-frame (evald func args flags)
+ "Print a trace of a single stack frame to `standard-output'.
+EVALD, FUNC, ARGS, FLAGS are as in `mapbacktrace'."
+ (princ (if (plist-get flags :debug-on-exit) "* " " "))
+ (cond
+ ((and evald (not debugger-stack-frame-as-list))
+ (prin1 func)
+ (if args (prin1 args) (princ "()")))
+ (t
+ (prin1 (cons func args))))
+ (princ "\n"))
+
+(defun backtrace ()
+ "Print a trace of Lisp function calls currently active.
+Output stream used is value of `standard-output'."
+ (let ((print-level (or print-level 8)))
+ (mapbacktrace #'backtrace--print-frame 'backtrace)))
+
+(defun backtrace-frame (nframes &optional base)
+ "Return the function and arguments NFRAMES up from current execution point.
+If that frame has not evaluated the arguments yet (or is a special form),
+the value is (nil FUNCTION ARG-FORMS...).
+If that frame has evaluated its arguments and called its function already,
+the value is (t FUNCTION ARG-VALUES...).
+A &rest arg is represented as the tail of the list ARG-VALUES.
+FUNCTION is whatever was supplied as car of evaluated list,
+or a lambda expression for macro calls.
+If NFRAMES is more than the number of frames, the value is nil.
+If BASE is non-nil, it should be a function and NFRAMES counts from its
+nearest activation frame."
+ (backtrace-frame--internal
+ (lambda (evald func args _) `(,evald ,func ,@args))
+ nframes (or base 'backtrace-frame)))
+
\f
(defvar called-interactively-p-functions nil
"Special hook called to skip special frames in `called-interactively-p'.
diff --git a/src/eval.c b/src/eval.c
index 724f001..9baa811 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -3401,87 +3401,29 @@ context where binding is lexical by default. */)
}
\f
-DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
- doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
-The debugger is entered when that frame exits, if the flag is non-nil. */)
- (Lisp_Object level, Lisp_Object flag)
-{
- union specbinding *pdl = backtrace_top ();
- register EMACS_INT i;
-
- CHECK_NUMBER (level);
-
- for (i = 0; backtrace_p (pdl) && i < XINT (level); i++)
- pdl = backtrace_next (pdl);
-
- if (backtrace_p (pdl))
- set_backtrace_debug_on_exit (pdl, !NILP (flag));
-
- return flag;
-}
-
-DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
- doc: /* Print a trace of Lisp function calls currently active.
-Output stream used is value of `standard-output'. */)
- (void)
+static union specbinding *
+get_backtrace_starting_at (Lisp_Object base)
{
union specbinding *pdl = backtrace_top ();
- Lisp_Object tem;
- Lisp_Object old_print_level = Vprint_level;
-
- if (NILP (Vprint_level))
- XSETFASTINT (Vprint_level, 8);
- while (backtrace_p (pdl))
- {
- write_string (backtrace_debug_on_exit (pdl) ? "* " : " ");
- if (backtrace_nargs (pdl) == UNEVALLED)
- {
- Fprin1 (Fcons (backtrace_function (pdl), *backtrace_args (pdl)),
- Qnil);
- write_string ("\n");
- }
- else
- {
- tem = backtrace_function (pdl);
- if (debugger_stack_frame_as_list)
- write_string ("(");
- Fprin1 (tem, Qnil); /* This can QUIT. */
- if (!debugger_stack_frame_as_list)
- write_string ("(");
- {
- ptrdiff_t i;
- for (i = 0; i < backtrace_nargs (pdl); i++)
- {
- if (i || debugger_stack_frame_as_list)
- write_string(" ");
- Fprin1 (backtrace_args (pdl)[i], Qnil);
- }
- }
- write_string (")\n");
- }
- pdl = backtrace_next (pdl);
+ if (!NILP (base))
+ { /* Skip up to `base'. */
+ base = Findirect_function (base, Qt);
+ while (backtrace_p (pdl)
+ && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
+ pdl = backtrace_next (pdl);
}
- Vprint_level = old_print_level;
- return Qnil;
+ return pdl;
}
static union specbinding *
get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
{
- union specbinding *pdl = backtrace_top ();
register EMACS_INT i;
CHECK_NATNUM (nframes);
-
- if (!NILP (base))
- { /* Skip up to `base'. */
- base = Findirect_function (base, Qt);
- while (backtrace_p (pdl)
- && !EQ (base, Findirect_function (backtrace_function (pdl), Qt)))
- pdl = backtrace_next (pdl);
- }
+ union specbinding *pdl = get_backtrace_starting_at (base);
/* Find the frame requested. */
for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--)
@@ -3490,33 +3432,74 @@ get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
return pdl;
}
-DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 2, NULL,
- doc: /* Return the function and arguments NFRAMES up from current execution point.
-If that frame has not evaluated the arguments yet (or is a special form),
-the value is (nil FUNCTION ARG-FORMS...).
-If that frame has evaluated its arguments and called its function already,
-the value is (t FUNCTION ARG-VALUES...).
-A &rest arg is represented as the tail of the list ARG-VALUES.
-FUNCTION is whatever was supplied as car of evaluated list,
-or a lambda expression for macro calls.
-If NFRAMES is more than the number of frames, the value is nil.
-If BASE is non-nil, it should be a function and NFRAMES counts from its
-nearest activation frame. */)
- (Lisp_Object nframes, Lisp_Object base)
+Lisp_Object
+backtrace_frame_apply (Lisp_Object function, union specbinding *pdl)
{
- union specbinding *pdl = get_backtrace_frame (nframes, base);
-
if (!backtrace_p (pdl))
return Qnil;
+
+ Lisp_Object flags = Qnil;
+ if (backtrace_debug_on_exit (pdl))
+ {
+ flags = Fcons (QCdebug_on_exit, Fcons (Qt, Qnil));
+ }
+
if (backtrace_nargs (pdl) == UNEVALLED)
- return Fcons (Qnil,
- Fcons (backtrace_function (pdl), *backtrace_args (pdl)));
+ {
+ return call4 (function, Qnil, backtrace_function (pdl), *backtrace_args (pdl), flags);
+ }
else
{
Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
+ return call4 (function, Qt, backtrace_function (pdl), tem, flags);
+ }
+}
- return Fcons (Qt, Fcons (backtrace_function (pdl), tem));
+DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
+ doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
+The debugger is entered when that frame exits, if the flag is non-nil. */)
+ (Lisp_Object level, Lisp_Object flag)
+{
+ CHECK_NUMBER (level);
+ union specbinding *pdl = get_backtrace_frame(level, Qnil);
+
+ if (backtrace_p (pdl))
+ set_backtrace_debug_on_exit (pdl, !NILP (flag));
+
+ return flag;
+}
+
+DEFUN ("mapbacktrace", Fmapbacktrace, Smapbacktrace, 1, 2, 0,
+ doc: /* Call FUNCTION for each frame in backtrace.
+FUNCTION is called with 4 arguments EVALD FUNC ARGS FLAGS. If a frame
+has not evaluated its arguments yet or is a special form, EVALD is nil
+and ARGS is a list of forms. If a frame has evaluated its arguments
+and called its function already, EVALD is t and ARGS is a list of
+values. FLAGS is a plist of properties of the current frame:
+currently, the only supported property is :debug-on-exit.
+If BASE is non-nil, it should be a function and iteration will start
+from its nearest activation frame.
+`mapbacktrace' always returns nil. */)
+ (Lisp_Object function, Lisp_Object base)
+{
+ union specbinding *pdl = get_backtrace_starting_at (base);
+
+ while (backtrace_p (pdl))
+ {
+ backtrace_frame_apply (function, pdl);
+ pdl = backtrace_next (pdl);
}
+
+ return Qnil;
+}
+
+DEFUN ("backtrace-frame--internal", Fbacktrace_frame_internal,
+ Sbacktrace_frame_internal, 3, 3, NULL,
+ doc: /* Call FUNCTION on stack frame NFRAMES away from BASE.
+Return the result of FUNCTION, or nil if no matching frame could be found. */)
+ (Lisp_Object function, Lisp_Object nframes, Lisp_Object base)
+{
+ return backtrace_frame_apply (function, get_backtrace_frame (nframes, base));
}
/* For backtrace-eval, we want to temporarily unwind the last few elements of
@@ -3973,8 +3956,9 @@ alist of active lexical bindings. */);
defsubr (&Srun_hook_wrapped);
defsubr (&Sfetch_bytecode);
defsubr (&Sbacktrace_debug);
- defsubr (&Sbacktrace);
- defsubr (&Sbacktrace_frame);
+ DEFSYM (QCdebug_on_exit, ":debug-on-exit");
+ defsubr (&Smapbacktrace);
+ defsubr (&Sbacktrace_frame_internal);
defsubr (&Sbacktrace_eval);
defsubr (&Sbacktrace__locals);
defsubr (&Sspecial_variable_p);
--
2.7.4
[-- Attachment #2: OpenPGP digital signature --]
[-- Type: application/pgp-signature, Size: 819 bytes --]
next prev parent reply other threads:[~2016-12-05 16:31 UTC|newest]
Thread overview: 19+ messages / expand[flat|nested] mbox.gz Atom feed top
[not found] <20160922231447.GA3833@odonien.localdomain>
[not found] ` <98fbb582-3da4-bd83-a2e9-e341dd7f6140@gmail.com>
[not found] ` <20160923075116.GA612@odonien.localdomain>
[not found] ` <82e39377-f31b-698c-5a9a-343868686799@gmail.com>
[not found] ` <20161202005226.GA4215@odonien.localdomain>
2016-12-02 1:23 ` bug#24514: 24.5; Lispy backtraces Clément Pit--Claudel
2016-12-02 2:24 ` Stefan Monnier
2016-12-03 22:15 ` Clément Pit--Claudel
2016-12-04 15:30 ` Eli Zaretskii
2016-12-04 19:27 ` Clément Pit--Claudel
2016-12-04 20:41 ` Eli Zaretskii
2016-12-04 22:14 ` Clément Pit--Claudel
2016-12-05 3:30 ` Eli Zaretskii
2016-12-05 6:02 ` Lisp-friendly backtraces [was: Lispy backtraces] Clément Pit--Claudel
2016-12-05 13:20 ` Stefan Monnier
2016-12-05 14:14 ` Clément Pit--Claudel
2016-12-05 14:37 ` Stefan Monnier
2016-12-05 16:31 ` Clément Pit--Claudel [this message]
2016-12-05 16:54 ` Eli Zaretskii
2016-12-05 16:23 ` Eli Zaretskii
2016-12-05 18:59 ` Clément Pit--Claudel
2016-12-06 18:55 ` Eli Zaretskii
2016-12-07 8:27 ` Clément Pit--Claudel
2016-12-12 22:42 ` Clément Pit--Claudel
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=e2ab0ea3-da80-233a-7f64-559aed4de06e@gmail.com \
--to=clement.pit@gmail.com \
--cc=emacs-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).