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'.

* test/lisp/subr-tests.el (subr-test-backtrace-simple-tests)
(subr-test-backtrace-integration-test): New tests.

* doc/lispref/debugging.texi (Internals of Debugger): Document
`mapbacktrace' and missing argument BASE of `backtrace-frame'.

1 files changed, 45 insertions, 0 deletions

diff --git a/lisp/subr.el b/lisp/subr.el
index 952453a9cc0..99b142993fc 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -4334,6 +4334,51 @@ The properties used on SYMBOL are `composefunc', `sendfunc',
   (put symbol 'sendfunc sendfunc)
   (put symbol 'abortfunc (or abortfunc 'kill-buffer))
   (put symbol 'hookvar (or hookvar 'mail-send-hook)))
+
+
+(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-frames (&optional base)
+  "Collect all frames of current backtrace into a list.
+If non-nil, BASE should be a function, and frames before its
+nearest activation frames are discarded."
+  (let ((frames nil))
+    (mapbacktrace (lambda (&rest frame) (push frame frames))
+                  (or base 'backtrace-frames))
+    (nreverse frames)))
+
+(defun backtrace-frame (nframes &optional base)
+  "Return the function and arguments NFRAMES up from current execution point.
+If non-nil, BASE should be a function, and NFRAMES counts from its
+nearest activation frame.
+If the frame has not evaluated the arguments yet (or is a special form),
+the value is (nil FUNCTION ARG-FORMS...).
+If the 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."
+  (backtrace-frame--internal
+   (lambda (evald func args _) `(,evald ,func ,@args))
+   nframes (or base 'backtrace-frame)))
+
 
 (defvar called-interactively-p-functions nil
   "Special hook called to skip special frames in `called-interactively-p'.