mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-29 00:31:01 -08:00
Code Issues Projects Releases Wiki Activity

Merge from mainline.

Browse source
This commit is contained in:
Paul Eggert 2011-04-01 13:19:36 -07:00
commit 6ddae4efd9
75 changed files with 4670 additions and 2483 deletions
Download patch file Download diff file Expand all files Collapse all files

163
src/bytecode.c
View file

@ -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. */
@ -413,6 +420,21 @@ 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)
{
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
@ -475,6 +497,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
@ -735,7 +803,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 ();
@ -863,37 +931,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;
@ -904,7 +978,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));
@ -912,7 +986,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 ();
@ -1384,7 +1458,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;
@ -1674,8 +1748,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