diff options
| author | Tom Tromey <tom@tromey.com> | 2018-01-20 12:25:26 -0700 |
|---|---|---|
| committer | Tom Tromey <tom@tromey.com> | 2018-01-22 22:11:26 -0700 |
| commit | 916094a84f0ab31be31aa6c3632f14176b4e882a (patch) | |
| tree | 5d14b3b849b7b63f19577bd45bbbd85cdba0b702 /src/bytecode.c | |
| parent | a6b4b9b4af5405b62cbd59f5ce23ca0fe0027ac7 (diff) | |
| download | emacs-feature/byte-unwind-protect.tar.gz | |
Add new bytecodes for unwind-protectfeature/byte-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.
Diffstat (limited to 'src/bytecode.c')
| -rw-r--r-- | src/bytecode.c | 43 |
1 files changed, 42 insertions, 1 deletions
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. */ |