\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
#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
} 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
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
case Bsave_window_excursion:
BEFORE_POTENTIAL_GC ();
- TOP = Fsave_window_excursion (TOP);
+ TOP = Fsave_window_excursion (TOP); /* FIXME: lexbind */
AFTER_POTENTIAL_GC ();
break;
Lisp_Object v1;
BEFORE_POTENTIAL_GC ();
v1 = POP;
- TOP = internal_catch (TOP, Feval, v1);
+ TOP = internal_catch (TOP, eval_sub, v1); /* FIXME: lexbind */
AFTER_POTENTIAL_GC ();
break;
}
case Bunwind_protect:
- record_unwind_protect (Fprogn, POP);
+ record_unwind_protect (Fprogn, POP); /* FIXME: lexbind */
break;
case Bcondition_case:
handlers = POP;
body = POP;
BEFORE_POTENTIAL_GC ();
- TOP = internal_lisp_condition_case (TOP, body, handlers);
+ TOP = internal_lisp_condition_case (TOP, body, handlers); /* FIXME: lexbind */
AFTER_POTENTIAL_GC ();
break;
}
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: