- union specbinding *pdl = get_backtrace_frame (nframes, base);
-
- if (!backtrace_p (pdl))
- return Qnil;
- if (backtrace_nargs (pdl) == UNEVALLED)
- return Fcons (Qnil,
- Fcons (backtrace_function (pdl), *backtrace_args (pdl)));
- else
- {
- Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
-
- return Fcons (Qt, Fcons (backtrace_function (pdl), tem));
- }
-}
-
-/* For backtrace-eval, we want to temporarily unwind the last few elements of
- the specpdl stack, and then rewind them. We store the pre-unwind values
- directly in the pre-existing specpdl elements (i.e. we swap the current
- value and the old value stored in the specpdl), kind of like the inplace
- pointer-reversal trick. As it turns out, the rewind does the same as the
- unwind, except it starts from the other end of the specpdl stack, so we use
- the same function for both unwind and rewind. */
-static void
-backtrace_eval_unrewind (int distance)
-{
- union specbinding *tmp = specpdl_ptr;
- int step = -1;
- if (distance < 0)
- { /* It's a rewind rather than unwind. */
- tmp += distance - 1;
- step = 1;
- distance = -distance;
- }
-
- for (; distance > 0; distance--)
- {
- tmp += step;
- /* */
- switch (tmp->kind)
- {
- /* FIXME: Ideally we'd like to "temporarily unwind" (some of) those
- unwind_protect, but the problem is that we don't know how to
- rewind them afterwards. */
- case SPECPDL_UNWIND:
- case SPECPDL_UNWIND_PTR:
- case SPECPDL_UNWIND_INT:
- case SPECPDL_UNWIND_VOID:
- case SPECPDL_BACKTRACE:
- break;
- case SPECPDL_LET:
- { /* If variable has a trivial value (no forwarding), we can
- just set it. No need to check for constant symbols here,
- since that was already done by specbind. */
- struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (tmp));
- if (sym->redirect == SYMBOL_PLAINVAL)
- {
- Lisp_Object old_value = specpdl_old_value (tmp);
- set_specpdl_old_value (tmp, SYMBOL_VAL (sym));
- SET_SYMBOL_VAL (sym, old_value);
- break;
- }
- else
- { /* FALLTHROUGH!!
- NOTE: we only ever come here if make_local_foo was used for
- the first time on this var within this let. */
- }
- }
- case SPECPDL_LET_DEFAULT:
- {
- Lisp_Object sym = specpdl_symbol (tmp);
- Lisp_Object old_value = specpdl_old_value (tmp);
- set_specpdl_old_value (tmp, Fdefault_value (sym));
- Fset_default (sym, old_value);
- }
- break;
- case SPECPDL_LET_LOCAL:
- {
- Lisp_Object symbol = specpdl_symbol (tmp);
- Lisp_Object where = specpdl_where (tmp);
- Lisp_Object old_value = specpdl_old_value (tmp);
- eassert (BUFFERP (where));
-
- /* If this was a local binding, reset the value in the appropriate
- buffer, but only if that buffer's binding still exists. */
- if (!NILP (Flocal_variable_p (symbol, where)))
- {
- set_specpdl_old_value
- (tmp, Fbuffer_local_value (symbol, where));
- set_internal (symbol, old_value, where, 1);
- }
- }
- break;
- }
- }
-}
-
-DEFUN ("backtrace-eval", Fbacktrace_eval, Sbacktrace_eval, 2, 3, NULL,
- doc: /* Evaluate EXP in the context of some activation frame.
-NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
- (Lisp_Object exp, Lisp_Object nframes, Lisp_Object base)
-{
- union specbinding *pdl = get_backtrace_frame (nframes, base);
- ptrdiff_t count = SPECPDL_INDEX ();
- ptrdiff_t distance = specpdl_ptr - pdl;
- eassert (distance >= 0);
-
- if (!backtrace_p (pdl))
- error ("Activation frame not found!");
-
- backtrace_eval_unrewind (distance);
- record_unwind_protect_int (backtrace_eval_unrewind, -distance);
-
- /* Use eval_sub rather than Feval since the main motivation behind
- backtrace-eval is to be able to get/set the value of lexical variables
- from the debugger. */
- return unbind_to (count, eval_sub (exp));
-}
-
-DEFUN ("backtrace--locals", Fbacktrace__locals, Sbacktrace__locals, 1, 2, NULL,
- doc: /* Return names and values of local variables of a stack frame.
-NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */)
- (Lisp_Object nframes, Lisp_Object base)
-{
- union specbinding *frame = get_backtrace_frame (nframes, base);
- union specbinding *prevframe
- = get_backtrace_frame (make_number (XFASTINT (nframes) - 1), base);
- ptrdiff_t distance = specpdl_ptr - frame;
- Lisp_Object result = Qnil;
- eassert (distance >= 0);
-
- if (!backtrace_p (prevframe))
- error ("Activation frame not found!");
- if (!backtrace_p (frame))
- error ("Activation frame not found!");
-
- /* The specpdl entries normally contain the symbol being bound along with its
- `old_value', so it can be restored. The new value to which it is bound is
- available in one of two places: either in the current value of the
- variable (if it hasn't been rebound yet) or in the `old_value' slot of the
- next specpdl entry for it.
- `backtrace_eval_unrewind' happens to swap the role of `old_value'
- and "new value", so we abuse it here, to fetch the new value.
- It's ugly (we'd rather not modify global data) and a bit inefficient,
- but it does the job for now. */
- backtrace_eval_unrewind (distance);
-
- /* Grab values. */
- {
- union specbinding *tmp = prevframe;
- for (; tmp > frame; tmp--)
- {
- switch (tmp->kind)
- {
- case SPECPDL_LET:
- case SPECPDL_LET_DEFAULT:
- case SPECPDL_LET_LOCAL:
- {
- Lisp_Object sym = specpdl_symbol (tmp);
- Lisp_Object val = specpdl_old_value (tmp);
- if (EQ (sym, Qinternal_interpreter_environment))
- {
- Lisp_Object env = val;
- for (; CONSP (env); env = XCDR (env))
- {
- Lisp_Object binding = XCAR (env);
- if (CONSP (binding))
- result = Fcons (Fcons (XCAR (binding),
- XCDR (binding)),
- result);
- }
- }
- else
- result = Fcons (Fcons (sym, val), result);
- }
- }
- }
- }
-
- /* Restore values from specpdl to original place. */
- backtrace_eval_unrewind (-distance);