1 files changed, 143 insertions, 20 deletions

diff --git a/src/bytecode.c b/src/bytecode.c
index a7be8e26f27..5d94cb0fb39 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -80,9 +80,11 @@ Lisp_Object Qbyte_code_meter;
 
 
 Lisp_Object Qbytecode;
+extern Lisp_Object Qand_optional, Qand_rest;
 
 /*  Byte codes: */
 
+#define Bstack_ref 0 /* Actually, Bstack_ref+0 is not implemented: use dup.  */
 #define Bvarref 010
 #define Bvarset 020
 #define Bvarbind 030
@@ -132,7 +134,7 @@ Lisp_Object Qbytecode;
 
 #define Bpoint 0140
 /* Was Bmark in v17.  */
-#define Bsave_current_buffer 0141
+#define Bsave_current_buffer 0141 /* Obsolete.  */
 #define Bgoto_char 0142
 #define Binsert 0143
 #define Bpoint_max 0144
@@ -158,7 +160,7 @@ Lisp_Object Qbytecode;
 #ifdef BYTE_CODE_SAFE
 #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
 #endif
-#define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
+#define Binteractive_p 0164 /* Obsolete since Emacs-24.1.  */
 
 #define Bforward_char 0165
 #define Bforward_word 0166
@@ -183,16 +185,16 @@ Lisp_Object Qbytecode;
 #define Bdup 0211
 
 #define Bsave_excursion 0212
-#define Bsave_window_excursion 0213
+#define Bsave_window_excursion 0213 /* Obsolete since Emacs-24.1.  */
 #define Bsave_restriction 0214
 #define Bcatch 0215
 
 #define Bunwind_protect 0216
 #define Bcondition_case 0217
-#define Btemp_output_buffer_setup 0220
-#define Btemp_output_buffer_show 0221
+#define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1.  */
+#define Btemp_output_buffer_show 0221  /* Obsolete since Emacs-24.1.  */
 
-#define Bunbind_all 0222
+#define Bunbind_all 0222        /* Obsolete.  Never used.  */
 
 #define Bset_marker 0223
 #define Bmatch_beginning 0224
@@ -228,6 +230,11 @@ Lisp_Object Qbytecode;
 #define BconcatN 0260
 #define BinsertN 0261
 
+/* Bstack_ref is code 0.  */
+#define Bstack_set  0262
+#define Bstack_set2 0263
+#define BdiscardN   0266
+
 #define Bconstant 0300
 
 /* Whether to maintain a `top' and `bottom' field in the stack frame.  */
@@ -414,6 +421,21 @@ the third, MAXDEPTH, the maximum stack depth used in this function.
 If the third argument is incorrect, Emacs may crash.  */)
   (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
 {
+  return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
+}
+
+/* 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
+   argument list (including &rest, &optional, etc.), and ARGS, of size
+   NARGS, should be a vector of the actual arguments.  The arguments in
+   ARGS are pushed on the stack according to ARGS_TEMPLATE before
+   executing BYTESTR.  */
+
+Lisp_Object
+exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
+                Lisp_Object args_template, int nargs, Lisp_Object *args)
+{
   int count = SPECPDL_INDEX ();
 #ifdef BYTE_CODE_METER
   int this_op = 0;
@@ -473,6 +495,52 @@ If the third argument is incorrect, Emacs may crash.  */)
   stacke = stack.bottom - 1 + XFASTINT (maxdepth);
 #endif
 
+  if (INTEGERP (args_template))
+    {
+      int at = XINT (args_template);
+      int rest = at & 128;
+      int mandatory = at & 127;
+      int nonrest = at >> 8;
+      eassert (mandatory <= nonrest);
+      if (nargs <= nonrest)
+        {
+          int i;
+          for (i = 0 ; i < nargs; i++, args++)
+            PUSH (*args);
+          if (nargs < mandatory)
+            /* Too few arguments.  */
+            Fsignal (Qwrong_number_of_arguments,
+                     Fcons (Fcons (make_number (mandatory),
+                                   rest ? Qand_rest : make_number (nonrest)),
+                            Fcons (make_number (nargs), Qnil)));
+          else
+            {
+              for (; i < nonrest; i++)
+                PUSH (Qnil);
+              if (rest)
+                PUSH (Qnil);
+            }
+        }
+      else if (rest)
+        {
+          int i;
+          for (i = 0 ; i < nonrest; i++, args++)
+            PUSH (*args);
+          PUSH (Flist (nargs - nonrest, args));
+        }
+      else
+        /* Too many arguments.  */
+        Fsignal (Qwrong_number_of_arguments,
+                 Fcons (Fcons (make_number (mandatory),
+                               make_number (nonrest)),
+                        Fcons (make_number (nargs), Qnil)));
+    }
+  else if (! NILP (args_template))
+    /* We should push some arguments on the stack.  */
+    {
+      error ("Unknown args template!");
+    }
+
   while (1)
     {
 #ifdef BYTE_CODE_SAFE
@@ -733,7 +801,7 @@ If the third argument is incorrect, Emacs may crash.  */)
           AFTER_POTENTIAL_GC ();
           break;
 
-        case Bunbind_all:
+        case Bunbind_all:       /* Obsolete.  Never used.  */
           /* To unbind back to the beginning of this frame.  Not used yet,
              but will be needed for tail-recursion elimination.  */
           BEFORE_POTENTIAL_GC ();
@@ -861,37 +929,43 @@ If the third argument is incorrect, Emacs may crash.  */)
                                  save_excursion_save ());
           break;
 
-        case Bsave_current_buffer:
+        case Bsave_current_buffer: /* Obsolete since ??.  */
         case Bsave_current_buffer_1:
           record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
           break;
 
-        case Bsave_window_excursion:
-          BEFORE_POTENTIAL_GC ();
-          TOP = Fsave_window_excursion (TOP);
-          AFTER_POTENTIAL_GC ();
-          break;
+        case Bsave_window_excursion: /* Obsolete since 24.1.  */
+          {
+            register int count = SPECPDL_INDEX ();
+            record_unwind_protect (Fset_window_configuration,
+                                   Fcurrent_window_configuration (Qnil));
+            BEFORE_POTENTIAL_GC ();
+            TOP = Fprogn (TOP);
+            unbind_to (count, TOP);
+            AFTER_POTENTIAL_GC ();
+            break;
+          }
 
         case Bsave_restriction:
           record_unwind_protect (save_restriction_restore,
                                  save_restriction_save ());
           break;
 
-        case Bcatch:
+        case Bcatch:            /* FIXME: ill-suited for lexbind */
           {
             Lisp_Object v1;
             BEFORE_POTENTIAL_GC ();
             v1 = POP;
-            TOP = internal_catch (TOP, Feval, v1);
+            TOP = internal_catch (TOP, eval_sub, v1);
             AFTER_POTENTIAL_GC ();
             break;
           }
 
-        case Bunwind_protect:
+        case Bunwind_protect:   /* FIXME: avoid closure for lexbind */
           record_unwind_protect (Fprogn, POP);
           break;
 
-        case Bcondition_case:
+        case Bcondition_case:   /* FIXME: ill-suited for lexbind */
           {
             Lisp_Object handlers, body;
             handlers = POP;
@@ -902,7 +976,7 @@ If the third argument is incorrect, Emacs may crash.  */)
             break;
           }
 
-        case Btemp_output_buffer_setup:
+        case Btemp_output_buffer_setup: /* Obsolete since 24.1.  */
           BEFORE_POTENTIAL_GC ();
           CHECK_STRING (TOP);
           temp_output_buffer_setup (SSDATA (TOP));
@@ -910,7 +984,7 @@ If the third argument is incorrect, Emacs may crash.  */)
           TOP = Vstandard_output;
           break;
 
-        case Btemp_output_buffer_show:
+        case Btemp_output_buffer_show: /* Obsolete since 24.1.  */
           {
             Lisp_Object v1;
             BEFORE_POTENTIAL_GC ();
@@ -1382,7 +1456,7 @@ If the third argument is incorrect, Emacs may crash.  */)
           AFTER_POTENTIAL_GC ();
           break;
 
-        case Binteractive_p:
+        case Binteractive_p:    /* Obsolete since 24.1.  */
           PUSH (Finteractive_p ());
           break;
 
@@ -1672,8 +1746,57 @@ If the third argument is incorrect, Emacs may crash.  */)
 #endif
 
         case 0:
+          /* Actually this is Bstack_ref with offset 0, but we use Bdup
+             for that instead.  */
+          /* case Bstack_ref: */
           abort ();
 
+          /* Handy byte-codes for lexical binding.  */
+        case Bstack_ref+1:
+        case Bstack_ref+2:
+        case Bstack_ref+3:
+        case Bstack_ref+4:
+        case Bstack_ref+5:
+          {
+            Lisp_Object *ptr = top - (op - Bstack_ref);
+            PUSH (*ptr);
+            break;
+          }
+        case Bstack_ref+6:
+          {
+            Lisp_Object *ptr = top - (FETCH);
+            PUSH (*ptr);
+            break;
+          }
+        case Bstack_ref+7:
+          {
+            Lisp_Object *ptr = top - (FETCH2);
+            PUSH (*ptr);
+            break;
+          }
+          /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos.  */
+        case Bstack_set:
+          {
+            Lisp_Object *ptr = top - (FETCH);
+            *ptr = POP;
+            break;
+          }
+        case Bstack_set2:
+          {
+            Lisp_Object *ptr = top - (FETCH2);
+            *ptr = POP;
+            break;
+          }
+        case BdiscardN:
+          op = FETCH;
+          if (op & 0x80)
+            {
+              op &= 0x7F;
+              top[-op] = TOP;
+            }
+          DISCARD (op);
+          break;
+
         case 255:
         default:
 #ifdef BYTE_CODE_SAFE