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.

1 files changed, 69 insertions, 10 deletions

diff --git a/src/bytecode.c b/src/bytecode.c
index 23e50826633..f7ccd35cbba 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -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;
 }