From 2f592f95d2344d4a28eb946848330dca49e0f5ee Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 3 Jun 2013 05:01:53 -0400 Subject: [PATCH] Merge the specpdl and backtrace stacks. Make the structure of the 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. --- src/.gdbinit | 21 +-- src/ChangeLog | 48 +++++ src/alloc.c | 17 +- src/data.c | 57 ++---- src/eval.c | 478 +++++++++++++++++++++++++++---------------------- src/lisp.h | 105 ++++++++--- src/profiler.c | 17 +- src/xdisp.c | 9 +- 8 files changed, 421 insertions(+), 331 deletions(-) diff --git a/src/.gdbinit b/src/.gdbinit index c4604e6e2b0..1bfc293c466 100644 --- a/src/.gdbinit +++ b/src/.gdbinit @@ -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 diff --git a/src/ChangeLog b/src/ChangeLog index a7791444e09..41687e07593 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,51 @@ +2013-06-03 Stefan Monnier + + 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 * process.h (catch_child_signal): Declare. diff --git a/src/alloc.c b/src/alloc.c index 7a56c78e2ba..cce0fff4fd4 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -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; } diff --git a/src/data.c b/src/data.c index 6622088b648..b33d9656d57 100644 --- a/src/data.c +++ b/src/data.c @@ -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: diff --git a/src/eval.c b/src/eval.c index 69483a9b205..fac71e34a22 100644 --- a/src/eval.c +++ b/src/eval.c @@ -32,8 +32,6 @@ along with GNU Emacs. If not, see . */ #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,20 +115,37 @@ 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; } - -static void -set_specpdl_old_value (Lisp_Object oldval) +LISP_INLINE struct specbinding *backtrace_next (struct specbinding *pdl) { - specpdl_ptr->old_value = oldval; + pdl--; + while (backtrace_p (pdl) && pdl->kind != SPECPDL_BACKTRACE) + pdl--; + return pdl; } + 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; - - 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); + 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)); + + 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); + 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)); + } + } +} + +void +get_backtrace (Lisp_Object array) +{ + struct specbinding *pdl = backtrace_next (backtrace_top ()); + ptrdiff_t i = 0, asize = ASIZE (array); - if (backlist->nargs == UNEVALLED - || backlist->nargs == MANY) /* FIXME: Can this happen? */ - i = 1; + /* 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 - i = backlist->nargs; - while (i--) - mark_object (backlist->args[i]); + ASET (array, i, Qnil); } } -#endif + +Lisp_Object backtrace_top_function (void) +{ + struct specbinding *pdl = backtrace_top (); + return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil); +} void syms_of_eval (void) diff --git a/src/lisp.h b/src/lisp.h index 79d32c90f73..bd2f55f7cf4 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -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; diff --git a/src/profiler.c b/src/profiler.c index 0a0a4d0bc57..aba81344c68 100644 --- a/src/profiler.c +++ b/src/profiler.c @@ -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 diff --git a/src/xdisp.c b/src/xdisp.c index 9f3be44ecfd..5ae15cbd0b3 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -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; } -- 2.39.2