From 916094a84f0ab31be31aa6c3632f14176b4e882a Mon Sep 17 00:00:00 2001
From: Tom Tromey
Date: Sat, 20 Jan 2018 12:25:26 -0700
Subject: Add new bytecodes for unwind-protect

* lisp/emacs-lisp/byte-opt.el (disassemble-offset): Handle
byte-pushunwindprotect.
* lisp/emacs-lisp/bytecomp.el (byte-pushunwindprotect)
(byte-endunwindprotect): New bytecodes.
(byte-goto-ops): Add byte-pushunwindprotect.
(byte-compile-unwind-protect): Emit new bytecodes.
(byte-compile-goto): Handle byte-pushunwindprotect.
* lisp/emacs-lisp/cconv.el (cconv-convert): Don't special-case
unwind-protect when byte-compile--use-old-handlers.
(cconv-analyze-form): Likewise.
* src/bytecode.c (Bpushunwindprotect, Bendunwindprotect): New bytecodes.
(exec_byte_code): Implement new bytecodes.
* test/src/bytecode-tests.el: New file.
---
 src/bytecode.c | 43 ++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 42 insertions(+), 1 deletion(-)

(limited to 'src/bytecode.c')

diff --git a/src/bytecode.c b/src/bytecode.c
index 55b193ffb2f..62ba2ca69d0 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -132,6 +132,8 @@ DEFINE (Bunbind7, 057)							\
 DEFINE (Bpophandler, 060)						\
 DEFINE (Bpushconditioncase, 061)					\
 DEFINE (Bpushcatch, 062)						\
+DEFINE (Bpushunwindprotect, 063)					\
+DEFINE (Bendunwindprotect, 064)						\
 									\
 DEFINE (Bnth, 070)							\
 DEFINE (Bsymbolp, 071)							\
@@ -770,6 +772,45 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	    NEXT;
 	  }
 
+	CASE (Bpushunwindprotect): /* New in 27.1.  */
+	  {
+	    struct handler *c = push_handler (Qt, CATCHER_ALL);
+	    c->bytecode_dest = FETCH2;
+	    c->bytecode_top = top;
+
+	    if (sys_setjmp (c->jmp))
+	      {
+		struct handler *c = handlerlist;
+		top = c->bytecode_top;
+		op = c->bytecode_dest;
+		handlerlist = c->next;
+		/* Push the exception value, plus a flag indicating
+		   that re-throwing is necessary.  This will be used
+		   by Bendunwindprotect.  */
+		PUSH (c->val);
+		PUSH (Qt);
+		goto op_branch;
+	      }
+
+	    NEXT;
+	  }
+	CASE (Bendunwindprotect): /* New in 27.1.  */
+	  {
+	    Lisp_Object flag = POP;
+
+	    if (!NILP (flag))
+	      {
+		Lisp_Object err = POP;
+
+		if (EQ (XCAR (err), Qsignal))
+		  Fsignal (XCAR (XCDR (err)), XCDR (XCDR (err)));
+		else
+		  Fthrow (XCAR (XCDR (err)), XCDR (XCDR (err)));
+	      }
+
+	    NEXT;
+	  }
+
 	CASE (Bpushcatch):	/* New in 24.4.  */
 	  type = CATCHER;
 	  goto pushhandler;
@@ -798,7 +839,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 	  handlerlist = handlerlist->next;
 	  NEXT;
 
-	CASE (Bunwind_protect):	/* FIXME: avoid closure for lexbind.  */
+	CASE (Bunwind_protect):	/* Obsolete since 27.1.  */
 	  {
 	    Lisp_Object handler = POP;
 	    /* Support for a function here is new in 24.4.  */
-- 
cgit v1.2.1