Merge from trunk

[bpt/emacs.git] / src / bytecode.c

diff --git a/src/bytecode.c b/src/bytecode.c
index 88ac509..d94b19b 100644 (file)
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -87,9 +87,11 @@ int byte_metering_on;
 \f
 
 Lisp_Object Qbytecode;
+extern Lisp_Object Qand_optional, Qand_rest;
 
 /*  Byte codes: */
 
+#define Bstack_ref 0
 #define Bvarref 010
 #define Bvarset 020
 #define Bvarbind 030
@@ -229,6 +231,13 @@ Lisp_Object Qbytecode;
 #define BconcatN 0260
 #define BinsertN 0261
 
+/* Bstack_ref is code 0.  */
+#define Bstack_set  0262
+#define Bstack_set2 0263
+#define Bvec_ref    0264
+#define Bvec_set    0265
+#define BdiscardN   0266
+
 #define Bconstant 0300
 #define CONSTANTLIM 0100
 
@@ -397,13 +406,37 @@ unmark_byte_stack (void)
   } while (0)
 
 
-DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
+DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, MANY, 0,
        doc: /* Function used internally in byte-compiled code.
 The first argument, BYTESTR, is a string of byte code;
 the second, VECTOR, a vector of constants;
 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)
+If the third argument is incorrect, Emacs may crash.
+
+If ARGS-TEMPLATE is specified, it is an argument list specification,
+according to which any remaining arguments are pushed on the stack
+before executing BYTESTR.
+
+usage: (byte-code BYTESTR VECTOR MAXDEP &optional ARGS-TEMPLATE &rest ARGS) */)
+     (int nargs, Lisp_Object *args)
+{
+  Lisp_Object args_tmpl = nargs >= 4 ? args[3] : Qnil;
+  int pnargs = nargs >= 4 ? nargs - 4 : 0;
+  Lisp_Object *pargs = nargs >= 4 ? args + 4 : 0;
+  return exec_byte_code (args[0], args[1], args[2], args_tmpl, pnargs, pargs);
+}
+
+/* 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
@@ -461,6 +494,37 @@ If the third argument is incorrect, Emacs may crash.  */)
   stacke = stack.bottom - 1 + XFASTINT (maxdepth);
 #endif
 
+  if (! NILP (args_template))
+    /* We should push some arguments on the stack.  */
+    {
+      Lisp_Object at;
+      int pushed = 0, optional = 0;
+
+      for (at = args_template; CONSP (at); at = XCDR (at))
+       if (EQ (XCAR (at), Qand_optional))
+         optional = 1;
+       else if (EQ (XCAR (at), Qand_rest))
+         {
+           PUSH (Flist (nargs, args));
+           pushed = nargs;
+           at = Qnil;
+           break;
+         }
+       else if (pushed < nargs)
+         {
+           PUSH (*args++);
+           pushed++;
+         }
+       else if (optional)
+         PUSH (Qnil);
+       else
+         break;
+
+      if (pushed != nargs || !NILP (at))
+       Fsignal (Qwrong_number_of_arguments,
+                Fcons (args_template, Fcons (make_number (nargs), Qnil)));
+    }
+
   while (1)
     {
 #ifdef BYTE_CODE_SAFE
@@ -1640,8 +1704,57 @@ If the third argument is incorrect, Emacs may crash.  */)
          break;
 #endif
 
-       case 0:
-         abort ();
+         /* Handy byte-codes for lexical binding.  */
+       case Bstack_ref:
+       case Bstack_ref+1:
+       case Bstack_ref+2:
+       case Bstack_ref+3:
+       case Bstack_ref+4:
+       case Bstack_ref+5:
+         PUSH (stack.bottom[op - Bstack_ref]);
+         break;
+       case Bstack_ref+6:
+         PUSH (stack.bottom[FETCH]);
+         break;
+       case Bstack_ref+7:
+         PUSH (stack.bottom[FETCH2]);
+         break;
+       case Bstack_set:
+         stack.bottom[FETCH] = POP;
+         break;
+       case Bstack_set2:
+         stack.bottom[FETCH2] = POP;
+         break;
+       case Bvec_ref:
+       case Bvec_set:
+         /* These byte-codes used mostly for variable references to
+            lexically bound variables that are in an environment vector
+            instead of on the byte-interpreter stack (generally those
+            variables which might be shared with a closure).  */
+         {
+           int index = FETCH;
+           Lisp_Object vec = POP;
+
+           if (! VECTORP (vec))
+             wrong_type_argument (Qvectorp, vec);
+           else if (index < 0 || index >= XVECTOR (vec)->size)
+             args_out_of_range (vec, make_number (index));
+
+           if (op == Bvec_ref)
+             PUSH (XVECTOR (vec)->contents[index]);
+           else
+             XVECTOR (vec)->contents[index] = POP;
+         }
+         break;
+       case BdiscardN:
+         op = FETCH;
+         if (op & 0x80)
+           {
+             op &= 0x7F;
+             top[-op] = TOP;
+           }
+         DISCARD (op);
+         break;
 
        case 255:
        default: