Commit 2f592f95 authored by Stefan Monnier's avatar Stefan Monnier

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.
parent e5e4a942
......@@ -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
......
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.
......
......@@ -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;
}
......
......@@ -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:
......
This diff is collapsed.
......@@ -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;
......
......@@ -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
......
......@@ -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;
}
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment