procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge the specpdl and backtrace stacks. Make the structure of the

Browse source 
specpdl entries more obvious via a tagged union of structs.
* src/lisp.h (BITS_PER_PTRDIFF_T): New constant.
(enum specbind_tag): New enum.
(struct specbinding): Make it a tagged union of structs.
Add a case for backtrace records.
(specpdl_symbol, specpdl_old_value, specpdl_where, specpdl_arg)
(specpdl_func, backtrace_function, backtrace_nargs, backtrace_args)
(backtrace_debug_on_exit): New accessors.
(struct backtrace): Remove.
(struct catchtag): Remove backlist field.
* src/data.c (let_shadows_buffer_binding_p, let_shadows_global_binding_p):
Move to eval.c.
(Flocal_variable_p): Speed up the common case where the binding is
already loaded.
* src/eval.c (backtrace_list): Remove.
(set_specpdl_symbol, set_specpdl_old_value): Remove.
(set_backtrace_args, set_backtrace_nargs)
(set_backtrace_debug_on_exit, backtrace_p, backtrace_top)
(backtrace_next): New functions.
(Fdefvaralias, Fdefvar): Adjust to new specpdl format.
(unwind_to_catch, internal_lisp_condition_case)
(internal_condition_case, internal_condition_case_1)
(internal_condition_case_2, internal_condition_case_n): Don't bother
with backtrace_list any more.
(Fsignal): Adjust to new backtrace format.
(grow_specpdl): Move up.
(record_in_backtrace): New function.
(eval_sub, Ffuncall): Use it.
(apply_lambda): Adjust to new backtrace format.
(let_shadows_buffer_binding_p, let_shadows_global_binding_p): Move from
data.c.
(specbind): Adjust to new specpdl format.  Simplify.
(record_unwind_protect, unbind_to): Adjust to new specpdl format.
(Fbacktrace_debug, Fbacktrace, Fbacktrace_frame): Adjust to new
backtrace format.
(mark_backtrace): Remove.
(mark_specpdl, get_backtrace, backtrace_top_function): New functions.
* src/xdisp.c (redisplay_internal): Use record_in_backtrace.
* src/alloc.c (Fgarbage_collect): Use record_in_backtrace.
Use mark_specpdl.
* src/profiler.c (record_backtrace): Use get_backtrace.
(handle_profiler_signal): Use backtrace_top_function.
* src/.gdbinit (xbacktrace, hookpost-backtrace): Use new backtrace
accessor functions.
This commit is contained in:
Stefan Monnier 2013-06-03 05:01:53 -04:00
parent e5e4a94293
commit 2f592f95d2
8 changed files with 423 additions and 333 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
src/.gdbinit
View file

@ -1150,17 +1150,18 @@ Print $ assuming it is a list font (font-spec, font-entity, or font-object).
end
define xbacktrace
set $bt = backtrace_list
while $bt
xgettype ($bt->function)
set $bt = backtrace_top ()
while backtrace_p ($bt)
set $fun = backtrace_function ($bt)
xgettype $fun
if $type == Lisp_Symbol
xprintsym ($bt->function)
printf " (0x%x)\n", $bt->args
xprintsym $fun
printf " (0x%x)\n", backtrace_args ($bt)
else
xgetptr $bt->function
xgetptr $fun
printf "0x%x ", $ptr
if $type == Lisp_Vectorlike
xgetptr ($bt->function)
xgetptr $fun
set $size = ((struct Lisp_Vector *) $ptr)->header.size
if ($size & PSEUDOVECTOR_FLAG)
output (enum pvec_type) (($size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS)
@ -1172,7 +1173,7 @@ define xbacktrace
end
echo \n
end
set $bt = $bt->next
set $bt = backtrace_next ($bt)
end
end
document xbacktrace
@ -1220,8 +1221,8 @@ end
# Show Lisp backtrace after normal backtrace.
define hookpost-backtrace
set $bt = backtrace_list
if $bt
set $bt = backtrace_top ()
if backtrace_p ($bt)
echo \n
echo Lisp Backtrace:\n
xbacktrace

48
src/ChangeLog
View file

@ -1,3 +1,51 @@
2013-06-03 Stefan Monnier <monnier@iro.umontreal.ca>
Merge the specpdl and backtrace stacks. Make the structure of the
specpdl entries more obvious via a tagged union of structs.
* lisp.h (BITS_PER_PTRDIFF_T): New constant.
(enum specbind_tag): New enum.
(struct specbinding): Make it a tagged union of structs.
Add a case for backtrace records.
(specpdl_symbol, specpdl_old_value, specpdl_where, specpdl_arg)
(specpdl_func, backtrace_function, backtrace_nargs, backtrace_args)
(backtrace_debug_on_exit): New accessors.
(struct backtrace): Remove.
(struct catchtag): Remove backlist field.
* data.c (let_shadows_buffer_binding_p, let_shadows_global_binding_p):
Move to eval.c.
(Flocal_variable_p): Speed up the common case where the binding is
already loaded.
* eval.c (backtrace_list): Remove.
(set_specpdl_symbol, set_specpdl_old_value): Remove.
(set_backtrace_args, set_backtrace_nargs)
(set_backtrace_debug_on_exit, backtrace_p, backtrace_top)
(backtrace_next): New functions.
(Fdefvaralias, Fdefvar): Adjust to new specpdl format.
(unwind_to_catch, internal_lisp_condition_case)
(internal_condition_case, internal_condition_case_1)
(internal_condition_case_2, internal_condition_case_n): Don't bother
with backtrace_list any more.
(Fsignal): Adjust to new backtrace format.
(grow_specpdl): Move up.
(record_in_backtrace): New function.
(eval_sub, Ffuncall): Use it.
(apply_lambda): Adjust to new backtrace format.
(let_shadows_buffer_binding_p, let_shadows_global_binding_p): Move from
data.c.
(specbind): Adjust to new specpdl format. Simplify.
(record_unwind_protect, unbind_to): Adjust to new specpdl format.
(Fbacktrace_debug, Fbacktrace, Fbacktrace_frame): Adjust to new
backtrace format.
(mark_backtrace): Remove.
(mark_specpdl, get_backtrace, backtrace_top_function): New functions.
* xdisp.c (redisplay_internal): Use record_in_backtrace.
* alloc.c (Fgarbage_collect): Use record_in_backtrace.
Use mark_specpdl.
* profiler.c (record_backtrace): Use get_backtrace.
(handle_profiler_signal): Use backtrace_top_function.
* .gdbinit (xbacktrace, hookpost-backtrace): Use new backtrace
accessor functions.
2013-06-02 Jan Djärv <jan.h.d@swipnet.se>
* process.h (catch_child_signal): Declare.

17
src/alloc.c
View file

@ -5165,7 +5165,6 @@ returns nil, because real GC can't be done.
See Info node `(elisp)Garbage Collection'. */)
(void)
{
struct specbinding *bind;
struct buffer *nextb;
char stack_top_variable;
ptrdiff_t i;
@ -5174,7 +5173,6 @@ See Info node `(elisp)Garbage Collection'. */)
EMACS_TIME start;
Lisp_Object retval = Qnil;
size_t tot_before = 0;
struct backtrace backtrace;
if (abort_on_gc)
emacs_abort ();
@ -5185,12 +5183,7 @@ See Info node `(elisp)Garbage Collection'. */)
return Qnil;
/* Record this function, so it appears on the profiler's backtraces. */
backtrace.next = backtrace_list;
backtrace.function = Qautomatic_gc;
backtrace.args = &Qnil;
backtrace.nargs = 0;
backtrace.debug_on_exit = 0;
backtrace_list = &backtrace;
record_in_backtrace (Qautomatic_gc, &Qnil, 0);
check_cons_list ();
@ -5257,11 +5250,7 @@ See Info node `(elisp)Garbage Collection'. */)
for (i = 0; i < staticidx; i++)
mark_object (*staticvec[i]);
for (bind = specpdl; bind != specpdl_ptr; bind++)
{
mark_object (bind->symbol);
mark_object (bind->old_value);
}
mark_specpdl ();
mark_terminals ();
mark_kboards ();
@ -5295,7 +5284,6 @@ See Info node `(elisp)Garbage Collection'. */)
mark_object (handler->var);
}
}
mark_backtrace ();
#endif
#ifdef HAVE_WINDOW_SYSTEM
@ -5486,7 +5474,6 @@ See Info node `(elisp)Garbage Collection'. */)
malloc_probe (swept);
}
backtrace_list = backtrace.next;
return retval;
}

57
src/data.c
View file

@ -1069,40 +1069,6 @@ DEFUN ("set", Fset, Sset, 2, 2, 0,
return newval;
}
/* Return true if SYMBOL currently has a let-binding
which was made in the buffer that is now current. */
static bool
let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
{
struct specbinding *p;
for (p = specpdl_ptr; p > specpdl; )
if ((--p)->func == NULL
&& CONSP (p->symbol))
{
struct Lisp_Symbol *let_bound_symbol = XSYMBOL (XCAR (p->symbol));
eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
if (symbol == let_bound_symbol
&& XBUFFER (XCDR (XCDR (p->symbol))) == current_buffer)
return 1;
}
return 0;
}
static bool
let_shadows_global_binding_p (Lisp_Object symbol)
{
struct specbinding *p;
for (p = specpdl_ptr; p > specpdl; )
if ((--p)->func == NULL && EQ (p->symbol, symbol))
return 1;
return 0;
}
/* Store the value NEWVAL into SYMBOL.
If buffer/frame-locality is an issue, WHERE specifies which context to use.
(nil stands for the current buffer/frame).
@ -1841,17 +1807,18 @@ BUFFER defaults to the current buffer. */)
XSETBUFFER (tmp, buf);
XSETSYMBOL (variable, sym); /* Update in case of aliasing. */
for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
{
elt = XCAR (tail);
if (EQ (variable, XCAR (elt)))
{
eassert (!blv->frame_local);
eassert (blv_found (blv) || !EQ (blv->where, tmp));
return Qt;
}
}
eassert (!blv_found (blv) || !EQ (blv->where, tmp));
if (EQ (blv->where, tmp)) /* The binding is already loaded. */
return blv_found (blv) ? Qt : Qnil;
else
for (tail = BVAR (buf, local_var_alist); CONSP (tail); tail = XCDR (tail))
{
elt = XCAR (tail);
if (EQ (variable, XCAR (elt)))
{
eassert (!blv->frame_local);
return Qt;
}
}
return Qnil;
}
case SYMBOL_FORWARDED:

482
src/eval.c
View file

@ -32,8 +32,6 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "xterm.h"
#endif
struct backtrace *backtrace_list;
#if !BYTE_MARK_STACK
static
#endif
@ -105,7 +103,7 @@ static EMACS_INT when_entered_debugger;
/* The function from which the last `signal' was called. Set in
Fsignal. */
/* FIXME: We should probably get rid of this! */
Lisp_Object Vsignaling_function;
/* If non-nil, Lisp code must not be run since some part of Emacs is
@ -117,19 +115,36 @@ Lisp_Object inhibit_lisp_code;
static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
/* Functions to set Lisp_Object slots of struct specbinding. */
/* Functions to modify slots of backtrace records. */
static void
set_specpdl_symbol (Lisp_Object symbol)
static void set_backtrace_args (struct specbinding *pdl, Lisp_Object *args)
{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.args = args; }
static void set_backtrace_nargs (struct specbinding *pdl, ptrdiff_t n)
{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.nargs = n; }
void set_backtrace_debug_on_exit (struct specbinding *pdl, bool doe)
{ eassert (pdl->kind == SPECPDL_BACKTRACE); pdl->v.bt.debug_on_exit = doe; }
/* Helper functions to scan the backtrace. */
LISP_INLINE bool backtrace_p (struct specbinding *pdl)
{ return pdl >= specpdl; }
LISP_INLINE struct specbinding *backtrace_top (void)
{
specpdl_ptr->symbol = symbol;
struct specbinding *pdl = specpdl_ptr - 1;
while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE) \
pdl--;
return pdl;
}
LISP_INLINE struct specbinding *backtrace_next (struct specbinding *pdl)
{
pdl--;
while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE)
pdl--;
return pdl;
}
static void
set_specpdl_old_value (Lisp_Object oldval)
{
specpdl_ptr->old_value = oldval;
}
void
init_eval_once (void)
@ -151,7 +166,6 @@ init_eval (void)
specpdl_ptr = specpdl;
catchlist = 0;
handlerlist = 0;
backtrace_list = 0;
Vquit_flag = Qnil;
debug_on_next_call = 0;
lisp_eval_depth = 0;
@ -234,7 +248,7 @@ static void
do_debug_on_call (Lisp_Object code)
{
debug_on_next_call = 0;
backtrace_list->debug_on_exit = 1;
set_backtrace_debug_on_exit (specpdl_ptr - 1, true);
call_debugger (Fcons (code, Qnil));
}
@ -530,9 +544,8 @@ The return value is BASE-VARIABLE. */)
struct specbinding *p;
for (p = specpdl_ptr; p > specpdl; )
if ((--p)->func == NULL
&& (EQ (new_alias,
CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
if ((--p)->kind >= SPECPDL_LET
&& (EQ (new_alias, specpdl_symbol (p))))
error ("Don't know how to make a let-bound variable an alias");
}
@ -597,8 +610,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
struct specbinding *pdl = specpdl_ptr;
while (pdl > specpdl)
{
if (EQ ((--pdl)->symbol, sym) && !pdl->func
&& EQ (pdl->old_value, Qunbound))
if ((--pdl)->kind >= SPECPDL_LET
&& EQ (specpdl_symbol (pdl), sym)
&& EQ (specpdl_old_value (pdl), Qunbound))
{
message_with_string
("Warning: defvar ignored because %s is let-bound",
@ -937,7 +951,7 @@ usage: (catch TAG BODY...) */)
/* Set up a catch, then call C function FUNC on argument ARG.
FUNC should return a Lisp_Object.
This is how catches are done from within C code. */
This is how catches are done from within C code. */
Lisp_Object
internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
@ -949,7 +963,6 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
c.next = catchlist;
c.tag = tag;
c.val = Qnil;
c.backlist = backtrace_list;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
@ -1014,7 +1027,6 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
#ifdef DEBUG_GCPRO
gcpro_level = gcprolist ? gcprolist->level + 1 : 0;
#endif
backtrace_list = catch->backlist;
lisp_eval_depth = catch->lisp_eval_depth;
sys_longjmp (catch->jmp, 1);
@ -1115,7 +1127,6 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
@ -1131,7 +1142,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
/* Note that this just undoes the binding of h.var; whoever
longjumped to us unwound the stack to c.pdlcount before
throwing. */
throwing. */
unbind_to (c.pdlcount, Qnil);
return val;
}
@ -1170,7 +1181,6 @@ internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
@ -1208,7 +1218,6 @@ internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
@ -1250,7 +1259,6 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
@ -1294,7 +1302,6 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
c.tag = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
@ -1362,7 +1369,6 @@ See also the function `condition-case'. */)
= (NILP (error_symbol) ? Fcar (data) : error_symbol);
register Lisp_Object clause = Qnil;
struct handler *h;
struct backtrace *bp;
immediate_quit = 0;
abort_on_gc = 0;
@ -1398,13 +1404,13 @@ See also the function `condition-case'. */)
too. Don't do this when ERROR_SYMBOL is nil, because that
is a memory-full error. */
Vsignaling_function = Qnil;
if (backtrace_list && !NILP (error_symbol))
if (!NILP (error_symbol))
{
bp = backtrace_list->next;
if (bp && EQ (bp->function, Qerror))
bp = bp->next;
if (bp)
Vsignaling_function = bp->function;
struct specbinding *pdl = backtrace_next (backtrace_top ());
if (backtrace_p (pdl) && EQ (backtrace_function (pdl), Qerror))
pdl = backtrace_next (pdl);
if (backtrace_p (pdl))
Vsignaling_function = backtrace_function (pdl);
}
for (h = handlerlist; h; h = h->next)
@ -1901,6 +1907,36 @@ If LEXICAL is t, evaluate using lexical scoping. */)
return unbind_to (count, eval_sub (form));
}
static void
grow_specpdl (void)
{
register ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX);
if (max_size <= specpdl_size)
{
if (max_specpdl_size < 400)
max_size = max_specpdl_size = 400;
if (max_size <= specpdl_size)
signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
}
specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl);
specpdl_ptr = specpdl + count;
}
LISP_INLINE void
record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
{
eassert (nargs >= UNEVALLED);
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
specpdl_ptr->kind = SPECPDL_BACKTRACE;
specpdl_ptr->v.bt.function = function;
specpdl_ptr->v.bt.args = args;
specpdl_ptr->v.bt.nargs = nargs;
specpdl_ptr->v.bt.debug_on_exit = false;
specpdl_ptr++;
}
/* Eval a sub-expression of the current expression (i.e. in the same
lexical scope). */
Lisp_Object
@ -1908,7 +1944,6 @@ eval_sub (Lisp_Object form)
{
Lisp_Object fun, val, original_fun, original_args;
Lisp_Object funcar;
struct backtrace backtrace;
struct gcpro gcpro1, gcpro2, gcpro3;
if (SYMBOLP (form))
@ -1946,12 +1981,8 @@ eval_sub (Lisp_Object form)
original_fun = XCAR (form);
original_args = XCDR (form);
backtrace.next = backtrace_list;
backtrace.function = original_fun; /* This also protects them from gc. */
backtrace.args = &original_args;
backtrace.nargs = UNEVALLED;
backtrace.debug_on_exit = 0;
backtrace_list = &backtrace;
/* This also protects them from gc. */
record_in_backtrace (original_fun, &original_args, UNEVALLED);
if (debug_on_next_call)
do_debug_on_call (Qt);
@ -2005,8 +2036,8 @@ eval_sub (Lisp_Object form)
gcpro3.nvars = argnum;
}
backtrace.args = vals;
backtrace.nargs = XINT (numargs);
set_backtrace_args (specpdl_ptr - 1, vals);
set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs));
val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
UNGCPRO;
@ -2027,8 +2058,8 @@ eval_sub (Lisp_Object form)
UNGCPRO;
backtrace.args = argvals;
backtrace.nargs = XINT (numargs);
set_backtrace_args (specpdl_ptr - 1, argvals);
set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs));
switch (i)
{
@ -2118,9 +2149,9 @@ eval_sub (Lisp_Object form)
check_cons_list ();
lisp_eval_depth--;
if (backtrace.debug_on_exit)
if (backtrace_debug_on_exit (specpdl_ptr - 1))
val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
backtrace_list = backtrace.next;
specpdl_ptr--;
return val;
}
@ -2600,7 +2631,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
ptrdiff_t numargs = nargs - 1;
Lisp_Object lisp_numargs;
Lisp_Object val;
struct backtrace backtrace;
register Lisp_Object *internal_args;
ptrdiff_t i;
@ -2614,12 +2644,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
error ("Lisp nesting exceeds `max-lisp-eval-depth'");
}
backtrace.next = backtrace_list;
backtrace.function = args[0];
backtrace.args = &args[1]; /* This also GCPROs them. */
backtrace.nargs = nargs - 1;
backtrace.debug_on_exit = 0;
backtrace_list = &backtrace;
/* This also GCPROs them. */
record_in_backtrace (args[0], &args[1], nargs - 1);
/* Call GC after setting up the backtrace, so the latter GCPROs the args. */
maybe_gc ();
@ -2744,9 +2770,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */)
}
check_cons_list ();
lisp_eval_depth--;
if (backtrace.debug_on_exit)
if (backtrace_debug_on_exit (specpdl_ptr - 1))
val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
backtrace_list = backtrace.next;
specpdl_ptr--;
return val;
}
@ -2778,15 +2804,17 @@ apply_lambda (Lisp_Object fun, Lisp_Object args)
UNGCPRO;
backtrace_list->args = arg_vector;
backtrace_list->nargs = i;
set_backtrace_args (specpdl_ptr - 1, arg_vector);
set_backtrace_nargs (specpdl_ptr - 1, i);
tem = funcall_lambda (fun, numargs, arg_vector);
/* Do the debug-on-exit now, while arg_vector still exists. */
if (backtrace_list->debug_on_exit)
tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
/* Don't do it again when we return to eval. */
backtrace_list->debug_on_exit = 0;
if (backtrace_debug_on_exit (specpdl_ptr - 1))
{
/* Don't do it again when we return to eval. */
set_backtrace_debug_on_exit (specpdl_ptr - 1, false);
tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
}
SAFE_FREE ();
return tem;
}
@ -2936,20 +2964,38 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
return object;
}
static void
grow_specpdl (void)
/* Return true if SYMBOL currently has a let-binding
which was made in the buffer that is now current. */
bool
let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol)
{
register ptrdiff_t count = SPECPDL_INDEX ();
ptrdiff_t max_size = min (max_specpdl_size, PTRDIFF_MAX);
if (max_size <= specpdl_size)
{
if (max_specpdl_size < 400)
max_size = max_specpdl_size = 400;
if (max_size <= specpdl_size)
signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
}
specpdl = xpalloc (specpdl, &specpdl_size, 1, max_size, sizeof *specpdl);
specpdl_ptr = specpdl + count;
struct specbinding *p;
Lisp_Object buf = Fcurrent_buffer ();
for (p = specpdl_ptr; p > specpdl; )
if ((--p)->kind > SPECPDL_LET)
{
struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p));
eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS);
if (symbol == let_bound_symbol
&& EQ (specpdl_where (p), buf))
return 1;
}
return 0;
}
bool
let_shadows_global_binding_p (Lisp_Object symbol)
{
struct specbinding *p;
for (p = specpdl_ptr; p > specpdl; )
if ((--p)->kind >= SPECPDL_LET && EQ (specpdl_symbol (p), symbol))
return 1;
return 0;
}
/* `specpdl_ptr->symbol' is a field which describes which variable is
@ -2985,9 +3031,9 @@ specbind (Lisp_Object symbol, Lisp_Object value)
case SYMBOL_PLAINVAL:
/* The most common case is that of a non-constant symbol with a
trivial value. Make that as fast as we can. */
set_specpdl_symbol (symbol);
set_specpdl_old_value (SYMBOL_VAL (sym));
specpdl_ptr->func = NULL;
specpdl_ptr->kind = SPECPDL_LET;
specpdl_ptr->v.let.symbol = symbol;
specpdl_ptr->v.let.old_value = SYMBOL_VAL (sym);
++specpdl_ptr;
if (!sym->constant)
SET_SYMBOL_VAL (sym, value);
@ -3000,59 +3046,36 @@ specbind (Lisp_Object symbol, Lisp_Object value)
case SYMBOL_FORWARDED:
{
Lisp_Object ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
set_specpdl_old_value (ovalue);
specpdl_ptr->kind = SPECPDL_LET_LOCAL;
specpdl_ptr->v.let.symbol = symbol;
specpdl_ptr->v.let.old_value = ovalue;
specpdl_ptr->v.let.where = Fcurrent_buffer ();
eassert (sym->redirect != SYMBOL_LOCALIZED
|| (EQ (SYMBOL_BLV (sym)->where,
SYMBOL_BLV (sym)->frame_local ?
Fselected_frame () : Fcurrent_buffer ())));
|| (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ())));
if (sym->redirect == SYMBOL_LOCALIZED
|| BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
if (sym->redirect == SYMBOL_LOCALIZED)
{
if (!blv_found (SYMBOL_BLV (sym)))
specpdl_ptr->kind = SPECPDL_LET_DEFAULT;
}
else if (BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
{
Lisp_Object where, cur_buf = Fcurrent_buffer ();
/* For a local variable, record both the symbol and which
buffer's or frame's value we are saving. */
if (!NILP (Flocal_variable_p (symbol, Qnil)))
{
eassert (sym->redirect != SYMBOL_LOCALIZED
|| (blv_found (SYMBOL_BLV (sym))
&& EQ (cur_buf, SYMBOL_BLV (sym)->where)));
where = cur_buf;
}
else if (sym->redirect == SYMBOL_LOCALIZED
&& blv_found (SYMBOL_BLV (sym)))
where = SYMBOL_BLV (sym)->where;
else
where = Qnil;
/* We're not using the `unused' slot in the specbinding
structure because this would mean we have to do more
work for simple variables. */
/* FIXME: The third value `current_buffer' is only used in
let_shadows_buffer_binding_p which is itself only used
in set_internal for local_if_set. */
eassert (NILP (where) || EQ (where, cur_buf));
set_specpdl_symbol (Fcons (symbol, Fcons (where, cur_buf)));
/* If SYMBOL is a per-buffer variable which doesn't have a
buffer-local value here, make the `let' change the global
value by changing the value of SYMBOL in all buffers not
having their own value. This is consistent with what
happens with other buffer-local variables. */
if (NILP (where)
&& sym->redirect == SYMBOL_FORWARDED)
if (NILP (Flocal_variable_p (symbol, Qnil)))
{
eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym)));
specpdl_ptr->kind = SPECPDL_LET_DEFAULT;
++specpdl_ptr;
Fset_default (symbol, value);
return;
}
}
else
set_specpdl_symbol (symbol);
specpdl_ptr->kind = SPECPDL_LET;
specpdl_ptr++;
set_internal (symbol, value, Qnil, 1);
@ -3067,9 +3090,9 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
{
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
specpdl_ptr->func = function;
set_specpdl_symbol (Qnil);
set_specpdl_old_value (arg);
specpdl_ptr->kind = SPECPDL_UNWIND;
specpdl_ptr->v.unwind.func = function;
specpdl_ptr->v.unwind.arg = arg;
specpdl_ptr++;
}
@ -3093,41 +3116,50 @@ unbind_to (ptrdiff_t count, Lisp_Object value)
struct specbinding this_binding;
this_binding = *--specpdl_ptr;
if (this_binding.func != 0)
(*this_binding.func) (this_binding.old_value);
/* If the symbol is a list, it is really (SYMBOL WHERE
. CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
frame. If WHERE is a buffer or frame, this indicates we
bound a variable that had a buffer-local or frame-local
binding. WHERE nil means that the variable had the default
value when it was bound. CURRENT-BUFFER is the buffer that
was current when the variable was bound. */
else if (CONSP (this_binding.symbol))
switch (this_binding.kind)
{
Lisp_Object symbol, where;
case SPECPDL_UNWIND:
(*specpdl_func (&this_binding)) (specpdl_arg (&this_binding));
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. */
if (XSYMBOL (specpdl_symbol (&this_binding))->redirect
== SYMBOL_PLAINVAL)
SET_SYMBOL_VAL (XSYMBOL (specpdl_symbol (&this_binding)),
specpdl_old_value (&this_binding));
else
/* NOTE: we only ever come here if make_local_foo was used for
the first time on this var within this let. */
Fset_default (specpdl_symbol (&this_binding),
specpdl_old_value (&this_binding));
break;
case SPECPDL_BACKTRACE:
break;
case SPECPDL_LET_LOCAL:
case SPECPDL_LET_DEFAULT:
{ /* If the symbol is a list, it is really (SYMBOL WHERE
. CURRENT-BUFFER) where WHERE is either nil, a buffer, or a
frame. If WHERE is a buffer or frame, this indicates we
bound a variable that had a buffer-local or frame-local
binding. WHERE nil means that the variable had the default
value when it was bound. CURRENT-BUFFER is the buffer that
was current when the variable was bound. */
Lisp_Object symbol = specpdl_symbol (&this_binding);
Lisp_Object where = specpdl_where (&this_binding);
eassert (BUFFERP (where));
symbol = XCAR (this_binding.symbol);
where = XCAR (XCDR (this_binding.symbol));
if (NILP (where))
Fset_default (symbol, this_binding.old_value);
/* If `where' is non-nil, reset the value in the appropriate
local binding, but only if that binding still exists. */
else if (BUFFERP (where)
? !NILP (Flocal_variable_p (symbol, where))
: !NILP (Fassq (symbol, XFRAME (where)->param_alist)))
set_internal (symbol, this_binding.old_value, where, 1);
if (this_binding.kind == SPECPDL_LET_DEFAULT)
Fset_default (symbol, specpdl_old_value (&this_binding));
/* If this was a local binding, reset the value in the appropriate
buffer, but only if that buffer's binding still exists. */
else if (!NILP (Flocal_variable_p (symbol, where)))
set_internal (symbol, specpdl_old_value (&this_binding),
where, 1);
}
break;
}
/* 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. */
else if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL)
SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol),
this_binding.old_value);
else
/* NOTE: we only ever come here if make_local_foo was used for
the first time on this var within this let. */
Fset_default (this_binding.symbol, this_binding.old_value);
}
if (NILP (Vquit_flag) && !NILP (quitf))
@ -3153,18 +3185,16 @@ DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
The debugger is entered when that frame exits, if the flag is non-nil. */)
(Lisp_Object level, Lisp_Object flag)
{
register struct backtrace *backlist = backtrace_list;
struct specbinding *pdl = backtrace_top ();
register EMACS_INT i;
CHECK_NUMBER (level);
for (i = 0; backlist && i < XINT (level); i++)
{
backlist = backlist->next;
}
for (i = 0; backtrace_p (pdl) && i < XINT (level); i++)
pdl = backtrace_next (pdl);
if (backlist)
backlist->debug_on_exit = !NILP (flag);
if (backtrace_p (pdl))
set_backtrace_debug_on_exit (pdl, !NILP (flag));
return flag;
}
@ -3174,58 +3204,41 @@ DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
Output stream used is value of `standard-output'. */)
(void)
{
register struct backtrace *backlist = backtrace_list;
Lisp_Object tail;
struct specbinding *pdl = backtrace_top ();
Lisp_Object tem;
struct gcpro gcpro1;
Lisp_Object old_print_level = Vprint_level;
if (NILP (Vprint_level))
XSETFASTINT (Vprint_level, 8);
tail = Qnil;
GCPRO1 (tail);
while (backlist)
while (backtrace_p (pdl))
{
write_string (backlist->debug_on_exit ? "* " : " ", 2);
if (backlist->nargs == UNEVALLED)
write_string (backtrace_debug_on_exit (pdl) ? "* " : " ", 2);
if (backtrace_nargs (pdl) == UNEVALLED)
{
Fprin1 (Fcons (backlist->function, *backlist->args), Qnil);
Fprin1 (Fcons (backtrace_function (pdl), *backtrace_args (pdl)),
Qnil);
write_string ("\n", -1);
}
else
{
tem = backlist->function;
tem = backtrace_function (pdl);
Fprin1 (tem, Qnil); /* This can QUIT. */
write_string ("(", -1);
if (backlist->nargs == MANY)
{ /* FIXME: Can this happen? */
bool later_arg = 0;
for (tail = *backlist->args; !NILP (tail); tail = Fcdr (tail))
{
if (later_arg)
write_string (" ", -1);
Fprin1 (Fcar (tail), Qnil);
later_arg = 1;
}
}
else
{
ptrdiff_t i;
for (i = 0; i < backlist->nargs; i++)
{
if (i) write_string (" ", -1);
Fprin1 (backlist->args[i], Qnil);
}
}
{
ptrdiff_t i;
for (i = 0; i < backtrace_nargs (pdl); i++)
{
if (i) write_string (" ", -1);
Fprin1 (backtrace_args (pdl)[i], Qnil);
}
}
write_string (")\n", -1);
}
backlist = backlist->next;
pdl = backtrace_next (pdl);
}
Vprint_level = old_print_level;
UNGCPRO;
return Qnil;
}
@ -3241,53 +3254,84 @@ or a lambda expression for macro calls.
If NFRAMES is more than the number of frames, the value is nil. */)
(Lisp_Object nframes)
{
register struct backtrace *backlist = backtrace_list;
struct specbinding *pdl = backtrace_top ();
register EMACS_INT i;
Lisp_Object tem;
CHECK_NATNUM (nframes);
/* Find the frame requested. */
for (i = 0; backlist && i < XFASTINT (nframes); i++)
backlist = backlist->next;
for (i = 0; backtrace_p (pdl) && i < XFASTINT (nframes); i++)
pdl = backtrace_next (pdl);
if (!backlist)
if (!backtrace_p (pdl))
return Qnil;
if (backlist->nargs == UNEVALLED)
return Fcons (Qnil, Fcons (backlist->function, *backlist->args));
if (backtrace_nargs (pdl) == UNEVALLED)
return Fcons (Qnil,
Fcons (backtrace_function (pdl), *backtrace_args (pdl)));
else
{
if (backlist->nargs == MANY) /* FIXME: Can this happen? */
tem = *backlist->args;
else
tem = Flist (backlist->nargs, backlist->args);
Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
return Fcons (Qt, Fcons (backlist->function, tem));
return Fcons (Qt, Fcons (backtrace_function (pdl), tem));
}
}
#if BYTE_MARK_STACK
void
mark_backtrace (void)
mark_specpdl (void)
{
register struct backtrace *backlist;
ptrdiff_t i;
for (backlist = backtrace_list; backlist; backlist = backlist->next)
struct specbinding *pdl;
for (pdl = specpdl; pdl != specpdl_ptr; pdl++)
{
mark_object (backlist->function);
if (backlist->nargs == UNEVALLED
|| backlist->nargs == MANY) /* FIXME: Can this happen? */
i = 1;
else
i = backlist->nargs;
while (i--)
mark_object (backlist->args[i]);
switch (pdl->kind)
{
case SPECPDL_UNWIND:
mark_object (specpdl_arg (pdl));
break;
case SPECPDL_BACKTRACE:
{
ptrdiff_t nargs = backtrace_nargs (pdl);
mark_object (backtrace_function (pdl));
if (nargs == UNEVALLED)
nargs = 1;
while (nargs--)
mark_object (backtrace_args (pdl)[nargs]);
}
break;
case SPECPDL_LET_DEFAULT:
case SPECPDL_LET_LOCAL:
mark_object (specpdl_where (pdl));
case SPECPDL_LET:
mark_object (specpdl_symbol (pdl));
mark_object (specpdl_old_value (pdl));
}
}
}
#endif
void
get_backtrace (Lisp_Object array)
{
struct specbinding *pdl = backtrace_next (backtrace_top ());
ptrdiff_t i = 0, asize = ASIZE (array);
/* Copy the backtrace contents into working memory. */
for (; i < asize; i++)
{
if (backtrace_p (pdl))
{
ASET (array, i, backtrace_function (pdl));
pdl = backtrace_next (pdl);
}
else
ASET (array, i, Qnil);
}
}
Lisp_Object backtrace_top_function (void)
{
struct specbinding *pdl = backtrace_top ();
return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil);
}
void
syms_of_eval (void)

105
src/lisp.h
View file

@ -73,6 +73,7 @@ enum
BITS_PER_SHORT = CHAR_BIT * sizeof (short),
BITS_PER_INT = CHAR_BIT * sizeof (int),
BITS_PER_LONG = CHAR_BIT * sizeof (long int),
BITS_PER_PTRDIFF_T = CHAR_BIT * sizeof (ptrdiff_t),
BITS_PER_EMACS_INT = CHAR_BIT * sizeof (EMACS_INT)
};
@ -2176,12 +2177,24 @@ typedef jmp_buf sys_jmp_buf;
#endif
/* Elisp uses several stacks:
- the C stack.
- the bytecode stack: used internally by the bytecode interpreter.
Allocated from the C stack.
- The specpdl stack: keeps track of active unwind-protect and
dynamic-let-bindings. Allocated from the `specpdl' array, a manually
managed stack.
- The catch stack: keeps track of active catch tags.
Allocated on the C stack. This is where the setmp data is kept.
- The handler stack: keeps track of active condition-case handlers.
Allocated on the C stack. Every entry there also uses an entry in
the catch stack. */
/* Structure for recording Lisp call stack for backtrace purposes. */
/* The special binding stack holds the outer values of variables while
they are bound by a function application or a let form, stores the
code to be executed for Lisp unwind-protect forms, and stores the C
functions to be called for record_unwind_protect.
code to be executed for unwind-protect forms.
If func is non-zero, undoing this binding applies func to old_value;
This implements record_unwind_protect.
@ -2194,35 +2207,77 @@ typedef jmp_buf sys_jmp_buf;
which means having bound a local value while CURRENT-BUFFER was active.
If WHERE is nil this means we saw the default value when binding SYMBOL.
WHERE being a buffer or frame means we saw a buffer-local or frame-local
value. Other values of WHERE mean an internal error. */
value. Other values of WHERE mean an internal error.
NOTE: The specbinding struct is defined here, because SPECPDL_INDEX is
used all over the place, needs to be fast, and needs to know the size of
struct specbinding. But only eval.c should access it. */
typedef Lisp_Object (*specbinding_func) (Lisp_Object);
enum specbind_tag {
SPECPDL_UNWIND, /* An unwind_protect function. */
SPECPDL_BACKTRACE, /* An element of the backtrace. */
SPECPDL_LET, /* A plain and simple dynamic let-binding. */
/* Tags greater than SPECPDL_LET must be "subkinds" of LET. */
SPECPDL_LET_LOCAL, /* A buffer-local let-binding. */
SPECPDL_LET_DEFAULT /* A global binding for a localized var. */
};
struct specbinding
{
Lisp_Object symbol, old_value;
specbinding_func func;
Lisp_Object unused; /* Dividing by 16 is faster than by 12. */
enum specbind_tag kind;
union {
struct {
Lisp_Object arg;
specbinding_func func;
} unwind;
struct {
/* `where' is not used in the case of SPECPDL_LET. */
Lisp_Object symbol, old_value, where;
} let;
struct {
Lisp_Object function;
Lisp_Object *args;
ptrdiff_t nargs : BITS_PER_PTRDIFF_T - 1;
bool debug_on_exit : 1;
} bt;
} v;
};
LISP_INLINE Lisp_Object specpdl_symbol (struct specbinding *pdl)
{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.symbol; }
LISP_INLINE Lisp_Object specpdl_old_value (struct specbinding *pdl)
{ eassert (pdl->kind >= SPECPDL_LET); return pdl->v.let.old_value; }
LISP_INLINE Lisp_Object specpdl_where (struct specbinding *pdl)
{ eassert (pdl->kind > SPECPDL_LET); return pdl->v.let.where; }
LISP_INLINE Lisp_Object specpdl_arg (struct specbinding *pdl)
{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.arg; }
LISP_INLINE specbinding_func specpdl_func (struct specbinding *pdl)
{ eassert (pdl->kind == SPECPDL_UNWIND); return pdl->v.unwind.func; }
LISP_INLINE Lisp_Object backtrace_function (struct specbinding *pdl)
{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.function; }
LISP_INLINE ptrdiff_t backtrace_nargs (struct specbinding *pdl)
{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.nargs; }
LISP_INLINE Lisp_Object *backtrace_args (struct specbinding *pdl)
{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.args; }
LISP_INLINE bool backtrace_debug_on_exit (struct specbinding *pdl)
{ eassert (pdl->kind == SPECPDL_BACKTRACE); return pdl->v.bt.debug_on_exit; }
extern struct specbinding *specpdl;
extern struct specbinding *specpdl_ptr;
extern ptrdiff_t specpdl_size;
#define SPECPDL_INDEX() (specpdl_ptr - specpdl)
struct backtrace
{
struct backtrace *next;
Lisp_Object function;
Lisp_Object *args; /* Points to vector of args. */
ptrdiff_t nargs; /* Length of vector. */
/* Nonzero means call value of debugger when done with this operation. */
unsigned int debug_on_exit : 1;
};
extern struct backtrace *backtrace_list;
/* Everything needed to describe an active condition case.
Members are volatile if their values need to survive _longjmp when
@ -2277,9 +2332,10 @@ struct catchtag
Lisp_Object tag;
Lisp_Object volatile val;
struct catchtag *volatile next;
#if 1 /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but they're defined later. */
struct gcpro *gcpro;
#endif
sys_jmp_buf jmp;
struct backtrace *backlist;
struct handler *handlerlist;
EMACS_INT lisp_eval_depth;
ptrdiff_t volatile pdlcount;
@ -3337,10 +3393,15 @@ extern Lisp_Object safe_call (ptrdiff_t, Lisp_Object, ...);
extern Lisp_Object safe_call1 (Lisp_Object, Lisp_Object);
extern Lisp_Object safe_call2 (Lisp_Object, Lisp_Object, Lisp_Object);
extern void init_eval (void);
#if BYTE_MARK_STACK
extern void mark_backtrace (void);
#endif
extern void syms_of_eval (void);
extern void record_in_backtrace (Lisp_Object function,
Lisp_Object *args, ptrdiff_t nargs);
extern void mark_specpdl (void);
extern void get_backtrace (Lisp_Object array);
Lisp_Object backtrace_top_function (void);
extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
extern bool let_shadows_global_binding_p (Lisp_Object symbol);
/* Defined in editfns.c. */
extern Lisp_Object Qfield;

17
src/profiler.c
View file

@ -138,10 +138,8 @@ static void evict_lower_half (log_t *log)
static void
record_backtrace (log_t *log, EMACS_INT count)
{
struct backtrace *backlist = backtrace_list;
Lisp_Object backtrace;
ptrdiff_t index, i = 0;
ptrdiff_t asize;
ptrdiff_t index;
if (!INTEGERP (log->next_free))
/* FIXME: transfer the evicted counts to a special entry rather
@ -151,16 +149,7 @@ record_backtrace (log_t *log, EMACS_INT count)
/* Get a "working memory" vector. */
backtrace = HASH_KEY (log, index);
asize = ASIZE (backtrace);
/* Copy the backtrace contents into working memory. */
for (; i < asize && backlist; i++, backlist = backlist->next)
/* FIXME: For closures we should ignore the environment. */
ASET (backtrace, i, backlist->function);
/* Make sure that unused space of working memory is filled with nil. */
for (; i < asize; i++)
ASET (backtrace, i, Qnil);
get_backtrace (backtrace);
{ /* We basically do a `gethash+puthash' here, except that we have to be
careful to avoid memory allocation since we're in a signal
@ -232,7 +221,7 @@ static EMACS_INT current_sampling_interval;
static void
handle_profiler_signal (int signal)
{
if (backtrace_list && EQ (backtrace_list->function, Qautomatic_gc))
if (EQ (backtrace_top_function (), Qautomatic_gc))
/* Special case the time-count inside GC because the hash-table
code is not prepared to be used while the GC is running.
More specifically it uses ASIZE at many places where it does

9
src/xdisp.c
View file

@ -12846,7 +12846,6 @@ redisplay_internal (void)
struct frame *sf;
int polling_stopped_here = 0;
Lisp_Object tail, frame;
struct backtrace backtrace;
/* Non-zero means redisplay has to consider all windows on all
frames. Zero means, only selected_window is considered. */
@ -12890,12 +12889,7 @@ redisplay_internal (void)
specbind (Qinhibit_free_realized_faces, Qnil);
/* Record this function, so it appears on the profiler's backtraces. */
backtrace.next = backtrace_list;
backtrace.function = Qredisplay_internal;
backtrace.args = &Qnil;
backtrace.nargs = 0;
backtrace.debug_on_exit = 0;
backtrace_list = &backtrace;
record_in_backtrace (Qredisplay_internal, &Qnil, 0);
FOR_EACH_FRAME (tail, frame)
XFRAME (frame)->already_hscrolled_p = 0;
@ -13532,7 +13526,6 @@ redisplay_internal (void)
#endif /* HAVE_WINDOW_SYSTEM */
end_of_redisplay:
backtrace_list = backtrace.next;
unbind_to (count, Qnil);
RESUME_POLLING;
}