summaryrefslogtreecommitdiff
path: root/src/eval.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/eval.c')
-rw-r--r--src/eval.c314
1 files changed, 236 insertions, 78 deletions
diff --git a/src/eval.c b/src/eval.c
index f9563a3f80c..5e25caaa847 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -204,6 +204,10 @@ bool
backtrace_p (union specbinding *pdl)
{ return pdl >= specpdl; }
+static bool
+backtrace_thread_p (struct thread_state *tstate, union specbinding *pdl)
+{ return pdl >= tstate->m_specpdl; }
+
union specbinding *
backtrace_top (void)
{
@@ -213,6 +217,15 @@ backtrace_top (void)
return pdl;
}
+static union specbinding *
+backtrace_thread_top (struct thread_state *tstate)
+{
+ union specbinding *pdl = tstate->m_specpdl_ptr - 1;
+ while (backtrace_thread_p (tstate, pdl) && pdl->kind != SPECPDL_BACKTRACE)
+ pdl--;
+ return pdl;
+}
+
union specbinding *
backtrace_next (union specbinding *pdl)
{
@@ -222,6 +235,15 @@ backtrace_next (union specbinding *pdl)
return pdl;
}
+static union specbinding *
+backtrace_thread_next (struct thread_state *tstate, union specbinding *pdl)
+{
+ pdl--;
+ while (backtrace_thread_p (tstate, pdl) && pdl->kind != SPECPDL_BACKTRACE)
+ pdl--;
+ return pdl;
+}
+
void
init_eval_once (void)
{
@@ -264,8 +286,8 @@ init_eval (void)
static void
restore_stack_limits (Lisp_Object data)
{
- max_specpdl_size = XINT (XCAR (data));
- max_lisp_eval_depth = XINT (XCDR (data));
+ max_specpdl_size = XFIXNUM (XCAR (data));
+ max_lisp_eval_depth = XFIXNUM (XCDR (data));
}
static void grow_specpdl (void);
@@ -303,8 +325,8 @@ call_debugger (Lisp_Object arg)
/* Restore limits after leaving the debugger. */
record_unwind_protect (restore_stack_limits,
- Fcons (make_number (old_max),
- make_number (old_depth)));
+ Fcons (make_fixnum (old_max),
+ make_fixnum (old_depth)));
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
@@ -511,7 +533,7 @@ usage: (setq [SYM VAL]...) */)
Lisp_Object sym = XCAR (tail), lex_binding;
tail = XCDR (tail);
if (!CONSP (tail))
- xsignal2 (Qwrong_number_of_arguments, Qsetq, make_number (nargs + 1));
+ xsignal2 (Qwrong_number_of_arguments, Qsetq, make_fixnum (nargs + 1));
Lisp_Object arg = XCAR (tail);
tail = XCDR (tail);
val = eval_sub (arg);
@@ -627,6 +649,16 @@ The return value is BASE-VARIABLE. */)
if (NILP (Fboundp (base_variable)))
set_internal (base_variable, find_symbol_value (new_alias),
Qnil, SET_INTERNAL_BIND);
+ else if (!NILP (Fboundp (new_alias))
+ && !EQ (find_symbol_value (new_alias),
+ find_symbol_value (base_variable)))
+ call2 (intern ("display-warning"),
+ list3 (intern ("defvaralias"), intern ("losing-value"), new_alias),
+ CALLN (Fformat_message,
+ build_string
+ ("Overwriting value of `%s' by aliasing to `%s'"),
+ new_alias, base_variable));
+
{
union specbinding *p;
@@ -667,8 +699,10 @@ default_toplevel_binding (Lisp_Object symbol)
break;
case SPECPDL_UNWIND:
+ case SPECPDL_UNWIND_ARRAY:
case SPECPDL_UNWIND_PTR:
case SPECPDL_UNWIND_INT:
+ case SPECPDL_UNWIND_EXCURSION:
case SPECPDL_UNWIND_VOID:
case SPECPDL_BACKTRACE:
case SPECPDL_LET_LOCAL:
@@ -741,6 +775,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
sym = XCAR (args);
tail = XCDR (args);
+ CHECK_SYMBOL (sym);
+
if (!NILP (tail))
{
if (!NILP (XCDR (tail)) && !NILP (XCDR (XCDR (tail))))
@@ -924,7 +960,7 @@ usage: (let VARLIST BODY...) */)
CHECK_LIST (varlist);
/* Make space to hold the values to give the bound variables. */
- EMACS_INT varlist_len = XFASTINT (Flength (varlist));
+ EMACS_INT varlist_len = XFIXNAT (Flength (varlist));
SAFE_ALLOCA_LISP (temps, varlist_len);
ptrdiff_t nvars = varlist_len;
@@ -971,8 +1007,7 @@ usage: (let VARLIST BODY...) */)
specbind (Qinternal_interpreter_environment, lexenv);
elt = Fprogn (XCDR (args));
- SAFE_FREE ();
- return unbind_to (count, elt);
+ return SAFE_FREE_UNBIND_TO (count, elt);
}
DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
@@ -1202,9 +1237,11 @@ Executes BODYFORM and returns its value if no error happens.
Each element of HANDLERS looks like (CONDITION-NAME BODY...)
where the BODY is made of Lisp expressions.
-A handler is applicable to an error
-if CONDITION-NAME is one of the error's condition names.
-If an error happens, the first applicable handler is run.
+A handler is applicable to an error if CONDITION-NAME is one of the
+error's condition names. Handlers may also apply when non-error
+symbols are signaled (e.g., `quit'). A CONDITION-NAME of t applies to
+any symbol, including non-error symbols. If multiple handlers are
+applicable, only the first one runs.
The car of a handler may be a list of condition names instead of a
single condition name; then it handles all of them. If the special
@@ -1420,6 +1457,57 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
}
}
+static Lisp_Object
+internal_catch_all_1 (Lisp_Object (*function) (void *), void *argument)
+{
+ struct handler *c = push_handler_nosignal (Qt, CATCHER_ALL);
+ if (c == NULL)
+ return Qcatch_all_memory_full;
+
+ if (sys_setjmp (c->jmp) == 0)
+ {
+ Lisp_Object val = function (argument);
+ eassert (handlerlist == c);
+ handlerlist = c->next;
+ return val;
+ }
+ else
+ {
+ eassert (handlerlist == c);
+ Lisp_Object val = c->val;
+ handlerlist = c->next;
+ Fsignal (Qno_catch, val);
+ }
+}
+
+/* Like a combination of internal_condition_case_1 and internal_catch.
+ Catches all signals and throws. Never exits nonlocally; returns
+ Qcatch_all_memory_full if no handler could be allocated. */
+
+Lisp_Object
+internal_catch_all (Lisp_Object (*function) (void *), void *argument,
+ Lisp_Object (*handler) (Lisp_Object))
+{
+ struct handler *c = push_handler_nosignal (Qt, CONDITION_CASE);
+ if (c == NULL)
+ return Qcatch_all_memory_full;
+
+ if (sys_setjmp (c->jmp) == 0)
+ {
+ Lisp_Object val = internal_catch_all_1 (function, argument);
+ eassert (handlerlist == c);
+ handlerlist = c->next;
+ return val;
+ }
+ else
+ {
+ eassert (handlerlist == c);
+ Lisp_Object val = c->val;
+ handlerlist = c->next;
+ return handler (val);
+ }
+}
+
struct handler *
push_handler (Lisp_Object tag_ch_val, enum handlertype handlertype)
{
@@ -1668,33 +1756,25 @@ xsignal3 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, Lisp_Obj
}
/* Signal `error' with message S, and additional arg ARG.
- If ARG is not a genuine list, make it a one-element list. */
+ If ARG is not a proper list, make it a one-element list. */
void
signal_error (const char *s, Lisp_Object arg)
{
- Lisp_Object tortoise, hare;
-
- hare = tortoise = arg;
- while (CONSP (hare))
- {
- hare = XCDR (hare);
- if (!CONSP (hare))
- break;
-
- hare = XCDR (hare);
- tortoise = XCDR (tortoise);
-
- if (EQ (hare, tortoise))
- break;
- }
-
- if (!NILP (hare))
+ if (NILP (Fproper_list_p (arg)))
arg = list1 (arg);
xsignal (Qerror, Fcons (build_string (s), arg));
}
+/* Use this for arithmetic overflow, e.g., when an integer result is
+ too large even for a bignum. */
+void
+overflow_error (void)
+{
+ xsignal0 (Qoverflow_error);
+}
+
/* Return true if LIST is a non-nil atom or
a list containing one of CONDITIONS. */
@@ -1806,7 +1886,9 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions)
for (h = handlers; CONSP (h); h = XCDR (h))
{
Lisp_Object handler = XCAR (h);
- if (!NILP (Fmemq (handler, conditions)))
+ if (!NILP (Fmemq (handler, conditions))
+ /* t is also used as a catch-all by Lisp code. */
+ || EQ (handler, Qt))
return handlers;
}
@@ -1943,12 +2025,12 @@ this does nothing and returns nil. */)
&& !AUTOLOADP (XSYMBOL (function)->u.s.function))
return Qnil;
- if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0)))
+ if (!NILP (Vpurify_flag) && EQ (docstring, make_fixnum (0)))
/* `read1' in lread.c has found the docstring starting with "\
and assumed the docstring will be provided by Snarf-documentation, so it
passed us 0 instead. But that leads to accidental sharing in purecopy's
hash-consing, so we use a (hopefully) unique integer instead. */
- docstring = make_number (XHASH (function));
+ docstring = make_fixnum (XHASH (function));
return Fdefalias (function,
list5 (Qautoload, file, docstring, interactive, type),
Qnil);
@@ -1968,7 +2050,7 @@ un_autoload (Lisp_Object oldqueue)
first = XCAR (queue);
second = Fcdr (first);
first = Fcar (first);
- if (EQ (first, make_number (0)))
+ if (EQ (first, make_fixnum (0)))
Vfeatures = second;
else
Ffset (first, second);
@@ -1993,12 +2075,10 @@ it defines a macro. */)
if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef)))
return fundef;
- if (EQ (macro_only, Qmacro))
- {
- Lisp_Object kind = Fnth (make_number (4), fundef);
- if (! (EQ (kind, Qt) || EQ (kind, Qmacro)))
- return fundef;
- }
+ Lisp_Object kind = Fnth (make_fixnum (4), fundef);
+ if (EQ (macro_only, Qmacro)
+ && !(EQ (kind, Qt) || EQ (kind, Qmacro)))
+ return fundef;
/* This is to make sure that loadup.el gives a clear picture
of what files are preloaded and when. */
@@ -2021,15 +2101,18 @@ it defines a macro. */)
The value saved here is to be restored into Vautoload_queue. */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
- /* If `macro_only', assume this autoload to be a "best-effort",
+ /* If `macro_only' is set and fundef isn't a macro, assume this autoload to
+ be a "best-effort" (e.g. to try and find a compiler macro),
so don't signal an error if autoloading fails. */
- Fload (Fcar (Fcdr (fundef)), macro_only, Qt, Qnil, Qt);
+ Lisp_Object ignore_errors
+ = (EQ (kind, Qt) || EQ (kind, Qmacro)) ? Qnil : macro_only;
+ Fload (Fcar (Fcdr (fundef)), ignore_errors, Qt, Qnil, Qt);
/* Once loading finishes, don't undo it. */
Vautoload_queue = Qt;
unbind_to (count, Qnil);
- if (NILP (funname))
+ if (NILP (funname) || !NILP (ignore_errors))
return Qnil;
else
{
@@ -2181,9 +2264,9 @@ eval_sub (Lisp_Object form)
check_cons_list ();
- if (XINT (numargs) < XSUBR (fun)->min_args
+ if (XFIXNUM (numargs) < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0
- && XSUBR (fun)->max_args < XINT (numargs)))
+ && XSUBR (fun)->max_args < XFIXNUM (numargs)))
xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
else if (XSUBR (fun)->max_args == UNEVALLED)
@@ -2195,9 +2278,9 @@ eval_sub (Lisp_Object form)
ptrdiff_t argnum = 0;
USE_SAFE_ALLOCA;
- SAFE_ALLOCA_LISP (vals, XINT (numargs));
+ SAFE_ALLOCA_LISP (vals, XFIXNUM (numargs));
- while (CONSP (args_left) && argnum < XINT (numargs))
+ while (CONSP (args_left) && argnum < XFIXNUM (numargs))
{
Lisp_Object arg = XCAR (args_left);
args_left = XCDR (args_left);
@@ -2227,7 +2310,7 @@ eval_sub (Lisp_Object form)
args_left = Fcdr (args_left);
}
- set_backtrace_args (specpdl + count, argvals, XINT (numargs));
+ set_backtrace_args (specpdl + count, argvals, XFIXNUM (numargs));
switch (i)
{
@@ -2305,7 +2388,7 @@ eval_sub (Lisp_Object form)
specbind (Qlexical_binding,
NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
exp = apply1 (Fcdr (fun), original_args);
- unbind_to (count1, Qnil);
+ exp = unbind_to (count1, exp);
val = eval_sub (exp);
}
else if (EQ (funcar, Qlambda)
@@ -2340,7 +2423,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */)
CHECK_LIST (spread_arg);
- numargs = XINT (Flength (spread_arg));
+ numargs = XFIXNUM (Flength (spread_arg));
if (numargs == 0)
return Ffuncall (nargs - 1, args);
@@ -2814,7 +2897,7 @@ funcall_subr (struct Lisp_Subr *subr, ptrdiff_t numargs, Lisp_Object *args)
{
Lisp_Object fun;
XSETSUBR (fun, subr);
- xsignal2 (Qwrong_number_of_arguments, fun, make_number (numargs));
+ xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (numargs));
}
else if (subr->max_args == UNEVALLED)
@@ -2895,7 +2978,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, ptrdiff_t count)
Lisp_Object tem;
USE_SAFE_ALLOCA;
- numargs = XFASTINT (Flength (args));
+ numargs = XFIXNAT (Flength (args));
SAFE_ALLOCA_LISP (arg_vector, numargs);
args_left = args;
@@ -2957,7 +3040,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
if (size <= COMPILED_STACK_DEPTH)
xsignal1 (Qinvalid_function, fun);
syms_left = AREF (fun, COMPILED_ARGLIST);
- if (INTEGERP (syms_left))
+ if (FIXNUMP (syms_left))
/* A byte-code object with an integer args template means we
shouldn't bind any arguments, instead just call the byte-code
interpreter directly; it will push arguments as necessary.
@@ -2987,7 +3070,6 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
emacs_abort ();
i = optional = rest = 0;
- bool previous_optional_or_rest = false;
for (; CONSP (syms_left); syms_left = XCDR (syms_left))
{
maybe_quit ();
@@ -2998,17 +3080,15 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
if (EQ (next, Qand_rest))
{
- if (rest || previous_optional_or_rest)
+ if (rest)
xsignal1 (Qinvalid_function, fun);
rest = 1;
- previous_optional_or_rest = true;
}
else if (EQ (next, Qand_optional))
{
- if (optional || rest || previous_optional_or_rest)
+ if (optional || rest)
xsignal1 (Qinvalid_function, fun);
optional = 1;
- previous_optional_or_rest = true;
}
else
{
@@ -3021,7 +3101,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
else if (i < nargs)
arg = arg_vector[i++];
else if (!optional)
- xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
+ xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs));
else
arg = Qnil;
@@ -3032,14 +3112,13 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
else
/* Dynamically bind NEXT. */
specbind (next, arg);
- previous_optional_or_rest = false;
}
}
- if (!NILP (syms_left) || previous_optional_or_rest)
+ if (!NILP (syms_left))
xsignal1 (Qinvalid_function, fun);
else if (i < nargs)
- xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
+ xsignal2 (Qwrong_number_of_arguments, fun, make_fixnum (nargs));
if (!EQ (lexenv, Vinternal_interpreter_environment))
/* Instantiate a new lexical environment. */
@@ -3146,7 +3225,7 @@ lambda_arity (Lisp_Object fun)
if (size <= COMPILED_STACK_DEPTH)
xsignal1 (Qinvalid_function, fun);
syms_left = AREF (fun, COMPILED_ARGLIST);
- if (INTEGERP (syms_left))
+ if (FIXNUMP (syms_left))
return get_byte_code_arity (syms_left);
}
else
@@ -3161,7 +3240,7 @@ lambda_arity (Lisp_Object fun)
xsignal1 (Qinvalid_function, fun);
if (EQ (next, Qand_rest))
- return Fcons (make_number (minargs), Qmany);
+ return Fcons (make_fixnum (minargs), Qmany);
else if (EQ (next, Qand_optional))
optional = true;
else
@@ -3175,7 +3254,7 @@ lambda_arity (Lisp_Object fun)
if (!NILP (syms_left))
xsignal1 (Qinvalid_function, fun);
- return Fcons (make_number (minargs), make_number (maxargs));
+ return Fcons (make_fixnum (minargs), make_fixnum (maxargs));
}
DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
@@ -3351,6 +3430,15 @@ record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg)
}
void
+record_unwind_protect_array (Lisp_Object *array, ptrdiff_t nelts)
+{
+ specpdl_ptr->unwind_array.kind = SPECPDL_UNWIND_ARRAY;
+ specpdl_ptr->unwind_array.array = array;
+ specpdl_ptr->unwind_array.nelts = nelts;
+ grow_specpdl ();
+}
+
+void
record_unwind_protect_ptr (void (*function) (void *), void *arg)
{
specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR;
@@ -3369,6 +3457,14 @@ record_unwind_protect_int (void (*function) (int), int arg)
}
void
+record_unwind_protect_excursion (void)
+{
+ specpdl_ptr->unwind_excursion.kind = SPECPDL_UNWIND_EXCURSION;
+ save_excursion_save (specpdl_ptr);
+ grow_specpdl ();
+}
+
+void
record_unwind_protect_void (void (*function) (void))
{
specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID;
@@ -3404,6 +3500,9 @@ do_one_unbind (union specbinding *this_binding, bool unwinding,
case SPECPDL_UNWIND:
this_binding->unwind.func (this_binding->unwind.arg);
break;
+ case SPECPDL_UNWIND_ARRAY:
+ xfree (this_binding->unwind_array.array);
+ break;
case SPECPDL_UNWIND_PTR:
this_binding->unwind_ptr.func (this_binding->unwind_ptr.arg);
break;
@@ -3413,6 +3512,10 @@ do_one_unbind (union specbinding *this_binding, bool unwinding,
case SPECPDL_UNWIND_VOID:
this_binding->unwind_void.func ();
break;
+ case SPECPDL_UNWIND_EXCURSION:
+ save_excursion_restore (this_binding->unwind_excursion.marker,
+ this_binding->unwind_excursion.window);
+ break;
case SPECPDL_BACKTRACE:
break;
case SPECPDL_LET:
@@ -3578,11 +3681,11 @@ get_backtrace_frame (Lisp_Object nframes, Lisp_Object base)
{
register EMACS_INT i;
- CHECK_NATNUM (nframes);
+ CHECK_FIXNAT (nframes);
union specbinding *pdl = get_backtrace_starting_at (base);
/* Find the frame requested. */
- for (i = XFASTINT (nframes); i > 0 && backtrace_p (pdl); i--)
+ for (i = XFIXNAT (nframes); i > 0 && backtrace_p (pdl); i--)
pdl = backtrace_next (pdl);
return pdl;
@@ -3612,7 +3715,7 @@ 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)
{
- CHECK_NUMBER (level);
+ CHECK_FIXNUM (level);
union specbinding *pdl = get_backtrace_frame(level, Qnil);
if (backtrace_p (pdl))
@@ -3659,6 +3762,42 @@ Return the result of FUNCTION, or nil if no matching frame could be found. */)
return backtrace_frame_apply (function, get_backtrace_frame (nframes, base));
}
+DEFUN ("backtrace--frames-from-thread", Fbacktrace_frames_from_thread,
+ Sbacktrace_frames_from_thread, 1, 1, NULL,
+ doc: /* Return the list of backtrace frames from current execution point in THREAD.
+If a frame has not evaluated the arguments yet (or is a special form),
+the value of the list element is (nil FUNCTION ARG-FORMS...).
+If a frame has evaluated its arguments and called its function already,
+the value of the list element is (t FUNCTION ARG-VALUES...).
+A &rest arg is represented as the tail of the list ARG-VALUES.
+FUNCTION is whatever was supplied as car of evaluated list,
+or a lambda expression for macro calls. */)
+ (Lisp_Object thread)
+{
+ struct thread_state *tstate;
+ CHECK_THREAD (thread);
+ tstate = XTHREAD (thread);
+
+ union specbinding *pdl = backtrace_thread_top (tstate);
+ Lisp_Object list = Qnil;
+
+ while (backtrace_thread_p (tstate, pdl))
+ {
+ Lisp_Object frame;
+ if (backtrace_nargs (pdl) == UNEVALLED)
+ frame = Fcons (Qnil,
+ Fcons (backtrace_function (pdl), *backtrace_args (pdl)));
+ else
+ {
+ Lisp_Object tem = Flist (backtrace_nargs (pdl), backtrace_args (pdl));
+ frame = Fcons (Qt, Fcons (backtrace_function (pdl), tem));
+ }
+ list = Fcons (frame, list);
+ pdl = backtrace_thread_next (tstate, pdl);
+ }
+ return Fnreverse (list);
+}
+
/* For backtrace-eval, we want to temporarily unwind the last few elements of
the specpdl stack, and then rewind them. We store the pre-unwind values
directly in the pre-existing specpdl elements (i.e. we swap the current
@@ -3687,18 +3826,22 @@ backtrace_eval_unrewind (int distance)
unwind_protect, but the problem is that we don't know how to
rewind them afterwards. */
case SPECPDL_UNWIND:
- {
- Lisp_Object oldarg = tmp->unwind.arg;
- if (tmp->unwind.func == set_buffer_if_live)
+ if (tmp->unwind.func == set_buffer_if_live)
+ {
+ Lisp_Object oldarg = tmp->unwind.arg;
tmp->unwind.arg = Fcurrent_buffer ();
- else if (tmp->unwind.func == save_excursion_restore)
- tmp->unwind.arg = save_excursion_save ();
- else
- break;
- tmp->unwind.func (oldarg);
- break;
+ set_buffer_if_live (oldarg);
+ }
+ break;
+ case SPECPDL_UNWIND_EXCURSION:
+ {
+ Lisp_Object marker = tmp->unwind_excursion.marker;
+ Lisp_Object window = tmp->unwind_excursion.window;
+ save_excursion_save (tmp);
+ save_excursion_restore (marker, window);
}
-
+ break;
+ case SPECPDL_UNWIND_ARRAY:
case SPECPDL_UNWIND_PTR:
case SPECPDL_UNWIND_INT:
case SPECPDL_UNWIND_VOID:
@@ -3779,7 +3922,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.
{
union specbinding *frame = get_backtrace_frame (nframes, base);
union specbinding *prevframe
- = get_backtrace_frame (make_number (XFASTINT (nframes) - 1), base);
+ = get_backtrace_frame (make_fixnum (XFIXNAT (nframes) - 1), base);
ptrdiff_t distance = specpdl_ptr - frame;
Lisp_Object result = Qnil;
eassert (distance >= 0);
@@ -3831,8 +3974,10 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'.
break;
case SPECPDL_UNWIND:
+ case SPECPDL_UNWIND_ARRAY:
case SPECPDL_UNWIND_PTR:
case SPECPDL_UNWIND_INT:
+ case SPECPDL_UNWIND_EXCURSION:
case SPECPDL_UNWIND_VOID:
case SPECPDL_BACKTRACE:
break;
@@ -3862,6 +4007,15 @@ mark_specpdl (union specbinding *first, union specbinding *ptr)
mark_object (specpdl_arg (pdl));
break;
+ case SPECPDL_UNWIND_ARRAY:
+ mark_maybe_objects (pdl->unwind_array.array, pdl->unwind_array.nelts);
+ break;
+
+ case SPECPDL_UNWIND_EXCURSION:
+ mark_object (pdl->unwind_excursion.marker);
+ mark_object (pdl->unwind_excursion.window);
+ break;
+
case SPECPDL_BACKTRACE:
{
ptrdiff_t nargs = backtrace_nargs (pdl);
@@ -4073,6 +4227,9 @@ alist of active lexical bindings. */);
inhibit_lisp_code = Qnil;
+ DEFSYM (Qcatch_all_memory_full, "catch-all-memory-full");
+ Funintern (Qcatch_all_memory_full, Qnil);
+
defsubr (&Sor);
defsubr (&Sand);
defsubr (&Sif);
@@ -4116,6 +4273,7 @@ alist of active lexical bindings. */);
DEFSYM (QCdebug_on_exit, ":debug-on-exit");
defsubr (&Smapbacktrace);
defsubr (&Sbacktrace_frame_internal);
+ defsubr (&Sbacktrace_frames_from_thread);
defsubr (&Sbacktrace_eval);
defsubr (&Sbacktrace__locals);
defsubr (&Sspecial_variable_p);
generated by cgit v1.2.3 (git 2.39.1) at 2025-06-05 02:18:11 +0000