bytecode.c 37.5 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Execution of byte code produced by bytecomp.el.
Paul Eggert's avatar
Paul Eggert committed
2
   Copyright (C) 1985-1988, 1993, 2000-2016 Free Software Foundation,
3
   Inc.
Jim Blandy's avatar
Jim Blandy committed
4 5 6

This file is part of GNU Emacs.

7
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
8
it under the terms of the GNU General Public License as published by
9 10
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
11 12 13 14 15 16 17

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
18
along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.  */
Jim Blandy's avatar
Jim Blandy committed
19

20
#include <config.h>
21

Jim Blandy's avatar
Jim Blandy committed
22
#include "lisp.h"
Paul Eggert's avatar
Paul Eggert committed
23
#include "blockinput.h"
24
#include "character.h"
25
#include "buffer.h"
Paul Eggert's avatar
Paul Eggert committed
26
#include "keyboard.h"
Jim Blandy's avatar
Jim Blandy committed
27
#include "syntax.h"
Stefan Monnier's avatar
Stefan Monnier committed
28
#include "window.h"
Jim Blandy's avatar
Jim Blandy committed
29

30 31 32 33 34
/* Work around GCC bug 54561.  */
#if GNUC_PREREQ (4, 3, 0)
# pragma GCC diagnostic ignored "-Wclobbered"
#endif

35
/*
36
 * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
37 38
 * debugging the byte compiler...)
 *
39
 * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
Jim Blandy's avatar
Jim Blandy committed
40
 */
41 42
/* #define BYTE_CODE_SAFE */
/* #define BYTE_CODE_METER */
Jim Blandy's avatar
Jim Blandy committed
43

Tom Tromey's avatar
Tom Tromey committed
44 45 46 47
/* If BYTE_CODE_THREADED is defined, then the interpreter will be
   indirect threaded, using GCC's computed goto extension.  This code,
   as currently implemented, is incompatible with BYTE_CODE_SAFE and
   BYTE_CODE_METER.  */
Paul Eggert's avatar
Paul Eggert committed
48 49
#if (defined __GNUC__ && !defined __STRICT_ANSI__ \
     && !defined BYTE_CODE_SAFE && !defined BYTE_CODE_METER)
Tom Tromey's avatar
Tom Tromey committed
50 51 52
#define BYTE_CODE_THREADED
#endif

Jim Blandy's avatar
Jim Blandy committed
53 54 55

#ifdef BYTE_CODE_METER

56 57
#define METER_2(code1, code2) \
  (*aref_addr (AREF (Vbyte_code_meter, code1), code2))
58
#define METER_1(code) METER_2 (0, code)
59

60 61 62 63
#define METER_CODE(last_code, this_code)				\
{									\
  if (byte_metering_on)							\
    {									\
64 65 66
      if (XFASTINT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM)	\
        XSETFASTINT (METER_1 (this_code),				\
		     XFASTINT (METER_1 (this_code)) + 1);		\
67
      if (last_code							\
68 69 70 71
	  && (XFASTINT (METER_2 (last_code, this_code))			\
	      < MOST_POSITIVE_FIXNUM))					\
        XSETFASTINT (METER_2 (last_code, this_code),			\
		     XFASTINT (METER_2 (last_code, this_code)) + 1);	\
72
    }									\
73
}
Jim Blandy's avatar
Jim Blandy committed
74

75
#endif /* BYTE_CODE_METER */
Jim Blandy's avatar
Jim Blandy committed
76 77 78 79


/*  Byte codes: */

Tom Tromey's avatar
Tom Tromey committed
80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129
#define BYTE_CODES							\
DEFINE (Bstack_ref, 0) /* Actually, Bstack_ref+0 is not implemented: use dup.  */ \
DEFINE (Bstack_ref1, 1)							\
DEFINE (Bstack_ref2, 2)							\
DEFINE (Bstack_ref3, 3)							\
DEFINE (Bstack_ref4, 4)							\
DEFINE (Bstack_ref5, 5)							\
DEFINE (Bstack_ref6, 6)							\
DEFINE (Bstack_ref7, 7)							\
DEFINE (Bvarref, 010)							\
DEFINE (Bvarref1, 011)							\
DEFINE (Bvarref2, 012)							\
DEFINE (Bvarref3, 013)							\
DEFINE (Bvarref4, 014)							\
DEFINE (Bvarref5, 015)							\
DEFINE (Bvarref6, 016)							\
DEFINE (Bvarref7, 017)							\
DEFINE (Bvarset, 020)							\
DEFINE (Bvarset1, 021)							\
DEFINE (Bvarset2, 022)							\
DEFINE (Bvarset3, 023)							\
DEFINE (Bvarset4, 024)							\
DEFINE (Bvarset5, 025)							\
DEFINE (Bvarset6, 026)							\
DEFINE (Bvarset7, 027)							\
DEFINE (Bvarbind, 030)							\
DEFINE (Bvarbind1, 031)							\
DEFINE (Bvarbind2, 032)							\
DEFINE (Bvarbind3, 033)							\
DEFINE (Bvarbind4, 034)							\
DEFINE (Bvarbind5, 035)							\
DEFINE (Bvarbind6, 036)							\
DEFINE (Bvarbind7, 037)							\
DEFINE (Bcall, 040)							\
DEFINE (Bcall1, 041)							\
DEFINE (Bcall2, 042)							\
DEFINE (Bcall3, 043)							\
DEFINE (Bcall4, 044)							\
DEFINE (Bcall5, 045)							\
DEFINE (Bcall6, 046)							\
DEFINE (Bcall7, 047)							\
DEFINE (Bunbind, 050)							\
DEFINE (Bunbind1, 051)							\
DEFINE (Bunbind2, 052)							\
DEFINE (Bunbind3, 053)							\
DEFINE (Bunbind4, 054)							\
DEFINE (Bunbind5, 055)							\
DEFINE (Bunbind6, 056)							\
DEFINE (Bunbind7, 057)							\
									\
130 131 132 133
DEFINE (Bpophandler, 060)						\
DEFINE (Bpushconditioncase, 061)					\
DEFINE (Bpushcatch, 062)						\
									\
Tom Tromey's avatar
Tom Tromey committed
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276
DEFINE (Bnth, 070)							\
DEFINE (Bsymbolp, 071)							\
DEFINE (Bconsp, 072)							\
DEFINE (Bstringp, 073)							\
DEFINE (Blistp, 074)							\
DEFINE (Beq, 075)							\
DEFINE (Bmemq, 076)							\
DEFINE (Bnot, 077)							\
DEFINE (Bcar, 0100)							\
DEFINE (Bcdr, 0101)							\
DEFINE (Bcons, 0102)							\
DEFINE (Blist1, 0103)							\
DEFINE (Blist2, 0104)							\
DEFINE (Blist3, 0105)							\
DEFINE (Blist4, 0106)							\
DEFINE (Blength, 0107)							\
DEFINE (Baref, 0110)							\
DEFINE (Baset, 0111)							\
DEFINE (Bsymbol_value, 0112)						\
DEFINE (Bsymbol_function, 0113)						\
DEFINE (Bset, 0114)							\
DEFINE (Bfset, 0115)							\
DEFINE (Bget, 0116)							\
DEFINE (Bsubstring, 0117)						\
DEFINE (Bconcat2, 0120)							\
DEFINE (Bconcat3, 0121)							\
DEFINE (Bconcat4, 0122)							\
DEFINE (Bsub1, 0123)							\
DEFINE (Badd1, 0124)							\
DEFINE (Beqlsign, 0125)							\
DEFINE (Bgtr, 0126)							\
DEFINE (Blss, 0127)							\
DEFINE (Bleq, 0130)							\
DEFINE (Bgeq, 0131)							\
DEFINE (Bdiff, 0132)							\
DEFINE (Bnegate, 0133)							\
DEFINE (Bplus, 0134)							\
DEFINE (Bmax, 0135)							\
DEFINE (Bmin, 0136)							\
DEFINE (Bmult, 0137)							\
									\
DEFINE (Bpoint, 0140)							\
/* Was Bmark in v17.  */						\
DEFINE (Bsave_current_buffer, 0141) /* Obsolete.  */			\
DEFINE (Bgoto_char, 0142)						\
DEFINE (Binsert, 0143)							\
DEFINE (Bpoint_max, 0144)						\
DEFINE (Bpoint_min, 0145)						\
DEFINE (Bchar_after, 0146)						\
DEFINE (Bfollowing_char, 0147)						\
DEFINE (Bpreceding_char, 0150)						\
DEFINE (Bcurrent_column, 0151)						\
DEFINE (Bindent_to, 0152)						\
DEFINE (Beolp, 0154)							\
DEFINE (Beobp, 0155)							\
DEFINE (Bbolp, 0156)							\
DEFINE (Bbobp, 0157)							\
DEFINE (Bcurrent_buffer, 0160)						\
DEFINE (Bset_buffer, 0161)						\
DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer.  */ \
DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1.  */		\
									\
DEFINE (Bforward_char, 0165)						\
DEFINE (Bforward_word, 0166)						\
DEFINE (Bskip_chars_forward, 0167)					\
DEFINE (Bskip_chars_backward, 0170)					\
DEFINE (Bforward_line, 0171)						\
DEFINE (Bchar_syntax, 0172)						\
DEFINE (Bbuffer_substring, 0173)					\
DEFINE (Bdelete_region, 0174)						\
DEFINE (Bnarrow_to_region, 0175)					\
DEFINE (Bwiden, 0176)							\
DEFINE (Bend_of_line, 0177)						\
									\
DEFINE (Bconstant2, 0201)						\
DEFINE (Bgoto, 0202)							\
DEFINE (Bgotoifnil, 0203)						\
DEFINE (Bgotoifnonnil, 0204)						\
DEFINE (Bgotoifnilelsepop, 0205)					\
DEFINE (Bgotoifnonnilelsepop, 0206)					\
DEFINE (Breturn, 0207)							\
DEFINE (Bdiscard, 0210)							\
DEFINE (Bdup, 0211)							\
									\
DEFINE (Bsave_excursion, 0212)						\
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) /* Obsolete since Emacs-24.1.  */ \
DEFINE (Btemp_output_buffer_show, 0221)  /* Obsolete since Emacs-24.1.  */ \
									\
DEFINE (Bunbind_all, 0222)	/* Obsolete.  Never used.  */		\
									\
DEFINE (Bset_marker, 0223)						\
DEFINE (Bmatch_beginning, 0224)						\
DEFINE (Bmatch_end, 0225)						\
DEFINE (Bupcase, 0226)							\
DEFINE (Bdowncase, 0227)						\
									\
DEFINE (Bstringeqlsign, 0230)						\
DEFINE (Bstringlss, 0231)						\
DEFINE (Bequal, 0232)							\
DEFINE (Bnthcdr, 0233)							\
DEFINE (Belt, 0234)							\
DEFINE (Bmember, 0235)							\
DEFINE (Bassq, 0236)							\
DEFINE (Bnreverse, 0237)						\
DEFINE (Bsetcar, 0240)							\
DEFINE (Bsetcdr, 0241)							\
DEFINE (Bcar_safe, 0242)						\
DEFINE (Bcdr_safe, 0243)						\
DEFINE (Bnconc, 0244)							\
DEFINE (Bquo, 0245)							\
DEFINE (Brem, 0246)							\
DEFINE (Bnumberp, 0247)							\
DEFINE (Bintegerp, 0250)						\
									\
DEFINE (BRgoto, 0252)							\
DEFINE (BRgotoifnil, 0253)						\
DEFINE (BRgotoifnonnil, 0254)						\
DEFINE (BRgotoifnilelsepop, 0255)					\
DEFINE (BRgotoifnonnilelsepop, 0256)					\
									\
DEFINE (BlistN, 0257)							\
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)

enum byte_code_op
{
#define DEFINE(name, value) name = value,
    BYTE_CODES
#undef DEFINE

277
#ifdef BYTE_CODE_SAFE
Tom Tromey's avatar
Tom Tromey committed
278
    Bscan_buffer = 0153, /* No longer generated as of v18.  */
Paul Eggert's avatar
Paul Eggert committed
279
    Bset_mark = 0163, /* this loser is no longer generated as of v18 */
280
#endif
Tom Tromey's avatar
Tom Tromey committed
281
};
282

Gerd Moellmann's avatar
Gerd Moellmann committed
283 284 285 286 287 288 289
/* Structure describing a value stack used during byte-code execution
   in Fbyte_code.  */

struct byte_stack
{
  /* Program counter.  This points into the byte_string below
     and is relocated when that string is relocated.  */
290
  const unsigned char *pc;
Gerd Moellmann's avatar
Gerd Moellmann committed
291

292 293 294 295 296 297
  /* bottom of stack.  The bottom points to an area of memory
     allocated with alloca in Fbyte_code.  */
#ifdef BYTE_CODE_SAFE
  Lisp_Object *bottom;
#endif

Gerd Moellmann's avatar
Gerd Moellmann committed
298
  /* The string containing the byte-code, and its current address.
299
     Storing this here protects it from GC.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
300
  Lisp_Object byte_string;
301
  const unsigned char *byte_string_start;
Gerd Moellmann's avatar
Gerd Moellmann committed
302 303 304 305 306 307 308

  /* Next entry in byte_stack_list.  */
  struct byte_stack *next;
};

/* A list of currently active byte-code execution value stacks.
   Fbyte_code adds an entry to the head of this list before it starts
309
   processing byte-code, and it removes the entry again when it is
310
   done.  Signaling an error truncates the list.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
311 312 313

struct byte_stack *byte_stack_list;

314

315 316
/* Relocate program counters in the stacks on byte_stack_list.  Called
   when GC has completed.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
317

318
void
319
relocate_byte_stack (void)
Gerd Moellmann's avatar
Gerd Moellmann committed
320 321 322 323
{
  struct byte_stack *stack;

  for (stack = byte_stack_list; stack; stack = stack->next)
324
    {
325
      if (stack->byte_string_start != SDATA (stack->byte_string))
326
	{
327
	  ptrdiff_t offset = stack->pc - stack->byte_string_start;
328
	  stack->byte_string_start = SDATA (stack->byte_string);
329 330 331
	  stack->pc = stack->byte_string_start + offset;
	}
    }
Gerd Moellmann's avatar
Gerd Moellmann committed
332 333
}

Jim Blandy's avatar
Jim Blandy committed
334

335
/* Fetch the next byte from the bytecode stream.  */
Jim Blandy's avatar
Jim Blandy committed
336

337 338 339
#ifdef BYTE_CODE_SAFE
#define FETCH (eassert (stack.byte_string_start == SDATA (stack.byte_string)), *stack.pc++)
#else
Gerd Moellmann's avatar
Gerd Moellmann committed
340
#define FETCH *stack.pc++
341
#endif
Jim Blandy's avatar
Jim Blandy committed
342

343
/* Fetch two bytes from the bytecode stream and make a 16-bit number
344
   out of them.  */
Jim Blandy's avatar
Jim Blandy committed
345 346 347

#define FETCH2 (op = FETCH, op + (FETCH << 8))

348 349
/* Push X onto the execution stack.  The expression X should not
   contain TOP, to avoid competing side effects.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
350

351
#define PUSH(x) (*++top = (x))
Jim Blandy's avatar
Jim Blandy committed
352 353 354

/* Pop a value off the execution stack.  */

Gerd Moellmann's avatar
Gerd Moellmann committed
355
#define POP (*top--)
Jim Blandy's avatar
Jim Blandy committed
356 357 358

/* Discard n values from the execution stack.  */

Gerd Moellmann's avatar
Gerd Moellmann committed
359 360 361
#define DISCARD(n) (top -= (n))

/* Get the value which is at the top of the execution stack, but don't
362
   pop it.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
363 364

#define TOP (*top)
Jim Blandy's avatar
Jim Blandy committed
365

366
/* Check for jumping out of range.  */
Gerd Moellmann's avatar
Gerd Moellmann committed
367 368 369

#ifdef BYTE_CODE_SAFE

370
#define CHECK_RANGE(ARG) \
371
  if (ARG >= bytestr_length) emacs_abort ()
372

373
#else /* not BYTE_CODE_SAFE */
Gerd Moellmann's avatar
Gerd Moellmann committed
374 375 376

#define CHECK_RANGE(ARG)

377
#endif /* not BYTE_CODE_SAFE */
Gerd Moellmann's avatar
Gerd Moellmann committed
378

Gerd Moellmann's avatar
Gerd Moellmann committed
379 380 381 382 383 384 385
/* A version of the QUIT macro which makes sure that the stack top is
   set before signaling `quit'.  */

#define BYTE_CODE_QUIT					\
  do {							\
    if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))	\
      {							\
386
        Lisp_Object flag = Vquit_flag;			\
Gerd Moellmann's avatar
Gerd Moellmann committed
387
	Vquit_flag = Qnil;				\
388
	if (EQ (Vthrow_on_input, flag))			\
389
	  Fthrow (Vthrow_on_input, Qt);			\
Paul Eggert's avatar
Paul Eggert committed
390
	quit ();					\
Gerd Moellmann's avatar
Gerd Moellmann committed
391
      }							\
392 393
    else if (pending_signals)				\
      process_pending_signals ();			\
Gerd Moellmann's avatar
Gerd Moellmann committed
394 395
  } while (0)

Gerd Moellmann's avatar
Gerd Moellmann committed
396

Jim Blandy's avatar
Jim Blandy committed
397
DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
398 399 400 401 402
       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.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
403
  (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
404
{
405
  return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
406 407
}

408 409 410 411 412 413
static void
bcall0 (Lisp_Object f)
{
  Ffuncall (1, &f);
}

414 415 416 417 418 419 420 421 422
/* 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
Stefan Monnier's avatar
Stefan Monnier committed
423
exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
424
		Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
Jim Blandy's avatar
Jim Blandy committed
425
{
426
  ptrdiff_t count = SPECPDL_INDEX ();
Jim Blandy's avatar
Jim Blandy committed
427
#ifdef BYTE_CODE_METER
428
  int volatile this_op = 0;
Jim Blandy's avatar
Jim Blandy committed
429 430
  int prev_op;
#endif
Gerd Moellmann's avatar
Gerd Moellmann committed
431
  int op;
432
  /* Lisp_Object v1, v2; */
433
  Lisp_Object *vectorp;
Jim Blandy's avatar
Jim Blandy committed
434
#ifdef BYTE_CODE_SAFE
435 436 437
  ptrdiff_t const_length;
  Lisp_Object *stacke;
  ptrdiff_t bytestr_length;
438
#endif
Gerd Moellmann's avatar
Gerd Moellmann committed
439 440
  struct byte_stack stack;
  Lisp_Object *top;
441
  Lisp_Object result;
442
  enum handlertype type;
Jim Blandy's avatar
Jim Blandy committed
443

444
  CHECK_STRING (bytestr);
Kim F. Storm's avatar
Kim F. Storm committed
445
  CHECK_VECTOR (vector);
446
  CHECK_NATNUM (maxdepth);
Jim Blandy's avatar
Jim Blandy committed
447

448
#ifdef BYTE_CODE_SAFE
449
  const_length = ASIZE (vector);
450 451
#endif

452 453 454 455 456
  if (STRING_MULTIBYTE (bytestr))
    /* BYTESTR must have been produced by Emacs 20.2 or the earlier
       because they produced a raw 8-bit string for byte-code and now
       such a byte-code string is loaded as multibyte while raw 8-bit
       characters converted to multibyte form.  Thus, now we must
457
       convert them back to the originally intended unibyte form.  */
458
    bytestr = Fstring_as_unibyte (bytestr);
459

460
#ifdef BYTE_CODE_SAFE
461
  bytestr_length = SBYTES (bytestr);
462
#endif
Paul Eggert's avatar
Paul Eggert committed
463
  vectorp = XVECTOR (vector)->contents;
464

Gerd Moellmann's avatar
Gerd Moellmann committed
465
  stack.byte_string = bytestr;
466
  stack.pc = stack.byte_string_start = SDATA (bytestr);
467
  if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth))
468
    memory_full (SIZE_MAX);
469
  top = alloca ((XFASTINT (maxdepth) + 1) * sizeof *top);
470 471 472
#ifdef BYTE_CODE_SAFE
  stack.bottom = top + 1;
#endif
Gerd Moellmann's avatar
Gerd Moellmann committed
473 474
  stack.next = byte_stack_list;
  byte_stack_list = &stack;
Jim Blandy's avatar
Jim Blandy committed
475

Gerd Moellmann's avatar
Gerd Moellmann committed
476 477 478
#ifdef BYTE_CODE_SAFE
  stacke = stack.bottom - 1 + XFASTINT (maxdepth);
#endif
479

480
  if (!NILP (args_template))
481
    {
482
      eassert (INTEGERP (args_template));
483
      ptrdiff_t at = XINT (args_template);
484
      bool rest = (at & 128) != 0;
485
      int mandatory = at & 127;
486
      ptrdiff_t nonrest = at >> 8;
487 488
      ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest;
      if (! (mandatory <= nargs && nargs <= maxargs))
489
	Fsignal (Qwrong_number_of_arguments,
490 491
		 list2 (Fcons (make_number (mandatory), make_number (nonrest)),
			make_number (nargs)));
492 493 494 495 496 497 498 499
      ptrdiff_t pushedargs = min (nonrest, nargs);
      for (ptrdiff_t i = 0; i < pushedargs; i++, args++)
	PUSH (*args);
      if (nonrest < nargs)
	PUSH (Flist (nargs - nonrest, args));
      else
	for (ptrdiff_t i = nargs - rest; i < nonrest; i++)
	  PUSH (Qnil);
500 501
    }

Jim Blandy's avatar
Jim Blandy committed
502 503 504
  while (1)
    {
#ifdef BYTE_CODE_SAFE
505
      if (top > stacke)
506
	emacs_abort ();
Gerd Moellmann's avatar
Gerd Moellmann committed
507
      else if (top < stack.bottom - 1)
508
	emacs_abort ();
Jim Blandy's avatar
Jim Blandy committed
509 510 511 512 513 514 515
#endif

#ifdef BYTE_CODE_METER
      prev_op = this_op;
      this_op = op = FETCH;
      METER_CODE (prev_op, op);
#else
Tom Tromey's avatar
Tom Tromey committed
516
#ifndef BYTE_CODE_THREADED
517
      op = FETCH;
Jim Blandy's avatar
Jim Blandy committed
518
#endif
Tom Tromey's avatar
Tom Tromey committed
519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560
#endif

      /* The interpreter can be compiled one of two ways: as an
	 ordinary switch-based interpreter, or as a threaded
	 interpreter.  The threaded interpreter relies on GCC's
	 computed goto extension, so it is not available everywhere.
	 Threading provides a performance boost.  These macros are how
	 we allow the code to be compiled both ways.  */
#ifdef BYTE_CODE_THREADED
      /* The CASE macro introduces an instruction's body.  It is
	 either a label or a case label.  */
#define CASE(OP) insn_ ## OP
      /* NEXT is invoked at the end of an instruction to go to the
	 next instruction.  It is either a computed goto, or a
	 plain break.  */
#define NEXT goto *(targets[op = FETCH])
      /* FIRST is like NEXT, but is only used at the start of the
	 interpreter body.  In the switch-based interpreter it is the
	 switch, so the threaded definition must include a semicolon.  */
#define FIRST NEXT;
      /* Most cases are labeled with the CASE macro, above.
	 CASE_DEFAULT is one exception; it is used if the interpreter
	 being built requires a default case.  The threaded
	 interpreter does not, because the dispatch table is
	 completely filled.  */
#define CASE_DEFAULT
      /* This introduces an instruction that is known to call abort.  */
#define CASE_ABORT CASE (Bstack_ref): CASE (default)
#else
      /* See above for the meaning of the various defines.  */
#define CASE(OP) case OP
#define NEXT break
#define FIRST switch (op)
#define CASE_DEFAULT case 255: default:
#define CASE_ABORT case 0
#endif

#ifdef BYTE_CODE_THREADED

      /* A convenience define that saves us a lot of typing and makes
	 the table clearer.  */
#define LABEL(OP) [OP] = &&insn_ ## OP
Jim Blandy's avatar
Jim Blandy committed
561

562
#if GNUC_PREREQ (4, 6, 0)
563 564
# pragma GCC diagnostic push
# pragma GCC diagnostic ignored "-Woverride-init"
565 566 567
#elif defined __clang__
# pragma GCC diagnostic push
# pragma GCC diagnostic ignored "-Winitializer-overrides"
568 569
#endif

Tom Tromey's avatar
Tom Tromey committed
570 571
      /* This is the dispatch table for the threaded interpreter.  */
      static const void *const targets[256] =
572
	{
Tom Tromey's avatar
Tom Tromey committed
573 574 575 576 577 578 579
	  [0 ... (Bconstant - 1)] = &&insn_default,
	  [Bconstant ... 255] = &&insn_Bconstant,

#define DEFINE(name, value) LABEL (name) ,
	  BYTE_CODES
#undef DEFINE
	};
580

581
#if GNUC_PREREQ (4, 6, 0) || defined __clang__
582 583 584
# pragma GCC diagnostic pop
#endif

Tom Tromey's avatar
Tom Tromey committed
585 586 587 588 589 590
#endif


      FIRST
	{
	CASE (Bvarref7):
Jim Blandy's avatar
Jim Blandy committed
591 592 593
	  op = FETCH2;
	  goto varref;

Tom Tromey's avatar
Tom Tromey committed
594 595 596 597 598 599
	CASE (Bvarref):
	CASE (Bvarref1):
	CASE (Bvarref2):
	CASE (Bvarref3):
	CASE (Bvarref4):
	CASE (Bvarref5):
Jim Blandy's avatar
Jim Blandy committed
600
	  op = op - Bvarref;
601 602 603 604
	  goto varref;

	/* This seems to be the most frequently executed byte-code
	   among the Bvarref's, so avoid a goto here.  */
Tom Tromey's avatar
Tom Tromey committed
605
	CASE (Bvarref6):
606
	  op = FETCH;
Jim Blandy's avatar
Jim Blandy committed
607
	varref:
608 609 610 611 612 613
	  {
	    Lisp_Object v1, v2;

	    v1 = vectorp[op];
	    if (SYMBOLP (v1))
	      {
614 615 616
		if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
		    || (v2 = SYMBOL_VAL (XSYMBOL (v1)),
			EQ (v2, Qunbound)))
617 618 619
		  {
		    v2 = Fsymbol_value (v1);
		  }
620 621
	      }
	    else
622 623 624
	      {
		v2 = Fsymbol_value (v1);
	      }
625
	    PUSH (v2);
Tom Tromey's avatar
Tom Tromey committed
626
	    NEXT;
627 628
	  }

Tom Tromey's avatar
Tom Tromey committed
629
	CASE (Bgotoifnil):
630 631
	  {
	    Lisp_Object v1;
Paul Eggert's avatar
Paul Eggert committed
632
	    maybe_gc ();
633 634 635 636 637 638 639 640
	    op = FETCH2;
	    v1 = POP;
	    if (NILP (v1))
	      {
		BYTE_CODE_QUIT;
		CHECK_RANGE (op);
		stack.pc = stack.byte_string_start + op;
	      }
Tom Tromey's avatar
Tom Tromey committed
641
	    NEXT;
642
	  }
Jim Blandy's avatar
Jim Blandy committed
643

Tom Tromey's avatar
Tom Tromey committed
644
	CASE (Bcar):
645 646 647
	  {
	    Lisp_Object v1;
	    v1 = TOP;
648 649 650 651 652 653 654 655
	    if (CONSP (v1))
	      TOP = XCAR (v1);
	    else if (NILP (v1))
	      TOP = Qnil;
	    else
	      {
		wrong_type_argument (Qlistp, v1);
	      }
Tom Tromey's avatar
Tom Tromey committed
656
	    NEXT;
657 658
	  }

Tom Tromey's avatar
Tom Tromey committed
659
	CASE (Beq):
660 661 662 663
	  {
	    Lisp_Object v1;
	    v1 = POP;
	    TOP = EQ (v1, TOP) ? Qt : Qnil;
Tom Tromey's avatar
Tom Tromey committed
664
	    NEXT;
665 666
	  }

Tom Tromey's avatar
Tom Tromey committed
667
	CASE (Bmemq):
668 669 670 671
	  {
	    Lisp_Object v1;
	    v1 = POP;
	    TOP = Fmemq (TOP, v1);
Tom Tromey's avatar
Tom Tromey committed
672
	    NEXT;
673 674
	  }

Tom Tromey's avatar
Tom Tromey committed
675
	CASE (Bcdr):
676 677 678
	  {
	    Lisp_Object v1;
	    v1 = TOP;
679 680 681 682 683 684 685 686
	    if (CONSP (v1))
	      TOP = XCDR (v1);
	    else if (NILP (v1))
	      TOP = Qnil;
	    else
	      {
		wrong_type_argument (Qlistp, v1);
	      }
Tom Tromey's avatar
Tom Tromey committed
687
	    NEXT;
688
	  }
Jim Blandy's avatar
Jim Blandy committed
689

Tom Tromey's avatar
Tom Tromey committed
690 691 692 693 694 695
	CASE (Bvarset):
	CASE (Bvarset1):
	CASE (Bvarset2):
	CASE (Bvarset3):
	CASE (Bvarset4):
	CASE (Bvarset5):
696
	  op -= Bvarset;
Jim Blandy's avatar
Jim Blandy committed
697 698
	  goto varset;

Tom Tromey's avatar
Tom Tromey committed
699
	CASE (Bvarset7):
700
	  op = FETCH2;
701 702
	  goto varset;

Tom Tromey's avatar
Tom Tromey committed
703
	CASE (Bvarset6):
704
	  op = FETCH;
Jim Blandy's avatar
Jim Blandy committed
705
	varset:
706 707
	  {
	    Lisp_Object sym, val;
708

709
	    sym = vectorp[op];
710
	    val = TOP;
711 712 713 714

	    /* Inline the most common case.  */
	    if (SYMBOLP (sym)
		&& !EQ (val, Qunbound)
715 716
		&& !XSYMBOL (sym)->redirect
		&& !SYMBOL_CONSTANT_P (sym))
717
	      SET_SYMBOL_VAL (XSYMBOL (sym), val);
718
	    else
719
	      {
720
		set_internal (sym, val, Qnil, 0);
721
	      }
722
	  }
723
	  (void) POP;
Tom Tromey's avatar
Tom Tromey committed
724
	  NEXT;
Jim Blandy's avatar
Jim Blandy committed
725

Tom Tromey's avatar
Tom Tromey committed
726
	CASE (Bdup):
727 728 729 730
	  {
	    Lisp_Object v1;
	    v1 = TOP;
	    PUSH (v1);
Tom Tromey's avatar
Tom Tromey committed
731
	    NEXT;
732 733 734 735
	  }

	/* ------------------ */

Tom Tromey's avatar
Tom Tromey committed
736
	CASE (Bvarbind6):
Jim Blandy's avatar
Jim Blandy committed
737 738 739
	  op = FETCH;
	  goto varbind;

Tom Tromey's avatar
Tom Tromey committed
740
	CASE (Bvarbind7):
Jim Blandy's avatar
Jim Blandy committed
741 742 743
	  op = FETCH2;
	  goto varbind;

Tom Tromey's avatar
Tom Tromey committed
744 745 746 747 748 749
	CASE (Bvarbind):
	CASE (Bvarbind1):
	CASE (Bvarbind2):
	CASE (Bvarbind3):
	CASE (Bvarbind4):
	CASE (Bvarbind5):
Jim Blandy's avatar
Jim Blandy committed
750 751
	  op -= Bvarbind;
	varbind:
752
	  /* Specbind can signal and thus GC.  */
Jim Blandy's avatar
Jim Blandy committed
753
	  specbind (vectorp[op], POP);
Tom Tromey's avatar
Tom Tromey committed
754
	  NEXT;
Jim Blandy's avatar
Jim Blandy committed
755

Tom Tromey's avatar
Tom Tromey committed
756
	CASE (Bcall6):
Jim Blandy's avatar
Jim Blandy committed
757 758 759
	  op = FETCH;
	  goto docall;

Tom Tromey's avatar
Tom Tromey committed
760
	CASE (Bcall7):
Jim Blandy's avatar
Jim Blandy committed
761 762 763
	  op = FETCH2;
	  goto docall;

Tom Tromey's avatar
Tom Tromey committed
764 765 766 767 768 769
	CASE (Bcall):
	CASE (Bcall1):
	CASE (Bcall2):
	CASE (Bcall3):
	CASE (Bcall4):
	CASE (Bcall5):
Jim Blandy's avatar
Jim Blandy committed
770 771
	  op -= Bcall;
	docall:
772 773
	  {
	    DISCARD (op);
774
#ifdef BYTE_CODE_METER
775 776 777 778 779 780 781
	    if (byte_metering_on && SYMBOLP (TOP))
	      {
		Lisp_Object v1, v2;

		v1 = TOP;
		v2 = Fget (v1, Qbyte_code_meter);
		if (INTEGERP (v2)
782
		    && XINT (v2) < MOST_POSITIVE_FIXNUM)
783 784 785 786 787
		  {
		    XSETINT (v2, XINT (v2) + 1);
		    Fput (v1, Qbyte_code_meter, v2);
		  }
	      }
788
#endif
789
	    TOP = Ffuncall (op + 1, &TOP);
Tom Tromey's avatar
Tom Tromey committed
790
	    NEXT;
791
	  }
Jim Blandy's avatar
Jim Blandy committed
792

Tom Tromey's avatar
Tom Tromey committed
793
	CASE (Bunbind6):
Jim Blandy's avatar
Jim Blandy committed
794 795 796
	  op = FETCH;
	  goto dounbind;

Tom Tromey's avatar
Tom Tromey committed
797
	CASE (Bunbind7):
Jim Blandy's avatar
Jim Blandy committed
798 799 800
	  op = FETCH2;
	  goto dounbind;

Tom Tromey's avatar
Tom Tromey committed
801 802 803 804 805 806
	CASE (Bunbind):
	CASE (Bunbind1):
	CASE (Bunbind2):
	CASE (Bunbind3):
	CASE (Bunbind4):
	CASE (Bunbind5):
Jim Blandy's avatar
Jim Blandy committed
807 808
	  op -= Bunbind;
	dounbind:
Juanma Barranquero's avatar
Juanma Barranquero committed
809
	  unbind_to (SPECPDL_INDEX () - op, Qnil);
Tom Tromey's avatar
Tom Tromey committed
810
	  NEXT;
Jim Blandy's avatar
Jim Blandy committed
811

Tom Tromey's avatar
Tom Tromey committed
812
	CASE (Bunbind_all):	/* Obsolete.  Never used.  */
Jim Blandy's avatar
Jim Blandy committed
813
	  /* To unbind back to the beginning of this frame.  Not used yet,
814
	     but will be needed for tail-recursion elimination.  */
Jim Blandy's avatar
Jim Blandy committed
815
	  unbind_to (count, Qnil);
Tom Tromey's avatar
Tom Tromey committed
816
	  NEXT;
Jim Blandy's avatar
Jim Blandy committed
817

Tom Tromey's avatar
Tom Tromey committed
818
	CASE (Bgoto):
Paul Eggert's avatar
Paul Eggert committed
819
	  maybe_gc ();
Gerd Moellmann's avatar
Gerd Moellmann committed
820
	  BYTE_CODE_QUIT;
Jim Blandy's avatar
Jim Blandy committed
821
	  op = FETCH2;    /* pc = FETCH2 loses since FETCH2 contains pc++ */
822
	  CHECK_RANGE (op);
Gerd Moellmann's avatar
Gerd Moellmann committed
823
	  stack.pc = stack.byte_string_start + op;
Tom Tromey's avatar
Tom Tromey committed
824
	  NEXT;
Jim Blandy's avatar
Jim Blandy committed
825

Tom Tromey's avatar
Tom Tromey committed
826
	CASE (Bgotoifnonnil):
827 828
	  {
	    Lisp_Object v1;
Paul Eggert's avatar
Paul Eggert committed
829
	    maybe_gc ();
830 831 832 833 834 835 836 837
	    op = FETCH2;
	    v1 = POP;
	    if (!NILP (v1))
	      {
		BYTE_CODE_QUIT;
		CHECK_RANGE (op);
		stack.pc = stack.byte_string_start + op;
	      }
Tom Tromey's avatar
Tom Tromey committed
838
	    NEXT;
839
	  }
Jim Blandy's avatar
Jim Blandy committed
840

Tom Tromey's avatar
Tom Tromey committed
841
	CASE (Bgotoifnilelsepop):
Paul Eggert's avatar
Paul Eggert committed
842
	  maybe_gc ();
Jim Blandy's avatar
Jim Blandy committed
843
	  op = FETCH2;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
844
	  if (NILP (TOP))
Jim Blandy's avatar
Jim Blandy committed
845
	    {
Gerd Moellmann's avatar
Gerd Moellmann committed
846
	      BYTE_CODE_QUIT;
847
	      CHECK_RANGE (op);
Gerd Moellmann's avatar
Gerd Moellmann committed
848
	      stack.pc = stack.byte_string_start + op;
Jim Blandy's avatar
Jim Blandy committed
849
	    }
850
	  else DISCARD (1);
Tom Tromey's avatar
Tom Tromey committed
851
	  NEXT;
Jim Blandy's avatar
Jim Blandy committed
852

Tom Tromey's avatar
Tom Tromey committed
853
	CASE (Bgotoifnonnilelsepop):
Paul Eggert's avatar
Paul Eggert committed
854
	  maybe_gc ();
Jim Blandy's avatar
Jim Blandy committed
855
	  op = FETCH2;
Joseph Arceneaux's avatar
Joseph Arceneaux committed
856
	  if (!NILP (TOP))
Jim Blandy's avatar
Jim Blandy committed
857
	    {
Gerd Moellmann's avatar
Gerd Moellmann committed
858
	      BYTE_CODE_QUIT;
859
	      CHECK_RANGE (op);
Gerd Moellmann's avatar
Gerd Moellmann committed
860
	      stack.pc = stack.byte_string_start + op;
Jim Blandy's avatar
Jim Blandy committed
861
	    }
862
	  else DISCARD (1);
Tom Tromey's avatar
Tom Tromey committed
863
	  NEXT;
864

Tom Tromey's avatar
Tom Tromey committed
865
	CASE (BRgoto):
Paul Eggert's avatar
Paul Eggert committed
866
	  maybe_gc ();
Gerd Moellmann's avatar
Gerd Moellmann committed
867
	  BYTE_CODE_QUIT;
Gerd Moellmann's avatar
Gerd Moellmann committed
868
	  stack.pc += (int) *stack.pc - 127;
Tom Tromey's avatar
Tom Tromey committed
869
	  NEXT;
870

Tom Tromey's avatar
Tom Tromey committed
871
	CASE (BRgotoifnil):
872 873
	  {
	    Lisp_Object v1;
Paul Eggert's avatar
Paul Eggert committed
874
	    maybe_gc ();
875 876 877 878 879 880 881
	    v1 = POP;
	    if (NILP (v1))
	      {
		BYTE_CODE_QUIT;
		stack.pc += (int) *stack.pc - 128;
	      }
	    stack.pc++;
Tom Tromey's avatar
Tom Tromey committed
882
	    NEXT;
883
	  }
884

Tom Tromey's avatar
Tom Tromey committed
885
	CASE (BRgotoifnonnil):
886 887
	  {
	    Lisp_Object v1;
Paul Eggert's avatar
Paul Eggert committed
888
	    maybe_gc ();
889 890 891 892 893 894 895
	    v1 = POP;
	    if (!NILP (v1))
	      {
		BYTE_CODE_QUIT;
		stack.pc += (int) *stack.pc - 128;
	      }
	    stack.pc++;
Tom Tromey's avatar
Tom Tromey committed
896
	    NEXT;
897
	  }
898

Tom Tromey's avatar
Tom Tromey committed
899
	CASE (BRgotoifnilelsepop):
Paul Eggert's avatar
Paul Eggert committed
900
	  maybe_gc ();
Gerd Moellmann's avatar
Gerd Moellmann committed
901
	  op = *stack.pc++;
902 903
	  if (NILP (TOP))
	    {
Gerd Moellmann's avatar
Gerd Moellmann committed
904
	      BYTE_CODE_QUIT;
Gerd Moellmann's avatar
Gerd Moellmann committed
905
	      stack.pc += op - 128;
906 907
	    }
	  else DISCARD (1);
Tom Tromey's avatar
Tom Tromey committed
908
	  NEXT;
909

Tom Tromey's avatar
Tom Tromey committed
910
	CASE (BRgotoifnonnilelsepop):
Paul Eggert's avatar
Paul Eggert committed
911
	  maybe_gc ();
Gerd Moellmann's avatar
Gerd Moellmann committed
912
	  op = *stack.pc++;
913 914
	  if (!NILP (TOP))
	    {
Gerd Moellmann's avatar
Gerd Moellmann committed
915
	      BYTE_CODE_QUIT;
Gerd Moellmann's avatar
Gerd Moellmann committed
916
	      stack.pc += op - 128;
917 918
	    }
	  else DISCARD (1);
Tom Tromey's avatar
Tom Tromey committed
919
	  NEXT;
Jim Blandy's avatar
Jim Blandy committed
920

Tom Tromey's avatar
Tom Tromey committed
921
	CASE (Breturn):
922
	  result = POP;
Jim Blandy's avatar
Jim Blandy committed
923 924
	  goto exit;

Tom Tromey's avatar
Tom Tromey committed
925
	CASE (Bdiscard):
926
	  DISCARD (1);
Tom Tromey's avatar
Tom Tromey committed
927
	  NEXT;
Jim Blandy's avatar
Jim Blandy committed
928

Tom Tromey's avatar
Tom Tromey committed
929
	CASE (Bconstant2):
Jim Blandy's avatar
Jim Blandy committed
930
	  PUSH (vectorp[FETCH2]);
Tom Tromey's avatar
Tom Tromey committed
931
	  NEXT;
Jim Blandy's avatar
Jim Blandy committed
932

Tom Tromey's avatar
Tom Tromey committed
933
	CASE (Bsave_excursion):
934 935
	  record_unwind_protect (save_excursion_restore,
				 save_excursion_save ());
Tom Tromey's avatar
Tom Tromey committed
936
	  NEXT;
Jim Blandy's avatar
Jim Blandy committed
937

Tom Tromey's avatar
Tom Tromey committed
938 939
	CASE (Bsave_current_buffer): /* Obsolete since ??.  */
	CASE (Bsave_current_buffer_1):
940
	  record_unwind_current_buffer ();
Tom Tromey's avatar
Tom Tromey committed
941
	  NEXT;
942

Tom Tromey's avatar
Tom Tromey committed
943
	CASE (Bsave_window_excursion): /* Obsolete since 24.1.  */
944
	  {
945 946
	    ptrdiff_t count1 = SPECPDL_INDEX ();
	    record_unwind_protect (restore_window_configuration,
947 948
				   Fcurrent_window_configuration (Qnil));
	    TOP = Fprogn (TOP);
949
	    unbind_to (count1, TOP);
Tom Tromey's avatar
Tom Tromey committed
950
	    NEXT;
951
	  }
Jim Blandy's avatar
Jim Blandy committed
952

Tom Tromey's avatar
Tom Tromey committed
953
	CASE (Bsave_restriction):
954 955
	  record_unwind_protect (save_restriction_restore,
				 save_restriction_save ());
Tom Tromey's avatar
Tom Tromey committed
956
	  NEXT;
Jim Blandy's avatar
Jim Blandy committed
957

958
	CASE (Bcatch):		/* Obsolete since 24.4.  */
959 960
	  {
	    Lisp_Object v1;
961
	    v1 = POP;
962
	    TOP = internal_catch (TOP, eval_sub, v1);
Tom Tromey's avatar
Tom Tromey committed
963
	    NEXT;
964
	  }
Jim Blandy's avatar
Jim Blandy committed
965

966 967 968 969
	CASE (Bpushcatch):	/* New in 24.4.  */
	  type = CATCHER;
	  goto pushhandler;
	CASE (Bpushconditioncase): /* New in 24.4.  */
970 971
	  type = CONDITION_CASE;
	pushhandler:
972
	  {
973 974
	    Lisp_Object tag = POP;
	    int dest = FETCH2;
975

976
	    struct handler *c = push_handler (tag, type);
977 978
	    c->bytecode_dest = dest;
	    c->bytecode_top = top;
979

980 981 982
	    if (sys_setjmp (c->jmp))
	      {
		struct handler *c = handlerlist;
983
		int dest;
984
		top = c->bytecode_top;
985
		dest = c->bytecode_dest;
986 987 988
		handlerlist = c->next;
		PUSH (c->val);
		CHECK_RANGE (dest);
989 990
		/* Might have been re-set by longjmp!  */
		stack.byte_string_start = SDATA (stack.byte_string);
991 992
		stack.pc = stack.byte_string_start + dest;
	      }
993

Stefan Monnier's avatar