mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-08 04:30:45 -08:00
Code Issues Projects Releases Wiki Activity

New branch for lexbind, losing all history.

Browse source 
This initial patch is based on 2002-06-27T22:39:10Z!storm@cua.dk of the original
lexbind branch.
This commit is contained in:
Stefan Monnier 2010-06-13 16:36:17 -04:00
parent a6e8d97c14
commit b9598260f9
30 changed files with 3032 additions and 416 deletions
Download patch file Download diff file Expand all files Collapse all files

128
src/bytecode.c
View file

@ -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: