diff options
Diffstat (limited to 'src/bytecode.c')
| -rw-r--r-- | src/bytecode.c | 128 |
1 files changed, 122 insertions, 6 deletions
diff --git a/src/bytecode.c b/src/bytecode.c index c53c5acdbb..fec855c0b8 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -87,9 +87,11 @@ int byte_metering_on; 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,14 +406,41 @@ unmark_byte_stack () } 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. */) - (bytestr, vector, maxdepth) - Lisp_Object bytestr, vector, 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) */) + (nargs, 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 (bytestr, vector, maxdepth, args_template, nargs, args) + Lisp_Object bytestr, vector, maxdepth, args_template; + int nargs; + Lisp_Object *args; { int count = SPECPDL_INDEX (); #ifdef BYTE_CODE_METER @@ -462,6 +498,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 @@ -1641,8 +1708,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, 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: |