Commit adf2aa61 authored by Stefan Monnier's avatar Stefan Monnier
Browse files

Introduce new bytecodes for efficient catch/condition-case in lexbind.

* lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
Optimize under `condition-case' and `catch' if
byte-compile--use-old-handlers is nil.
(disassemble-offset): Handle new bytecodes.

* lisp/emacs-lisp/bytecomp.el (byte-pushcatch, byte-pushconditioncase)
(byte-pophandler): New byte codes.
(byte-goto-ops): Adjust accordingly.
(byte-compile--use-old-handlers): New var.
(byte-compile-catch): Use new byte codes depending on
byte-compile--use-old-handlers.
(byte-compile-condition-case--old): Rename from
byte-compile-condition-case.
(byte-compile-condition-case--new): New function.
(byte-compile-condition-case): New function that dispatches depending
on byte-compile--use-old-handlers.
(byte-compile-unwind-protect): Pass a function to byte-unwind-protect
when we can.

* lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): Adjust for
the new compilation scheme using the new byte-codes.

* src/alloc.c (Fgarbage_collect): Merge scans of handlerlist and catchlist,
and make them unconditional now that they're heap-allocated.

* src/bytecode.c (BYTE_CODES): Add Bpushcatch, Bpushconditioncase
and Bpophandler.
(bcall0): New function.
(exec_byte_code): Add corresponding cases.  Improve error message when
encountering an invalid byte-code.  Let Bunwind_protect accept
a function (rather than a list of expressions) as argument.

* src/eval.c (catchlist): Remove (merge with handlerlist).
(handlerlist, lisp_eval_depth): Not static any more.
(internal_catch, internal_condition_case, internal_condition_case_1)
(internal_condition_case_2, internal_condition_case_n):
Use PUSH_HANDLER.
(unwind_to_catch, Fthrow, Fsignal): Adjust to merged
handlerlist/catchlist.
(internal_lisp_condition_case): Use PUSH_HANDLER.  Adjust to new
handlerlist which can only handle a single condition-case handler at
a time.
(find_handler_clause): Simplify since we only a single branch here
any more.

* src/lisp.h (struct handler): Merge struct handler and struct catchtag.
(PUSH_HANDLER): New macro.
(catchlist): Remove.
(handlerlist): Always declare.
parent 328a8179
2013-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): Adjust for
the new compilation scheme using the new byte-codes.
* emacs-lisp/bytecomp.el (byte-pushcatch, byte-pushconditioncase)
(byte-pophandler): New byte codes.
(byte-goto-ops): Adjust accordingly.
(byte-compile--use-old-handlers): New var.
(byte-compile-catch): Use new byte codes depending on
byte-compile--use-old-handlers.
(byte-compile-condition-case--old): Rename from
byte-compile-condition-case.
(byte-compile-condition-case--new): New function.
(byte-compile-condition-case): New function that dispatches depending
on byte-compile--use-old-handlers.
(byte-compile-unwind-protect): Pass a function to byte-unwind-protect
when we can.
* emacs-lisp/byte-opt.el (byte-optimize-form-code-walker):
Optimize under `condition-case' and `catch' if
byte-compile--use-old-handlers is nil.
(disassemble-offset): Handle new bytecodes.
2013-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
* subr.el (error): Use `declare'.
......
......@@ -488,11 +488,22 @@
(prin1-to-string form))
nil)
((memq fn '(function condition-case))
;; These forms are compiled as constants or by breaking out
((eq fn 'function)
;; This forms is compiled as constant or by breaking out
;; all the subexpressions and compiling them separately.
form)
((eq fn 'condition-case)
(if byte-compile--use-old-handlers
;; Will be optimized later.
form
`(condition-case ,(nth 1 form) ;Not evaluated.
,(byte-optimize-form (nth 2 form) for-effect)
,@(mapcar (lambda (clause)
`(,(car clause)
,@(byte-optimize-body (cdr clause) for-effect)))
(nthcdr 3 form)))))
((eq fn 'unwind-protect)
;; the "protected" part of an unwind-protect is compiled (and thus
;; optimized) as a top-level form, so don't do it here. But the
......@@ -504,13 +515,14 @@
(cdr (cdr form)))))
((eq fn 'catch)
;; the body of a catch is compiled (and thus optimized) as a
;; top-level form, so don't do it here. The tag is never
;; for-effect. The body should have the same for-effect status
;; as the catch form itself, but that isn't handled properly yet.
(cons fn
(cons (byte-optimize-form (nth 1 form) nil)
(cdr (cdr form)))))
(if byte-compile--use-old-handlers
;; The body of a catch is compiled (and thus
;; optimized) as a top-level form, so don't do it
;; here.
(cdr (cdr form))
(byte-optimize-body (cdr form) for-effect)))))
((eq fn 'ignore)
;; Don't treat the args to `ignore' as being
......@@ -1292,7 +1304,7 @@
"Don't call this!"
;; Fetch and return the offset for the current opcode.
;; Return nil if this opcode has no offset.
(cond ((< bytedecomp-op byte-nth)
(cond ((< bytedecomp-op byte-pophandler)
(let ((tem (logand bytedecomp-op 7)))
(setq bytedecomp-op (logand bytedecomp-op 248))
(cond ((eq tem 6)
......@@ -1311,7 +1323,9 @@
(setq bytedecomp-op byte-constant)))
((or (and (>= bytedecomp-op byte-constant2)
(<= bytedecomp-op byte-goto-if-not-nil-else-pop))
(= bytedecomp-op byte-stack-set2))
(memq bytedecomp-op (eval-when-compile
(list byte-stack-set2 byte-pushcatch
byte-pushconditioncase))))
;; Offset in next 2 bytes.
(setq bytedecomp-ptr (1+ bytedecomp-ptr))
(+ (aref bytes bytedecomp-ptr)
......
......@@ -535,7 +535,13 @@ Each element is (INDEX . VALUE)")
(byte-defop 40 0 byte-unbind "for unbinding special bindings")
;; codes 8-47 are consumed by the preceding opcodes
;; unused: 48-55
;; New (in Emacs-24.4) bytecodes for more efficient handling of non-local exits
;; (especially useful in lexical-binding code).
(byte-defop 48 0 byte-pophandler)
(byte-defop 50 -1 byte-pushcatch)
(byte-defop 49 -1 byte-pushconditioncase)
;; unused: 51-55
(byte-defop 56 -1 byte-nth)
(byte-defop 57 0 byte-symbolp)
......@@ -707,7 +713,8 @@ otherwise pop it")
(defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
byte-goto-if-nil-else-pop
byte-goto-if-not-nil-else-pop)
byte-goto-if-not-nil-else-pop
byte-pushcatch byte-pushconditioncase)
"List of byte-codes whose offset is a pc.")
(defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil))
......@@ -4028,23 +4035,35 @@ binding slots have been popped."
;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro.
(byte-defop-compiler-1 track-mouse)
(defvar byte-compile--use-old-handlers t
"If nil, use new byte codes introduced in Emacs-24.4.")
(defun byte-compile-catch (form)
(byte-compile-form (car (cdr form)))
(pcase (cddr form)
(`(:fun-body ,f)
(byte-compile-form `(list 'funcall ,f)))
(body
(byte-compile-push-constant
(byte-compile-top-level (cons 'progn body) byte-compile--for-effect))))
(byte-compile-out 'byte-catch 0))
(if (not byte-compile--use-old-handlers)
(let ((endtag (byte-compile-make-tag)))
(byte-compile-goto 'byte-pushcatch endtag)
(byte-compile-body (cddr form) nil)
(byte-compile-out 'byte-pophandler)
(byte-compile-out-tag endtag))
(pcase (cddr form)
(`(:fun-body ,f)
(byte-compile-form `(list 'funcall ,f)))
(body
(byte-compile-push-constant
(byte-compile-top-level (cons 'progn body) byte-compile--for-effect))))
(byte-compile-out 'byte-catch 0)))
(defun byte-compile-unwind-protect (form)
(pcase (cddr form)
(`(:fun-body ,f)
(byte-compile-form `(list (list 'funcall ,f))))
(byte-compile-form
(if byte-compile--use-old-handlers `(list (list 'funcall ,f)) f)))
(handlers
(byte-compile-push-constant
(byte-compile-top-level-body handlers t))))
(if byte-compile--use-old-handlers
(byte-compile-push-constant
(byte-compile-top-level-body handlers t))
(byte-compile-form `#'(lambda () ,@handlers)))))
(byte-compile-out 'byte-unwind-protect 0)
(byte-compile-form-do-effect (car (cdr form)))
(byte-compile-out 'byte-unbind 1))
......@@ -4056,6 +4075,11 @@ binding slots have been popped."
(_ `(eval '(track-mouse ,@(byte-compile-top-level-body (cdr form))))))))
(defun byte-compile-condition-case (form)
(if byte-compile--use-old-handlers
(byte-compile-condition-case--old form)
(byte-compile-condition-case--new form)))
(defun byte-compile-condition-case--old (form)
(let* ((var (nth 1 form))
(fun-bodies (eq var :fun-body))
(byte-compile-bound-variables
......@@ -4106,6 +4130,62 @@ binding slots have been popped."
(byte-compile-push-constant compiled-clauses)))
(byte-compile-out 'byte-condition-case 0)))
(defun byte-compile-condition-case--new (form)
(let* ((var (nth 1 form))
(body (nth 2 form))
(depth byte-compile-depth)
(clauses (mapcar (lambda (clause)
(cons (byte-compile-make-tag) clause))
(nthcdr 3 form)))
(endtag (byte-compile-make-tag)))
(byte-compile-set-symbol-position 'condition-case)
(unless (symbolp var)
(byte-compile-warn
"`%s' is not a variable-name or nil (in condition-case)" var))
(dolist (clause (reverse clauses))
(let ((condition (nth 1 clause)))
(unless (consp condition) (setq condition (list condition)))
(dolist (c condition)
(unless (and c (symbolp c))
(byte-compile-warn
"`%S' is not a condition name (in condition-case)" c))
;; In reality, the `error-conditions' property is only required
;; for the argument to `signal', not to `condition-case'.
;;(unless (consp (get c 'error-conditions))
;; (byte-compile-warn
;; "`%s' is not a known condition name (in condition-case)"
;; c))
)
(byte-compile-push-constant condition))
(byte-compile-goto 'byte-pushconditioncase (car clause)))
(byte-compile-form body) ;; byte-compile--for-effect
(dolist (_ clauses) (byte-compile-out 'byte-pophandler))
(byte-compile-goto 'byte-goto endtag)
(while clauses
(let ((clause (pop clauses))
(byte-compile-bound-variables byte-compile-bound-variables)
(byte-compile--lexical-environment
byte-compile--lexical-environment))
(setq byte-compile-depth (1+ depth))
(byte-compile-out-tag (pop clause))
(dolist (_ clauses) (byte-compile-out 'byte-pophandler))
(cond
((null var) (byte-compile-discard))
(lexical-binding
(push (cons var (1- byte-compile-depth))
byte-compile--lexical-environment))
(t (byte-compile-dynamic-variable-bind var)))
(byte-compile-body (cdr clause)) ;; byte-compile--for-effect
(cond
((null var) nil)
(lexical-binding (byte-compile-discard 1 'preserve-tos))
(t (byte-compile-out 'byte-unbind 1)))
(byte-compile-goto 'byte-goto endtag)))
(byte-compile-out-tag endtag)))
(defun byte-compile-save-excursion (form)
(if (and (eq 'set-buffer (car-safe (car-safe (cdr form))))
......
......@@ -79,8 +79,7 @@
;; command-history).
;; - canonize code in macro-expand so we don't have to handle (let (var) body)
;; and other oddities.
;; - new byte codes for unwind-protect, catch, and condition-case so that
;; closures aren't needed at all.
;; - new byte codes for unwind-protect so that closures aren't needed at all.
;; - a reference to a var that is known statically to always hold a constant
;; should be turned into a byte-constant rather than a byte-stack-ref.
;; Hmm... right, that's called constant propagation and could be done here,
......@@ -421,18 +420,42 @@ places where they originally did not directly appear."
forms)))
;condition-case
(`(condition-case ,var ,protected-form . ,handlers)
((and `(condition-case ,var ,protected-form . ,handlers)
(guard byte-compile--use-old-handlers))
(let ((newform (cconv--convert-function
() (list protected-form) env form)))
`(condition-case :fun-body ,newform
,@(mapcar (lambda (handler)
,@(mapcar (lambda (handler)
(list (car handler)
(cconv--convert-function
(list (or var cconv--dummy-var))
(cdr handler) env form)))
handlers))))
(`(,(and head (or `catch `unwind-protect)) ,form . ,body)
; condition-case with new byte-codes.
(`(condition-case ,var ,protected-form . ,handlers)
`(condition-case ,var
,(cconv-convert protected-form env extend)
,@(let* ((cm (and var (member (cons (list var) form)
cconv-captured+mutated)))
(newenv
(cond (cm (cons `(,var . (car-save ,var)) env))
((assq var env) (cons `(,var) env))
(t env))))
(mapcar
(lambda (handler)
`(,(car handler)
,@(let ((body
(mapcar (lambda (form)
(cconv-convert form newenv extend))
(cdr handler))))
(if (not cm) body
`((let ((,var (list ,var))) ,@body))))))
handlers))))
(`(,(and head (or (and `catch (guard byte-compile--use-old-handlers))
`unwind-protect))
,form . ,body)
`(,head ,(cconv-convert form env extend)
:fun-body ,(cconv--convert-function () body env form)))
......@@ -491,7 +514,7 @@ places where they originally did not directly appear."
(`(,func . ,forms)
;; First element is function or whatever function-like forms are: or, and,
;; if, progn, prog1, prog2, while, until
;; if, catch, progn, prog1, prog2, while, until
`(,func . ,(mapcar (lambda (form)
(cconv-convert form env extend))
forms)))
......@@ -646,16 +669,32 @@ and updates the data stored in ENV."
(`(quote . ,_) nil) ; quote form
(`(function . ,_) nil) ; same as quote
(`(condition-case ,var ,protected-form . ,handlers)
((and `(condition-case ,var ,protected-form . ,handlers)
(guard byte-compile--use-old-handlers))
;; FIXME: The bytecode for condition-case forces us to wrap the
;; form and handlers in closures (for handlers, it's understandable
;; but not for the protected form).
;; form and handlers in closures.
(cconv--analyse-function () (list protected-form) env form)
(dolist (handler handlers)
(cconv--analyse-function (if var (list var)) (cdr handler) env form)))
(cconv--analyse-function (if var (list var)) (cdr handler)
env form)))
;; FIXME: The bytecode for catch forces us to wrap the body.
(`(,(or `catch `unwind-protect) ,form . ,body)
(`(condition-case ,var ,protected-form . ,handlers)
(cconv-analyse-form protected-form env)
(when (and var (symbolp var) (byte-compile-not-lexical-var-p var))
(byte-compile-log-warning
(format "Lexical variable shadows the dynamic variable %S" var)))
(let* ((varstruct (list var nil nil nil nil)))
(if var (push varstruct env))
(dolist (handler handlers)
(dolist (form (cdr handler))
(cconv-analyse-form form env)))
(if var (cconv--analyse-use (cons (list var) (cdr varstruct))
form "variable"))))
;; FIXME: The bytecode for unwind-protect forces us to wrap the unwind.
(`(,(or (and `catch (guard byte-compile--use-old-handlers))
`unwind-protect)
,form . ,body)
(cconv-analyse-form form env)
(cconv--analyse-function () body env form))
......
2013-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
* lisp.h (struct handler): Merge struct handler and struct catchtag.
(PUSH_HANDLER): New macro.
(catchlist): Remove.
(handlerlist): Always declare.
* eval.c (catchlist): Remove (merge with handlerlist).
(handlerlist, lisp_eval_depth): Not static any more.
(internal_catch, internal_condition_case, internal_condition_case_1)
(internal_condition_case_2, internal_condition_case_n):
Use PUSH_HANDLER.
(unwind_to_catch, Fthrow, Fsignal): Adjust to merged
handlerlist/catchlist.
(internal_lisp_condition_case): Use PUSH_HANDLER. Adjust to new
handlerlist which can only handle a single condition-case handler at
a time.
(find_handler_clause): Simplify since we only a single branch here
any more.
* bytecode.c (BYTE_CODES): Add Bpushcatch, Bpushconditioncase
and Bpophandler.
(bcall0): New function.
(exec_byte_code): Add corresponding cases. Improve error message when
encountering an invalid byte-code. Let Bunwind_protect accept
a function (rather than a list of expressions) as argument.
* alloc.c (Fgarbage_collect): Merge scans of handlerlist and catchlist,
and make them unconditional now that they're heap-allocated.
2013-10-03 Stefan Monnier <monnier@iro.umontreal.ca>
* charset.c (Fdecode_char, Fencode_char): Remove description of
......
......@@ -5370,23 +5370,15 @@ See Info node `(elisp)Garbage Collection'. */)
mark_object (tail->var[i]);
}
mark_byte_stack ();
#endif
{
struct catchtag *catch;
struct handler *handler;
for (catch = catchlist; catch; catch = catch->next)
{
mark_object (catch->tag);
mark_object (catch->val);
}
for (handler = handlerlist; handler; handler = handler->next)
{
mark_object (handler->handler);
mark_object (handler->var);
}
for (handler = handlerlist; handler; handler = handler->next)
{
mark_object (handler->tag_or_ch);
mark_object (handler->val);
}
}
#endif
#ifdef HAVE_WINDOW_SYSTEM
mark_fringe_data ();
#endif
......
......@@ -141,6 +141,10 @@ DEFINE (Bunbind5, 055) \
DEFINE (Bunbind6, 056) \
DEFINE (Bunbind7, 057) \
\
DEFINE (Bpophandler, 060) \
DEFINE (Bpushconditioncase, 061) \
DEFINE (Bpushcatch, 062) \
\
DEFINE (Bnth, 070) \
DEFINE (Bsymbolp, 071) \
DEFINE (Bconsp, 072) \
......@@ -478,6 +482,12 @@ If the third argument is incorrect, Emacs may crash. */)
return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
}
static void
bcall0 (Lisp_Object f)
{
Ffuncall (1, &f);
}
/* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and
MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect,
emacs may crash!). If ARGS_TEMPLATE is non-nil, it should be a lisp
......@@ -506,6 +516,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
struct byte_stack stack;
Lisp_Object *top;
Lisp_Object result;
enum handlertype type;
#if 0 /* CHECK_FRAME_FONT */
{
......@@ -1078,7 +1089,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
save_restriction_save ());
NEXT;
CASE (Bcatch): /* FIXME: ill-suited for lexbind. */
CASE (Bcatch): /* Obsolete since 24.4. */
{
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
......@@ -1088,11 +1099,56 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
NEXT;
}
CASE (Bpushcatch): /* New in 24.4. */
type = CATCHER;
goto pushhandler;
CASE (Bpushconditioncase): /* New in 24.4. */
{
extern EMACS_INT lisp_eval_depth;
extern int poll_suppress_count;
extern int interrupt_input_blocked;
struct handler *c;
Lisp_Object tag;
int dest;
type = CONDITION_CASE;
pushhandler:
tag = POP;
dest = FETCH2;
PUSH_HANDLER (c, tag, type);
c->bytecode_dest = dest;
c->bytecode_top = top;
if (sys_setjmp (c->jmp))
{
struct handler *c = handlerlist;
top = c->bytecode_top;
int dest = c->bytecode_dest;
handlerlist = c->next;
PUSH (c->val);
CHECK_RANGE (dest);
stack.pc = stack.byte_string_start + dest;
}
NEXT;
}
CASE (Bpophandler): /* New in 24.4. */
{
handlerlist = handlerlist->next;
NEXT;
}
CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind. */
record_unwind_protect (unwind_body, POP);
NEXT;
{
Lisp_Object handler = POP;
/* Support for a function here is new in 24.4. */
record_unwind_protect (NILP (Ffunctionp (handler))
? unwind_body : bcall0,
handler);
NEXT;
}
CASE (Bcondition_case): /* FIXME: ill-suited for lexbind. */
CASE (Bcondition_case): /* Obsolete since 24.4. */
{
Lisp_Object handlers, body;
handlers = POP;
......@@ -1884,7 +1940,10 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
/* Actually this is Bstack_ref with offset 0, but we use Bdup
for that instead. */
/* CASE (Bstack_ref): */
error ("Invalid byte opcode");
call3 (intern ("error"),
build_string ("Invalid byte opcode: op=%s, ptr=%d"),
make_number (op),
make_number ((stack.pc - 1) - stack.byte_string_start));
/* Handy byte-codes for lexical binding. */
CASE (Bstack_ref1):
......@@ -1957,11 +2016,11 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
/* Binds and unbinds are supposed to be compiled balanced. */
if (SPECPDL_INDEX () != count)
#ifdef BYTE_CODE_SAFE
error ("binding stack not balanced (serious byte compiler bug)");
#else
emacs_abort ();
#endif
{
if (SPECPDL_INDEX () > count)
unbind_to (count, Qnil);
error ("binding stack not balanced (serious byte compiler bug)");
}
return result;
}
......
......@@ -32,20 +32,8 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include "xterm.h"
#endif
#if !BYTE_MARK_STACK
static
#endif
struct catchtag *catchlist;
/* Chain of condition handlers currently in effect.
The elements of this chain are contained in the stack frames
of Fcondition_case and internal_condition_case.
When an error is signaled (by calling Fsignal, below),
this chain is searched for an element that applies. */
/* Chain of condition and catch handlers currently in effect. */
#if !BYTE_MARK_STACK
static
#endif
struct handler *handlerlist;
#ifdef DEBUG_GCPRO
......@@ -92,7 +80,7 @@ union specbinding *specpdl_ptr;
/* Depth in Lisp evaluations and function calls. */
static EMACS_INT lisp_eval_depth;
EMACS_INT lisp_eval_depth;
/* The value of num_nonmacro_input_events as of the last time we
started to enter the debugger. If we decide to enter the debugger
......@@ -253,8 +241,7 @@ void
init_eval (void)
{
specpdl_ptr = specpdl;
catchlist = 0;
handlerlist = 0;
handlerlist = NULL;
Vquit_flag = Qnil;
debug_on_next_call = 0;
lisp_eval_depth = 0;
......@@ -1093,28 +1080,26 @@ Lisp_Object
internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
{
/* This structure is made part of the chain `catchlist'. */
struct catchtag c;
struct handler *c;
/* Fill in the components of c, and put it on the list. */
c.next = catchlist;
c.tag = tag;
c.val = Qnil;
c.handlerlist = handlerlist;
c.lisp_eval_depth = lisp_eval_depth;
c.pdlcount = SPECPDL_INDEX ();
c.poll_suppress_count = poll_suppress_count;
c.interrupt_input_blocked = interrupt_input_blocked;
c.gcpro = gcprolist;
c.byte_stack = byte_stack_list;
catchlist = &c;
PUSH_HANDLER (c, tag, CATCHER);
/* Call FUNC. */
if (! sys_setjmp (c.jmp))
c.val = (*func) (arg);
/* Throw works by a longjmp that comes right here. */
catchlist = c.next;
return c.val;
if (! sys_setjmp (c->jmp))
{
Lisp_Object val = (*func) (arg);
eassert (handlerlist == c);
handlerlist = c->next;
return val;
}
else
{ /* Throw works by a longjmp that comes right here. */
Lisp_Object val = handlerlist->val;
eassert (handlerlist == c);
handlerlist = handlerlist->next;
return val;
}
}
/* Unwind the specbind, catch, and handler stacks back to CATCH, and
......@@ -1134,7 +1119,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
This is used for correct unwinding in Fthrow and Fsignal. */
static _Noreturn void
unwind_to_catch (struct catchtag *catch, Lisp_Object value)
unwind_to_catch (struct handler *catch, Lisp_Object value)
{
bool last_time;
......@@ -1148,16 +1133,17 @@ unwind_to_catch (struct catchtag *catch, Lisp_Object value)
do
{
last_time = catchlist == catch;
/* Unwind the specpdl stack, and then restore the proper set of
handlers. */
unbind_to (catchlist->pdlcount, Qnil);
handlerlist = catchlist->handlerlist;
catchlist = catchlist->next;
unbind_to (handlerlist->pdlcount, Qnil);