src/bytecode.c

   1 /* Execution of byte code produced by bytecomp.el.
   2    Copyright (C) 1985-1988, 1993, 2000-2016 Free Software Foundation,
   3    Inc.
   4
   5 This file is part of GNU Emacs.
   6
   7 GNU Emacs is free software: you can redistribute it and/or modify
   8 it under the terms of the GNU General Public License as published by
   9 the Free Software Foundation, either version 3 of the License, or (at
  10 your option) any later version.
  11
  12 GNU Emacs is distributed in the hope that it will be useful,
  13 but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 GNU General Public License for more details.
  16
  17 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/>.  */
  19
  20 #include <config.h>
  21
  22 #include "lisp.h"
  23 #include "blockinput.h"
  24 #include "character.h"
  25 #include "buffer.h"
  26 #include "keyboard.h"
  27 #include "syntax.h"
  28 #include "window.h"
  29
  30 /* Work around GCC bug 54561.  */
  31 #if GNUC_PREREQ (4, 3, 0)
  32 # pragma GCC diagnostic ignored "-Wclobbered"
  33 #endif
  34
  35 /* Define BYTE_CODE_SAFE true to enable some minor sanity checking,
  36    useful for debugging the byte compiler.  It defaults to false.  */
  37
  38 #ifndef BYTE_CODE_SAFE
  39 # define BYTE_CODE_SAFE false
  40 #endif
  41
  42 /* Define BYTE_CODE_METER to generate a byte-op usage histogram.  */
  43 /* #define BYTE_CODE_METER */
  44
  45 /* If BYTE_CODE_THREADED is defined, then the interpreter will be
  46    indirect threaded, using GCC's computed goto extension.  This code,
  47    as currently implemented, is incompatible with BYTE_CODE_SAFE and
  48    BYTE_CODE_METER.  */
  49 #if (defined __GNUC__ && !defined __STRICT_ANSI__ \
  50      && !BYTE_CODE_SAFE && !defined BYTE_CODE_METER)
  51 #define BYTE_CODE_THREADED
  52 #endif
  53
  54 \f
  55 #ifdef BYTE_CODE_METER
  56
  57 #define METER_2(code1, code2) \
  58   (*aref_addr (AREF (Vbyte_code_meter, code1), code2))
  59 #define METER_1(code) METER_2 (0, code)
  60
  61 #define METER_CODE(last_code, this_code)                                \
  62 {                                                                       \
  63   if (byte_metering_on)                                                 \
  64     {                                                                   \
  65       if (XFASTINT (METER_1 (this_code)) < MOST_POSITIVE_FIXNUM)        \
  66         XSETFASTINT (METER_1 (this_code),                               \
  67                      XFASTINT (METER_1 (this_code)) + 1);               \
  68       if (last_code                                                     \
  69           && (XFASTINT (METER_2 (last_code, this_code))                 \
  70               < MOST_POSITIVE_FIXNUM))                                  \
  71         XSETFASTINT (METER_2 (last_code, this_code),                    \
  72                      XFASTINT (METER_2 (last_code, this_code)) + 1);    \
  73     }                                                                   \
  74 }
  75
  76 #endif /* BYTE_CODE_METER */
  77 \f
  78
  79 /*  Byte codes: */
  80
  81 #define BYTE_CODES                                                      \
  82 DEFINE (Bstack_ref, 0) /* Actually, Bstack_ref+0 is not implemented: use dup.  */ \
  83 DEFINE (Bstack_ref1, 1)                                                 \
  84 DEFINE (Bstack_ref2, 2)                                                 \
  85 DEFINE (Bstack_ref3, 3)                                                 \
  86 DEFINE (Bstack_ref4, 4)                                                 \
  87 DEFINE (Bstack_ref5, 5)                                                 \
  88 DEFINE (Bstack_ref6, 6)                                                 \
  89 DEFINE (Bstack_ref7, 7)                                                 \
  90 DEFINE (Bvarref, 010)                                                   \
  91 DEFINE (Bvarref1, 011)                                                  \
  92 DEFINE (Bvarref2, 012)                                                  \
  93 DEFINE (Bvarref3, 013)                                                  \
  94 DEFINE (Bvarref4, 014)                                                  \
  95 DEFINE (Bvarref5, 015)                                                  \
  96 DEFINE (Bvarref6, 016)                                                  \
  97 DEFINE (Bvarref7, 017)                                                  \
  98 DEFINE (Bvarset, 020)                                                   \
  99 DEFINE (Bvarset1, 021)                                                  \
 100 DEFINE (Bvarset2, 022)                                                  \
 101 DEFINE (Bvarset3, 023)                                                  \
 102 DEFINE (Bvarset4, 024)                                                  \
 103 DEFINE (Bvarset5, 025)                                                  \
 104 DEFINE (Bvarset6, 026)                                                  \
 105 DEFINE (Bvarset7, 027)                                                  \
 106 DEFINE (Bvarbind, 030)                                                  \
 107 DEFINE (Bvarbind1, 031)                                                 \
 108 DEFINE (Bvarbind2, 032)                                                 \
 109 DEFINE (Bvarbind3, 033)                                                 \
 110 DEFINE (Bvarbind4, 034)                                                 \
 111 DEFINE (Bvarbind5, 035)                                                 \
 112 DEFINE (Bvarbind6, 036)                                                 \
 113 DEFINE (Bvarbind7, 037)                                                 \
 114 DEFINE (Bcall, 040)                                                     \
 115 DEFINE (Bcall1, 041)                                                    \
 116 DEFINE (Bcall2, 042)                                                    \
 117 DEFINE (Bcall3, 043)                                                    \
 118 DEFINE (Bcall4, 044)                                                    \
 119 DEFINE (Bcall5, 045)                                                    \
 120 DEFINE (Bcall6, 046)                                                    \
 121 DEFINE (Bcall7, 047)                                                    \
 122 DEFINE (Bunbind, 050)                                                   \
 123 DEFINE (Bunbind1, 051)                                                  \
 124 DEFINE (Bunbind2, 052)                                                  \
 125 DEFINE (Bunbind3, 053)                                                  \
 126 DEFINE (Bunbind4, 054)                                                  \
 127 DEFINE (Bunbind5, 055)                                                  \
 128 DEFINE (Bunbind6, 056)                                                  \
 129 DEFINE (Bunbind7, 057)                                                  \
 130                                                                         \
 131 DEFINE (Bpophandler, 060)                                               \
 132 DEFINE (Bpushconditioncase, 061)                                        \
 133 DEFINE (Bpushcatch, 062)                                                \
 134                                                                         \
 135 DEFINE (Bnth, 070)                                                      \
 136 DEFINE (Bsymbolp, 071)                                                  \
 137 DEFINE (Bconsp, 072)                                                    \
 138 DEFINE (Bstringp, 073)                                                  \
 139 DEFINE (Blistp, 074)                                                    \
 140 DEFINE (Beq, 075)                                                       \
 141 DEFINE (Bmemq, 076)                                                     \
 142 DEFINE (Bnot, 077)                                                      \
 143 DEFINE (Bcar, 0100)                                                     \
 144 DEFINE (Bcdr, 0101)                                                     \
 145 DEFINE (Bcons, 0102)                                                    \
 146 DEFINE (Blist1, 0103)                                                   \
 147 DEFINE (Blist2, 0104)                                                   \
 148 DEFINE (Blist3, 0105)                                                   \
 149 DEFINE (Blist4, 0106)                                                   \
 150 DEFINE (Blength, 0107)                                                  \
 151 DEFINE (Baref, 0110)                                                    \
 152 DEFINE (Baset, 0111)                                                    \
 153 DEFINE (Bsymbol_value, 0112)                                            \
 154 DEFINE (Bsymbol_function, 0113)                                         \
 155 DEFINE (Bset, 0114)                                                     \
 156 DEFINE (Bfset, 0115)                                                    \
 157 DEFINE (Bget, 0116)                                                     \
 158 DEFINE (Bsubstring, 0117)                                               \
 159 DEFINE (Bconcat2, 0120)                                                 \
 160 DEFINE (Bconcat3, 0121)                                                 \
 161 DEFINE (Bconcat4, 0122)                                                 \
 162 DEFINE (Bsub1, 0123)                                                    \
 163 DEFINE (Badd1, 0124)                                                    \
 164 DEFINE (Beqlsign, 0125)                                                 \
 165 DEFINE (Bgtr, 0126)                                                     \
 166 DEFINE (Blss, 0127)                                                     \
 167 DEFINE (Bleq, 0130)                                                     \
 168 DEFINE (Bgeq, 0131)                                                     \
 169 DEFINE (Bdiff, 0132)                                                    \
 170 DEFINE (Bnegate, 0133)                                                  \
 171 DEFINE (Bplus, 0134)                                                    \
 172 DEFINE (Bmax, 0135)                                                     \
 173 DEFINE (Bmin, 0136)                                                     \
 174 DEFINE (Bmult, 0137)                                                    \
 175                                                                         \
 176 DEFINE (Bpoint, 0140)                                                   \
 177 /* Was Bmark in v17.  */                                                \
 178 DEFINE (Bsave_current_buffer, 0141) /* Obsolete.  */                    \
 179 DEFINE (Bgoto_char, 0142)                                               \
 180 DEFINE (Binsert, 0143)                                                  \
 181 DEFINE (Bpoint_max, 0144)                                               \
 182 DEFINE (Bpoint_min, 0145)                                               \
 183 DEFINE (Bchar_after, 0146)                                              \
 184 DEFINE (Bfollowing_char, 0147)                                          \
 185 DEFINE (Bpreceding_char, 0150)                                          \
 186 DEFINE (Bcurrent_column, 0151)                                          \
 187 DEFINE (Bindent_to, 0152)                                               \
 188 DEFINE (Beolp, 0154)                                                    \
 189 DEFINE (Beobp, 0155)                                                    \
 190 DEFINE (Bbolp, 0156)                                                    \
 191 DEFINE (Bbobp, 0157)                                                    \
 192 DEFINE (Bcurrent_buffer, 0160)                                          \
 193 DEFINE (Bset_buffer, 0161)                                              \
 194 DEFINE (Bsave_current_buffer_1, 0162) /* Replacing Bsave_current_buffer.  */ \
 195 DEFINE (Binteractive_p, 0164) /* Obsolete since Emacs-24.1.  */         \
 196                                                                         \
 197 DEFINE (Bforward_char, 0165)                                            \
 198 DEFINE (Bforward_word, 0166)                                            \
 199 DEFINE (Bskip_chars_forward, 0167)                                      \
 200 DEFINE (Bskip_chars_backward, 0170)                                     \
 201 DEFINE (Bforward_line, 0171)                                            \
 202 DEFINE (Bchar_syntax, 0172)                                             \
 203 DEFINE (Bbuffer_substring, 0173)                                        \
 204 DEFINE (Bdelete_region, 0174)                                           \
 205 DEFINE (Bnarrow_to_region, 0175)                                        \
 206 DEFINE (Bwiden, 0176)                                                   \
 207 DEFINE (Bend_of_line, 0177)                                             \
 208                                                                         \
 209 DEFINE (Bconstant2, 0201)                                               \
 210 DEFINE (Bgoto, 0202)                                                    \
 211 DEFINE (Bgotoifnil, 0203)                                               \
 212 DEFINE (Bgotoifnonnil, 0204)                                            \
 213 DEFINE (Bgotoifnilelsepop, 0205)                                        \
 214 DEFINE (Bgotoifnonnilelsepop, 0206)                                     \
 215 DEFINE (Breturn, 0207)                                                  \
 216 DEFINE (Bdiscard, 0210)                                                 \
 217 DEFINE (Bdup, 0211)                                                     \
 218                                                                         \
 219 DEFINE (Bsave_excursion, 0212)                                          \
 220 DEFINE (Bsave_window_excursion, 0213) /* Obsolete since Emacs-24.1.  */ \
 221 DEFINE (Bsave_restriction, 0214)                                        \
 222 DEFINE (Bcatch, 0215)                                                   \
 223                                                                         \
 224 DEFINE (Bunwind_protect, 0216)                                          \
 225 DEFINE (Bcondition_case, 0217)                                          \
 226 DEFINE (Btemp_output_buffer_setup, 0220) /* Obsolete since Emacs-24.1.  */ \
 227 DEFINE (Btemp_output_buffer_show, 0221)  /* Obsolete since Emacs-24.1.  */ \
 228                                                                         \
 229 DEFINE (Bunbind_all, 0222)      /* Obsolete.  Never used.  */           \
 230                                                                         \
 231 DEFINE (Bset_marker, 0223)                                              \
 232 DEFINE (Bmatch_beginning, 0224)                                         \
 233 DEFINE (Bmatch_end, 0225)                                               \
 234 DEFINE (Bupcase, 0226)                                                  \
 235 DEFINE (Bdowncase, 0227)                                                \
 236                                                                         \
 237 DEFINE (Bstringeqlsign, 0230)                                           \
 238 DEFINE (Bstringlss, 0231)                                               \
 239 DEFINE (Bequal, 0232)                                                   \
 240 DEFINE (Bnthcdr, 0233)                                                  \
 241 DEFINE (Belt, 0234)                                                     \
 242 DEFINE (Bmember, 0235)                                                  \
 243 DEFINE (Bassq, 0236)                                                    \
 244 DEFINE (Bnreverse, 0237)                                                \
 245 DEFINE (Bsetcar, 0240)                                                  \
 246 DEFINE (Bsetcdr, 0241)                                                  \
 247 DEFINE (Bcar_safe, 0242)                                                \
 248 DEFINE (Bcdr_safe, 0243)                                                \
 249 DEFINE (Bnconc, 0244)                                                   \
 250 DEFINE (Bquo, 0245)                                                     \
 251 DEFINE (Brem, 0246)                                                     \
 252 DEFINE (Bnumberp, 0247)                                                 \
 253 DEFINE (Bintegerp, 0250)                                                \
 254                                                                         \
 255 DEFINE (BRgoto, 0252)                                                   \
 256 DEFINE (BRgotoifnil, 0253)                                              \
 257 DEFINE (BRgotoifnonnil, 0254)                                           \
 258 DEFINE (BRgotoifnilelsepop, 0255)                                       \
 259 DEFINE (BRgotoifnonnilelsepop, 0256)                                    \
 260                                                                         \
 261 DEFINE (BlistN, 0257)                                                   \
 262 DEFINE (BconcatN, 0260)                                                 \
 263 DEFINE (BinsertN, 0261)                                                 \
 264                                                                         \
 265 /* Bstack_ref is code 0.  */                                            \
 266 DEFINE (Bstack_set,  0262)                                              \
 267 DEFINE (Bstack_set2, 0263)                                              \
 268 DEFINE (BdiscardN,   0266)                                              \
 269                                                                         \
 270 DEFINE (Bconstant, 0300)
 271
 272 enum byte_code_op
 273 {
 274 #define DEFINE(name, value) name = value,
 275     BYTE_CODES
 276 #undef DEFINE
 277
 278 #if BYTE_CODE_SAFE
 279     Bscan_buffer = 0153, /* No longer generated as of v18.  */
 280     Bset_mark = 0163, /* this loser is no longer generated as of v18 */
 281 #endif
 282 };
 283 \f
 284 /* Structure describing a value stack used during byte-code execution
 285    in Fbyte_code.  */
 286
 287 struct byte_stack
 288 {
 289   /* Program counter.  This points into the byte_string below
 290      and is relocated when that string is relocated.  */
 291   const unsigned char *pc;
 292
 293   /* The string containing the byte-code, and its current address.
 294      Storing this here protects it from GC.  */
 295   Lisp_Object byte_string;
 296   const unsigned char *byte_string_start;
 297
 298   /* Next entry in byte_stack_list.  */
 299   struct byte_stack *next;
 300 };
 301
 302 /* A list of currently active byte-code execution value stacks.
 303    Fbyte_code adds an entry to the head of this list before it starts
 304    processing byte-code, and it removes the entry again when it is
 305    done.  Signaling an error truncates the list.  */
 306
 307 struct byte_stack *byte_stack_list;
 308
 309 \f
 310 /* Relocate program counters in the stacks on byte_stack_list.  Called
 311    when GC has completed.  */
 312
 313 void
 314 relocate_byte_stack (void)
 315 {
 316   struct byte_stack *stack;
 317
 318   for (stack = byte_stack_list; stack; stack = stack->next)
 319     {
 320       if (stack->byte_string_start != SDATA (stack->byte_string))
 321         {
 322           ptrdiff_t offset = stack->pc - stack->byte_string_start;
 323           stack->byte_string_start = SDATA (stack->byte_string);
 324           stack->pc = stack->byte_string_start + offset;
 325         }
 326     }
 327 }
 328
 329 \f
 330 /* Fetch the next byte from the bytecode stream.  */
 331
 332 #if BYTE_CODE_SAFE
 333 #define FETCH (eassert (stack.byte_string_start == SDATA (stack.byte_string)), *stack.pc++)
 334 #else
 335 #define FETCH *stack.pc++
 336 #endif
 337
 338 /* Fetch two bytes from the bytecode stream and make a 16-bit number
 339    out of them.  */
 340
 341 #define FETCH2 (op = FETCH, op + (FETCH << 8))
 342
 343 /* Push X onto the execution stack.  The expression X should not
 344    contain TOP, to avoid competing side effects.  */
 345
 346 #define PUSH(x) (*++top = (x))
 347
 348 /* Pop a value off the execution stack.  */
 349
 350 #define POP (*top--)
 351
 352 /* Discard n values from the execution stack.  */
 353
 354 #define DISCARD(n) (top -= (n))
 355
 356 /* Get the value which is at the top of the execution stack, but don't
 357    pop it.  */
 358
 359 #define TOP (*top)
 360
 361 /* Check for jumping out of range.  */
 362
 363 #define CHECK_RANGE(ARG) \
 364   (BYTE_CODE_SAFE && bytestr_length <= (ARG) ? emacs_abort () : (void) 0)
 365
 366 /* A version of the QUIT macro which makes sure that the stack top is
 367    set before signaling `quit'.  */
 368
 369 #define BYTE_CODE_QUIT                                  \
 370   do {                                                  \
 371     if (quitcounter++)                                  \
 372       break;                                            \
 373     maybe_gc ();                                        \
 374     if (!NILP (Vquit_flag) && NILP (Vinhibit_quit))     \
 375       {                                                 \
 376         Lisp_Object flag = Vquit_flag;                  \
 377         Vquit_flag = Qnil;                              \
 378         if (EQ (Vthrow_on_input, flag))                 \
 379           Fthrow (Vthrow_on_input, Qt);                 \
 380         quit ();                                        \
 381       }                                                 \
 382     else if (pending_signals)                           \
 383       process_pending_signals ();                       \
 384   } while (0)
 385
 386
 387 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
 388        doc: /* Function used internally in byte-compiled code.
 389 The first argument, BYTESTR, is a string of byte code;
 390 the second, VECTOR, a vector of constants;
 391 the third, MAXDEPTH, the maximum stack depth used in this function.
 392 If the third argument is incorrect, Emacs may crash.  */)
 393   (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
 394 {
 395   return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
 396 }
 397
 398 static void
 399 bcall0 (Lisp_Object f)
 400 {
 401   Ffuncall (1, &f);
 402 }
 403
 404 /* Execute the byte-code in BYTESTR.  VECTOR is the constant vector, and
 405    MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect,
 406    emacs may crash!).  If ARGS_TEMPLATE is non-nil, it should be a lisp
 407    argument list (including &rest, &optional, etc.), and ARGS, of size
 408    NARGS, should be a vector of the actual arguments.  The arguments in
 409    ARGS are pushed on the stack according to ARGS_TEMPLATE before
 410    executing BYTESTR.  */
 411
 412 Lisp_Object
 413 exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 414                 Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
 415 {
 416   ptrdiff_t count = SPECPDL_INDEX ();
 417 #ifdef BYTE_CODE_METER
 418   int volatile this_op = 0;
 419   int prev_op;
 420 #endif
 421   int op;
 422   /* Lisp_Object v1, v2; */
 423   Lisp_Object *vectorp;
 424   ptrdiff_t const_length;
 425   ptrdiff_t bytestr_length;
 426   struct byte_stack stack;
 427   Lisp_Object *top;
 428   Lisp_Object result;
 429   enum handlertype type;
 430
 431   CHECK_STRING (bytestr);
 432   CHECK_VECTOR (vector);
 433   CHECK_NATNUM (maxdepth);
 434
 435   const_length = ASIZE (vector);
 436
 437   if (STRING_MULTIBYTE (bytestr))
 438     /* BYTESTR must have been produced by Emacs 20.2 or the earlier
 439        because they produced a raw 8-bit string for byte-code and now
 440        such a byte-code string is loaded as multibyte while raw 8-bit
 441        characters converted to multibyte form.  Thus, now we must
 442        convert them back to the originally intended unibyte form.  */
 443     bytestr = Fstring_as_unibyte (bytestr);
 444
 445   bytestr_length = SBYTES (bytestr);
 446   vectorp = XVECTOR (vector)->contents;
 447
 448   stack.byte_string = bytestr;
 449   stack.pc = stack.byte_string_start = SDATA (bytestr);
 450   if (MAX_ALLOCA / word_size <= XFASTINT (maxdepth))
 451     memory_full (SIZE_MAX);
 452   unsigned char quitcounter = 0;
 453   int stack_items = XFASTINT (maxdepth) + 1;
 454   Lisp_Object *stack_base = alloca (stack_items * sizeof *top);
 455   Lisp_Object *stack_lim = stack_base + stack_items;
 456   top = stack_base;
 457   stack.next = byte_stack_list;
 458   byte_stack_list = &stack;
 459
 460   if (!NILP (args_template))
 461     {
 462       eassert (INTEGERP (args_template));
 463       ptrdiff_t at = XINT (args_template);
 464       bool rest = (at & 128) != 0;
 465       int mandatory = at & 127;
 466       ptrdiff_t nonrest = at >> 8;
 467       ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest;
 468       if (! (mandatory <= nargs && nargs <= maxargs))
 469         Fsignal (Qwrong_number_of_arguments,
 470                  list2 (Fcons (make_number (mandatory), make_number (nonrest)),
 471                         make_number (nargs)));
 472       ptrdiff_t pushedargs = min (nonrest, nargs);
 473       for (ptrdiff_t i = 0; i < pushedargs; i++, args++)
 474         PUSH (*args);
 475       if (nonrest < nargs)
 476         PUSH (Flist (nargs - nonrest, args));
 477       else
 478         for (ptrdiff_t i = nargs - rest; i < nonrest; i++)
 479           PUSH (Qnil);
 480     }
 481
 482   while (1)
 483     {
 484       if (BYTE_CODE_SAFE && ! (stack_base <= top && top < stack_lim))
 485         emacs_abort ();
 486
 487 #ifdef BYTE_CODE_METER
 488       prev_op = this_op;
 489       this_op = op = FETCH;
 490       METER_CODE (prev_op, op);
 491 #else
 492 #ifndef BYTE_CODE_THREADED
 493       op = FETCH;
 494 #endif
 495 #endif
 496
 497       /* The interpreter can be compiled one of two ways: as an
 498          ordinary switch-based interpreter, or as a threaded
 499          interpreter.  The threaded interpreter relies on GCC's
 500          computed goto extension, so it is not available everywhere.
 501          Threading provides a performance boost.  These macros are how
 502          we allow the code to be compiled both ways.  */
 503 #ifdef BYTE_CODE_THREADED
 504       /* The CASE macro introduces an instruction's body.  It is
 505          either a label or a case label.  */
 506 #define CASE(OP) insn_ ## OP
 507       /* NEXT is invoked at the end of an instruction to go to the
 508          next instruction.  It is either a computed goto, or a
 509          plain break.  */
 510 #define NEXT goto *(targets[op = FETCH])
 511       /* FIRST is like NEXT, but is only used at the start of the
 512          interpreter body.  In the switch-based interpreter it is the
 513          switch, so the threaded definition must include a semicolon.  */
 514 #define FIRST NEXT;
 515       /* Most cases are labeled with the CASE macro, above.
 516          CASE_DEFAULT is one exception; it is used if the interpreter
 517          being built requires a default case.  The threaded
 518          interpreter does not, because the dispatch table is
 519          completely filled.  */
 520 #define CASE_DEFAULT
 521       /* This introduces an instruction that is known to call abort.  */
 522 #define CASE_ABORT CASE (Bstack_ref): CASE (default)
 523 #else
 524       /* See above for the meaning of the various defines.  */
 525 #define CASE(OP) case OP
 526 #define NEXT break
 527 #define FIRST switch (op)
 528 #define CASE_DEFAULT case 255: default:
 529 #define CASE_ABORT case 0
 530 #endif
 531
 532 #ifdef BYTE_CODE_THREADED
 533
 534       /* A convenience define that saves us a lot of typing and makes
 535          the table clearer.  */
 536 #define LABEL(OP) [OP] = &&insn_ ## OP
 537
 538 #if GNUC_PREREQ (4, 6, 0)
 539 # pragma GCC diagnostic push
 540 # pragma GCC diagnostic ignored "-Woverride-init"
 541 #elif defined __clang__
 542 # pragma GCC diagnostic push
 543 # pragma GCC diagnostic ignored "-Winitializer-overrides"
 544 #endif
 545
 546       /* This is the dispatch table for the threaded interpreter.  */
 547       static const void *const targets[256] =
 548         {
 549           [0 ... (Bconstant - 1)] = &&insn_default,
 550           [Bconstant ... 255] = &&insn_Bconstant,
 551
 552 #define DEFINE(name, value) LABEL (name) ,
 553           BYTE_CODES
 554 #undef DEFINE
 555         };
 556
 557 #if GNUC_PREREQ (4, 6, 0) || defined __clang__
 558 # pragma GCC diagnostic pop
 559 #endif
 560
 561 #endif
 562
 563
 564       FIRST
 565         {
 566         CASE (Bvarref7):
 567           op = FETCH2;
 568           goto varref;
 569
 570         CASE (Bvarref):
 571         CASE (Bvarref1):
 572         CASE (Bvarref2):
 573         CASE (Bvarref3):
 574         CASE (Bvarref4):
 575         CASE (Bvarref5):
 576           op = op - Bvarref;
 577           goto varref;
 578
 579         /* This seems to be the most frequently executed byte-code
 580            among the Bvarref's, so avoid a goto here.  */
 581         CASE (Bvarref6):
 582           op = FETCH;
 583         varref:
 584           {
 585             Lisp_Object v1, v2;
 586
 587             v1 = vectorp[op];
 588             if (SYMBOLP (v1))
 589               {
 590                 if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
 591                     || (v2 = SYMBOL_VAL (XSYMBOL (v1)),
 592                         EQ (v2, Qunbound)))
 593                   {
 594                     v2 = Fsymbol_value (v1);
 595                   }
 596               }
 597             else
 598               {
 599                 v2 = Fsymbol_value (v1);
 600               }
 601             PUSH (v2);
 602             NEXT;
 603           }
 604
 605         CASE (Bgotoifnil):
 606           {
 607             Lisp_Object v1;
 608             op = FETCH2;
 609             v1 = POP;
 610             if (NILP (v1))
 611               {
 612                 BYTE_CODE_QUIT;
 613                 CHECK_RANGE (op);
 614                 stack.pc = stack.byte_string_start + op;
 615               }
 616             NEXT;
 617           }
 618
 619         CASE (Bcar):
 620           {
 621             Lisp_Object v1;
 622             v1 = TOP;
 623             if (CONSP (v1))
 624               TOP = XCAR (v1);
 625             else if (NILP (v1))
 626               TOP = Qnil;
 627             else
 628               {
 629                 wrong_type_argument (Qlistp, v1);
 630               }
 631             NEXT;
 632           }
 633
 634         CASE (Beq):
 635           {
 636             Lisp_Object v1;
 637             v1 = POP;
 638             TOP = EQ (v1, TOP) ? Qt : Qnil;
 639             NEXT;
 640           }
 641
 642         CASE (Bmemq):
 643           {
 644             Lisp_Object v1;
 645             v1 = POP;
 646             TOP = Fmemq (TOP, v1);
 647             NEXT;
 648           }
 649
 650         CASE (Bcdr):
 651           {
 652             Lisp_Object v1;
 653             v1 = TOP;
 654             if (CONSP (v1))
 655               TOP = XCDR (v1);
 656             else if (NILP (v1))
 657               TOP = Qnil;
 658             else
 659               {
 660                 wrong_type_argument (Qlistp, v1);
 661               }
 662             NEXT;
 663           }
 664
 665         CASE (Bvarset):
 666         CASE (Bvarset1):
 667         CASE (Bvarset2):
 668         CASE (Bvarset3):
 669         CASE (Bvarset4):
 670         CASE (Bvarset5):
 671           op -= Bvarset;
 672           goto varset;
 673
 674         CASE (Bvarset7):
 675           op = FETCH2;
 676           goto varset;
 677
 678         CASE (Bvarset6):
 679           op = FETCH;
 680         varset:
 681           {
 682             Lisp_Object sym, val;
 683
 684             sym = vectorp[op];
 685             val = TOP;
 686
 687             /* Inline the most common case.  */
 688             if (SYMBOLP (sym)
 689                 && !EQ (val, Qunbound)
 690                 && !XSYMBOL (sym)->redirect
 691                 && !SYMBOL_CONSTANT_P (sym))
 692               SET_SYMBOL_VAL (XSYMBOL (sym), val);
 693             else
 694               {
 695                 set_internal (sym, val, Qnil, 0);
 696               }
 697           }
 698           (void) POP;
 699           NEXT;
 700
 701         CASE (Bdup):
 702           {
 703             Lisp_Object v1;
 704             v1 = TOP;
 705             PUSH (v1);
 706             NEXT;
 707           }
 708
 709         /* ------------------ */
 710
 711         CASE (Bvarbind6):
 712           op = FETCH;
 713           goto varbind;
 714
 715         CASE (Bvarbind7):
 716           op = FETCH2;
 717           goto varbind;
 718
 719         CASE (Bvarbind):
 720         CASE (Bvarbind1):
 721         CASE (Bvarbind2):
 722         CASE (Bvarbind3):
 723         CASE (Bvarbind4):
 724         CASE (Bvarbind5):
 725           op -= Bvarbind;
 726         varbind:
 727           /* Specbind can signal and thus GC.  */
 728           specbind (vectorp[op], POP);
 729           NEXT;
 730
 731         CASE (Bcall6):
 732           op = FETCH;
 733           goto docall;
 734
 735         CASE (Bcall7):
 736           op = FETCH2;
 737           goto docall;
 738
 739         CASE (Bcall):
 740         CASE (Bcall1):
 741         CASE (Bcall2):
 742         CASE (Bcall3):
 743         CASE (Bcall4):
 744         CASE (Bcall5):
 745           op -= Bcall;
 746         docall:
 747           {
 748             DISCARD (op);
 749 #ifdef BYTE_CODE_METER
 750             if (byte_metering_on && SYMBOLP (TOP))
 751               {
 752                 Lisp_Object v1, v2;
 753
 754                 v1 = TOP;
 755                 v2 = Fget (v1, Qbyte_code_meter);
 756                 if (INTEGERP (v2)
 757                     && XINT (v2) < MOST_POSITIVE_FIXNUM)
 758                   {
 759                     XSETINT (v2, XINT (v2) + 1);
 760                     Fput (v1, Qbyte_code_meter, v2);
 761                   }
 762               }
 763 #endif
 764             TOP = Ffuncall (op + 1, &TOP);
 765             NEXT;
 766           }
 767
 768         CASE (Bunbind6):
 769           op = FETCH;
 770           goto dounbind;
 771
 772         CASE (Bunbind7):
 773           op = FETCH2;
 774           goto dounbind;
 775
 776         CASE (Bunbind):
 777         CASE (Bunbind1):
 778         CASE (Bunbind2):
 779         CASE (Bunbind3):
 780         CASE (Bunbind4):
 781         CASE (Bunbind5):
 782           op -= Bunbind;
 783         dounbind:
 784           unbind_to (SPECPDL_INDEX () - op, Qnil);
 785           NEXT;
 786
 787         CASE (Bunbind_all):     /* Obsolete.  Never used.  */
 788           /* To unbind back to the beginning of this frame.  Not used yet,
 789              but will be needed for tail-recursion elimination.  */
 790           unbind_to (count, Qnil);
 791           NEXT;
 792
 793         CASE (Bgoto):
 794           BYTE_CODE_QUIT;
 795           op = FETCH2;    /* pc = FETCH2 loses since FETCH2 contains pc++ */
 796           CHECK_RANGE (op);
 797           stack.pc = stack.byte_string_start + op;
 798           NEXT;
 799
 800         CASE (Bgotoifnonnil):
 801           {
 802             Lisp_Object v1;
 803             op = FETCH2;
 804             v1 = POP;
 805             if (!NILP (v1))
 806               {
 807                 BYTE_CODE_QUIT;
 808                 CHECK_RANGE (op);
 809                 stack.pc = stack.byte_string_start + op;
 810               }
 811             NEXT;
 812           }
 813
 814         CASE (Bgotoifnilelsepop):
 815           op = FETCH2;
 816           if (NILP (TOP))
 817             {
 818               BYTE_CODE_QUIT;
 819               CHECK_RANGE (op);
 820               stack.pc = stack.byte_string_start + op;
 821             }
 822           else DISCARD (1);
 823           NEXT;
 824
 825         CASE (Bgotoifnonnilelsepop):
 826           op = FETCH2;
 827           if (!NILP (TOP))
 828             {
 829               BYTE_CODE_QUIT;
 830               CHECK_RANGE (op);
 831               stack.pc = stack.byte_string_start + op;
 832             }
 833           else DISCARD (1);
 834           NEXT;
 835
 836         CASE (BRgoto):
 837           BYTE_CODE_QUIT;
 838           stack.pc += (int) *stack.pc - 127;
 839           NEXT;
 840
 841         CASE (BRgotoifnil):
 842           {
 843             Lisp_Object v1;
 844             v1 = POP;
 845             if (NILP (v1))
 846               {
 847                 BYTE_CODE_QUIT;
 848                 stack.pc += (int) *stack.pc - 128;
 849               }
 850             stack.pc++;
 851             NEXT;
 852           }
 853
 854         CASE (BRgotoifnonnil):
 855           {
 856             Lisp_Object v1;
 857             v1 = POP;
 858             if (!NILP (v1))
 859               {
 860                 BYTE_CODE_QUIT;
 861                 stack.pc += (int) *stack.pc - 128;
 862               }
 863             stack.pc++;
 864             NEXT;
 865           }
 866
 867         CASE (BRgotoifnilelsepop):
 868           op = *stack.pc++;
 869           if (NILP (TOP))
 870             {
 871               BYTE_CODE_QUIT;
 872               stack.pc += op - 128;
 873             }
 874           else DISCARD (1);
 875           NEXT;
 876
 877         CASE (BRgotoifnonnilelsepop):
 878           op = *stack.pc++;
 879           if (!NILP (TOP))
 880             {
 881               BYTE_CODE_QUIT;
 882               stack.pc += op - 128;
 883             }
 884           else DISCARD (1);
 885           NEXT;
 886
 887         CASE (Breturn):
 888           result = POP;
 889           goto exit;
 890
 891         CASE (Bdiscard):
 892           DISCARD (1);
 893           NEXT;
 894
 895         CASE (Bconstant2):
 896           PUSH (vectorp[FETCH2]);
 897           NEXT;
 898
 899         CASE (Bsave_excursion):
 900           record_unwind_protect (save_excursion_restore,
 901                                  save_excursion_save ());
 902           NEXT;
 903
 904         CASE (Bsave_current_buffer): /* Obsolete since ??.  */
 905         CASE (Bsave_current_buffer_1):
 906           record_unwind_current_buffer ();
 907           NEXT;
 908
 909         CASE (Bsave_window_excursion): /* Obsolete since 24.1.  */
 910           {
 911             ptrdiff_t count1 = SPECPDL_INDEX ();
 912             record_unwind_protect (restore_window_configuration,
 913                                    Fcurrent_window_configuration (Qnil));
 914             TOP = Fprogn (TOP);
 915             unbind_to (count1, TOP);
 916             NEXT;
 917           }
 918
 919         CASE (Bsave_restriction):
 920           record_unwind_protect (save_restriction_restore,
 921                                  save_restriction_save ());
 922           NEXT;
 923
 924         CASE (Bcatch):          /* Obsolete since 24.4.  */
 925           {
 926             Lisp_Object v1;
 927             v1 = POP;
 928             TOP = internal_catch (TOP, eval_sub, v1);
 929             NEXT;
 930           }
 931
 932         CASE (Bpushcatch):      /* New in 24.4.  */
 933           type = CATCHER;
 934           goto pushhandler;
 935         CASE (Bpushconditioncase): /* New in 24.4.  */
 936           type = CONDITION_CASE;
 937         pushhandler:
 938           {
 939             Lisp_Object tag = POP;
 940             int dest = FETCH2;
 941
 942             struct handler *c = push_handler (tag, type);
 943             c->bytecode_dest = dest;
 944             c->bytecode_top = top;
 945
 946             if (sys_setjmp (c->jmp))
 947               {
 948                 struct handler *c = handlerlist;
 949                 int dest;
 950                 top = c->bytecode_top;
 951                 dest = c->bytecode_dest;
 952                 handlerlist = c->next;
 953                 PUSH (c->val);
 954                 CHECK_RANGE (dest);
 955                 /* Might have been re-set by longjmp!  */
 956                 stack.byte_string_start = SDATA (stack.byte_string);
 957                 stack.pc = stack.byte_string_start + dest;
 958               }
 959
 960             NEXT;
 961           }
 962
 963         CASE (Bpophandler):     /* New in 24.4.  */
 964           {
 965             handlerlist = handlerlist->next;
 966             NEXT;
 967           }
 968
 969         CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind.  */
 970           {
 971             Lisp_Object handler = POP;
 972             /* Support for a function here is new in 24.4.  */
 973             record_unwind_protect (NILP (Ffunctionp (handler))
 974                                    ? unwind_body : bcall0,
 975                                    handler);
 976             NEXT;
 977           }
 978
 979         CASE (Bcondition_case):         /* Obsolete since 24.4.  */
 980           {
 981             Lisp_Object handlers, body;
 982             handlers = POP;
 983             body = POP;
 984             TOP = internal_lisp_condition_case (TOP, body, handlers);
 985             NEXT;
 986           }
 987
 988         CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1.  */
 989           CHECK_STRING (TOP);
 990           temp_output_buffer_setup (SSDATA (TOP));
 991           TOP = Vstandard_output;
 992           NEXT;
 993
 994         CASE (Btemp_output_buffer_show): /* Obsolete since 24.1.  */
 995           {
 996             Lisp_Object v1;
 997             v1 = POP;
 998             temp_output_buffer_show (TOP);
 999             TOP = v1;
1000             /* pop binding of standard-output */
1001             unbind_to (SPECPDL_INDEX () - 1, Qnil);
1002             NEXT;
1003           }
1004
1005         CASE (Bnth):
1006           {
1007             Lisp_Object v1, v2;
1008             EMACS_INT n;
1009             v1 = POP;
1010             v2 = TOP;
1011             CHECK_NUMBER (v2);
1012             n = XINT (v2);
1013             immediate_quit = 1;
1014             while (--n >= 0 && CONSP (v1))
1015               v1 = XCDR (v1);
1016             immediate_quit = 0;
1017             TOP = CAR (v1);
1018             NEXT;
1019           }
1020
1021         CASE (Bsymbolp):
1022           TOP = SYMBOLP (TOP) ? Qt : Qnil;
1023           NEXT;
1024
1025         CASE (Bconsp):
1026           TOP = CONSP (TOP) ? Qt : Qnil;
1027           NEXT;
1028
1029         CASE (Bstringp):
1030           TOP = STRINGP (TOP) ? Qt : Qnil;
1031           NEXT;
1032
1033         CASE (Blistp):
1034           TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
1035           NEXT;
1036
1037         CASE (Bnot):
1038           TOP = NILP (TOP) ? Qt : Qnil;
1039           NEXT;
1040
1041         CASE (Bcons):
1042           {
1043             Lisp_Object v1;
1044             v1 = POP;
1045             TOP = Fcons (TOP, v1);
1046             NEXT;
1047           }
1048
1049         CASE (Blist1):
1050           TOP = list1 (TOP);
1051           NEXT;
1052
1053         CASE (Blist2):
1054           {
1055             Lisp_Object v1;
1056             v1 = POP;
1057             TOP = list2 (TOP, v1);
1058             NEXT;
1059           }
1060
1061         CASE (Blist3):
1062           DISCARD (2);
1063           TOP = Flist (3, &TOP);
1064           NEXT;
1065
1066         CASE (Blist4):
1067           DISCARD (3);
1068           TOP = Flist (4, &TOP);
1069           NEXT;
1070
1071         CASE (BlistN):
1072           op = FETCH;
1073           DISCARD (op - 1);
1074           TOP = Flist (op, &TOP);
1075           NEXT;
1076
1077         CASE (Blength):
1078           TOP = Flength (TOP);
1079           NEXT;
1080
1081         CASE (Baref):
1082           {
1083             Lisp_Object v1;
1084             v1 = POP;
1085             TOP = Faref (TOP, v1);
1086             NEXT;
1087           }
1088
1089         CASE (Baset):
1090           {
1091             Lisp_Object v1, v2;
1092             v2 = POP; v1 = POP;
1093             TOP = Faset (TOP, v1, v2);
1094             NEXT;
1095           }
1096
1097         CASE (Bsymbol_value):
1098           TOP = Fsymbol_value (TOP);
1099           NEXT;
1100
1101         CASE (Bsymbol_function):
1102           TOP = Fsymbol_function (TOP);
1103           NEXT;
1104
1105         CASE (Bset):
1106           {
1107             Lisp_Object v1;
1108             v1 = POP;
1109             TOP = Fset (TOP, v1);
1110             NEXT;
1111           }
1112
1113         CASE (Bfset):
1114           {
1115             Lisp_Object v1;
1116             v1 = POP;
1117             TOP = Ffset (TOP, v1);
1118             NEXT;
1119           }
1120
1121         CASE (Bget):
1122           {
1123             Lisp_Object v1;
1124             v1 = POP;
1125             TOP = Fget (TOP, v1);
1126             NEXT;
1127           }
1128
1129         CASE (Bsubstring):
1130           {
1131             Lisp_Object v1, v2;
1132             v2 = POP; v1 = POP;
1133             TOP = Fsubstring (TOP, v1, v2);
1134             NEXT;
1135           }
1136
1137         CASE (Bconcat2):
1138           DISCARD (1);
1139           TOP = Fconcat (2, &TOP);
1140           NEXT;
1141
1142         CASE (Bconcat3):
1143           DISCARD (2);
1144           TOP = Fconcat (3, &TOP);
1145           NEXT;
1146
1147         CASE (Bconcat4):
1148           DISCARD (3);
1149           TOP = Fconcat (4, &TOP);
1150           NEXT;
1151
1152         CASE (BconcatN):
1153           op = FETCH;
1154           DISCARD (op - 1);
1155           TOP = Fconcat (op, &TOP);
1156           NEXT;
1157
1158         CASE (Bsub1):
1159           {
1160             Lisp_Object v1;
1161             v1 = TOP;
1162             if (INTEGERP (v1))
1163               {
1164                 XSETINT (v1, XINT (v1) - 1);
1165                 TOP = v1;
1166               }
1167             else
1168               {
1169                 TOP = Fsub1 (v1);
1170               }
1171             NEXT;
1172           }
1173
1174         CASE (Badd1):
1175           {
1176             Lisp_Object v1;
1177             v1 = TOP;
1178             if (INTEGERP (v1))
1179               {
1180                 XSETINT (v1, XINT (v1) + 1);
1181                 TOP = v1;
1182               }
1183             else
1184               {
1185                 TOP = Fadd1 (v1);
1186               }
1187             NEXT;
1188           }
1189
1190         CASE (Beqlsign):
1191           {
1192             Lisp_Object v1, v2;
1193             v2 = POP; v1 = TOP;
1194             CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
1195             CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
1196             if (FLOATP (v1) || FLOATP (v2))
1197               {
1198                 double f1, f2;
1199
1200                 f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1));
1201                 f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
1202                 TOP = (f1 == f2 ? Qt : Qnil);
1203               }
1204             else
1205               TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
1206             NEXT;
1207           }
1208
1209         CASE (Bgtr):
1210           {
1211             Lisp_Object v1;
1212             v1 = POP;
1213             TOP = arithcompare (TOP, v1, ARITH_GRTR);
1214             NEXT;
1215           }
1216
1217         CASE (Blss):
1218           {
1219             Lisp_Object v1;
1220             v1 = POP;
1221             TOP = arithcompare (TOP, v1, ARITH_LESS);
1222             NEXT;
1223           }
1224
1225         CASE (Bleq):
1226           {
1227             Lisp_Object v1;
1228             v1 = POP;
1229             TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL);
1230             NEXT;
1231           }
1232
1233         CASE (Bgeq):
1234           {
1235             Lisp_Object v1;
1236             v1 = POP;
1237             TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL);
1238             NEXT;
1239           }
1240
1241         CASE (Bdiff):
1242           DISCARD (1);
1243           TOP = Fminus (2, &TOP);
1244           NEXT;
1245
1246         CASE (Bnegate):
1247           {
1248             Lisp_Object v1;
1249             v1 = TOP;
1250             if (INTEGERP (v1))
1251               {
1252                 XSETINT (v1, - XINT (v1));
1253                 TOP = v1;
1254               }
1255             else
1256               {
1257                 TOP = Fminus (1, &TOP);
1258               }
1259             NEXT;
1260           }
1261
1262         CASE (Bplus):
1263           DISCARD (1);
1264           TOP = Fplus (2, &TOP);
1265           NEXT;
1266
1267         CASE (Bmax):
1268           DISCARD (1);
1269           TOP = Fmax (2, &TOP);
1270           NEXT;
1271
1272         CASE (Bmin):
1273           DISCARD (1);
1274           TOP = Fmin (2, &TOP);
1275           NEXT;
1276
1277         CASE (Bmult):
1278           DISCARD (1);
1279           TOP = Ftimes (2, &TOP);
1280           NEXT;
1281
1282         CASE (Bquo):
1283           DISCARD (1);
1284           TOP = Fquo (2, &TOP);
1285           NEXT;
1286
1287         CASE (Brem):
1288           {
1289             Lisp_Object v1;
1290             v1 = POP;
1291             TOP = Frem (TOP, v1);
1292             NEXT;
1293           }
1294
1295         CASE (Bpoint):
1296           {
1297             Lisp_Object v1;
1298             XSETFASTINT (v1, PT);
1299             PUSH (v1);
1300             NEXT;
1301           }
1302
1303         CASE (Bgoto_char):
1304           TOP = Fgoto_char (TOP);
1305           NEXT;
1306
1307         CASE (Binsert):
1308           TOP = Finsert (1, &TOP);
1309           NEXT;
1310
1311         CASE (BinsertN):
1312           op = FETCH;
1313           DISCARD (op - 1);
1314           TOP = Finsert (op, &TOP);
1315           NEXT;
1316
1317         CASE (Bpoint_max):
1318           {
1319             Lisp_Object v1;
1320             XSETFASTINT (v1, ZV);
1321             PUSH (v1);
1322             NEXT;
1323           }
1324
1325         CASE (Bpoint_min):
1326           {
1327             Lisp_Object v1;
1328             XSETFASTINT (v1, BEGV);
1329             PUSH (v1);
1330             NEXT;
1331           }
1332
1333         CASE (Bchar_after):
1334           TOP = Fchar_after (TOP);
1335           NEXT;
1336
1337         CASE (Bfollowing_char):
1338           {
1339             Lisp_Object v1;
1340             v1 = Ffollowing_char ();
1341             PUSH (v1);
1342             NEXT;
1343           }
1344
1345         CASE (Bpreceding_char):
1346           {
1347             Lisp_Object v1;
1348             v1 = Fprevious_char ();
1349             PUSH (v1);
1350             NEXT;
1351           }
1352
1353         CASE (Bcurrent_column):
1354           {
1355             Lisp_Object v1;
1356             XSETFASTINT (v1, current_column ());
1357             PUSH (v1);
1358             NEXT;
1359           }
1360
1361         CASE (Bindent_to):
1362           TOP = Findent_to (TOP, Qnil);
1363           NEXT;
1364
1365         CASE (Beolp):
1366           PUSH (Feolp ());
1367           NEXT;
1368
1369         CASE (Beobp):
1370           PUSH (Feobp ());
1371           NEXT;
1372
1373         CASE (Bbolp):
1374           PUSH (Fbolp ());
1375           NEXT;
1376
1377         CASE (Bbobp):
1378           PUSH (Fbobp ());
1379           NEXT;
1380
1381         CASE (Bcurrent_buffer):
1382           PUSH (Fcurrent_buffer ());
1383           NEXT;
1384
1385         CASE (Bset_buffer):
1386           TOP = Fset_buffer (TOP);
1387           NEXT;
1388
1389         CASE (Binteractive_p):  /* Obsolete since 24.1.  */
1390           PUSH (call0 (intern ("interactive-p")));
1391           NEXT;
1392
1393         CASE (Bforward_char):
1394           TOP = Fforward_char (TOP);
1395           NEXT;
1396
1397         CASE (Bforward_word):
1398           TOP = Fforward_word (TOP);
1399           NEXT;
1400
1401         CASE (Bskip_chars_forward):
1402           {
1403             Lisp_Object v1;
1404             v1 = POP;
1405             TOP = Fskip_chars_forward (TOP, v1);
1406             NEXT;
1407           }
1408
1409         CASE (Bskip_chars_backward):
1410           {
1411             Lisp_Object v1;
1412             v1 = POP;
1413             TOP = Fskip_chars_backward (TOP, v1);
1414             NEXT;
1415           }
1416
1417         CASE (Bforward_line):
1418           TOP = Fforward_line (TOP);
1419           NEXT;
1420
1421         CASE (Bchar_syntax):
1422           {
1423             int c;
1424
1425             CHECK_CHARACTER (TOP);
1426             c = XFASTINT (TOP);
1427             if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1428               MAKE_CHAR_MULTIBYTE (c);
1429             XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]);
1430           }
1431           NEXT;
1432
1433         CASE (Bbuffer_substring):
1434           {
1435             Lisp_Object v1;
1436             v1 = POP;
1437             TOP = Fbuffer_substring (TOP, v1);
1438             NEXT;
1439           }
1440
1441         CASE (Bdelete_region):
1442           {
1443             Lisp_Object v1;
1444             v1 = POP;
1445             TOP = Fdelete_region (TOP, v1);
1446             NEXT;
1447           }
1448
1449         CASE (Bnarrow_to_region):
1450           {
1451             Lisp_Object v1;
1452             v1 = POP;
1453             TOP = Fnarrow_to_region (TOP, v1);
1454             NEXT;
1455           }
1456
1457         CASE (Bwiden):
1458           PUSH (Fwiden ());
1459           NEXT;
1460
1461         CASE (Bend_of_line):
1462           TOP = Fend_of_line (TOP);
1463           NEXT;
1464
1465         CASE (Bset_marker):
1466           {
1467             Lisp_Object v1, v2;
1468             v1 = POP;
1469             v2 = POP;
1470             TOP = Fset_marker (TOP, v2, v1);
1471             NEXT;
1472           }
1473
1474         CASE (Bmatch_beginning):
1475           TOP = Fmatch_beginning (TOP);
1476           NEXT;
1477
1478         CASE (Bmatch_end):
1479           TOP = Fmatch_end (TOP);
1480           NEXT;
1481
1482         CASE (Bupcase):
1483           TOP = Fupcase (TOP);
1484           NEXT;
1485
1486         CASE (Bdowncase):
1487           TOP = Fdowncase (TOP);
1488         NEXT;
1489
1490       CASE (Bstringeqlsign):
1491           {
1492             Lisp_Object v1;
1493             v1 = POP;
1494             TOP = Fstring_equal (TOP, v1);
1495             NEXT;
1496           }
1497
1498         CASE (Bstringlss):
1499           {
1500             Lisp_Object v1;
1501             v1 = POP;
1502             TOP = Fstring_lessp (TOP, v1);
1503             NEXT;
1504           }
1505
1506         CASE (Bequal):
1507           {
1508             Lisp_Object v1;
1509             v1 = POP;
1510             TOP = Fequal (TOP, v1);
1511             NEXT;
1512           }
1513
1514         CASE (Bnthcdr):
1515           {
1516             Lisp_Object v1;
1517             v1 = POP;
1518             TOP = Fnthcdr (TOP, v1);
1519             NEXT;
1520           }
1521
1522         CASE (Belt):
1523           {
1524             Lisp_Object v1, v2;
1525             if (CONSP (TOP))
1526               {
1527                 /* Exchange args and then do nth.  */
1528                 EMACS_INT n;
1529                 v2 = POP;
1530                 v1 = TOP;
1531                 CHECK_NUMBER (v2);
1532                 n = XINT (v2);
1533                 immediate_quit = 1;
1534                 while (--n >= 0 && CONSP (v1))
1535                   v1 = XCDR (v1);
1536                 immediate_quit = 0;
1537                 TOP = CAR (v1);
1538               }
1539             else
1540               {
1541                 v1 = POP;
1542                 TOP = Felt (TOP, v1);
1543               }
1544             NEXT;
1545           }
1546
1547         CASE (Bmember):
1548           {
1549             Lisp_Object v1;
1550             v1 = POP;
1551             TOP = Fmember (TOP, v1);
1552             NEXT;
1553           }
1554
1555         CASE (Bassq):
1556           {
1557             Lisp_Object v1;
1558             v1 = POP;
1559             TOP = Fassq (TOP, v1);
1560             NEXT;
1561           }
1562
1563         CASE (Bnreverse):
1564           TOP = Fnreverse (TOP);
1565           NEXT;
1566
1567         CASE (Bsetcar):
1568           {
1569             Lisp_Object v1;
1570             v1 = POP;
1571             TOP = Fsetcar (TOP, v1);
1572             NEXT;
1573           }
1574
1575         CASE (Bsetcdr):
1576           {
1577             Lisp_Object v1;
1578             v1 = POP;
1579             TOP = Fsetcdr (TOP, v1);
1580             NEXT;
1581           }
1582
1583         CASE (Bcar_safe):
1584           {
1585             Lisp_Object v1;
1586             v1 = TOP;
1587             TOP = CAR_SAFE (v1);
1588             NEXT;
1589           }
1590
1591         CASE (Bcdr_safe):
1592           {
1593             Lisp_Object v1;
1594             v1 = TOP;
1595             TOP = CDR_SAFE (v1);
1596             NEXT;
1597           }
1598
1599         CASE (Bnconc):
1600           DISCARD (1);
1601           TOP = Fnconc (2, &TOP);
1602           NEXT;
1603
1604         CASE (Bnumberp):
1605           TOP = (NUMBERP (TOP) ? Qt : Qnil);
1606           NEXT;
1607
1608         CASE (Bintegerp):
1609           TOP = INTEGERP (TOP) ? Qt : Qnil;
1610           NEXT;
1611
1612 #if BYTE_CODE_SAFE
1613           /* These are intentionally written using 'case' syntax,
1614              because they are incompatible with the threaded
1615              interpreter.  */
1616
1617         case Bset_mark:
1618           error ("set-mark is an obsolete bytecode");
1619           break;
1620         case Bscan_buffer:
1621           error ("scan-buffer is an obsolete bytecode");
1622           break;
1623 #endif
1624
1625         CASE_ABORT:
1626           /* Actually this is Bstack_ref with offset 0, but we use Bdup
1627              for that instead.  */
1628           /* CASE (Bstack_ref): */
1629           call3 (Qerror,
1630                  build_string ("Invalid byte opcode: op=%s, ptr=%d"),
1631                  make_number (op),
1632                  make_number ((stack.pc - 1) - stack.byte_string_start));
1633
1634           /* Handy byte-codes for lexical binding.  */
1635         CASE (Bstack_ref1):
1636         CASE (Bstack_ref2):
1637         CASE (Bstack_ref3):
1638         CASE (Bstack_ref4):
1639         CASE (Bstack_ref5):
1640           {
1641             Lisp_Object *ptr = top - (op - Bstack_ref);
1642             PUSH (*ptr);
1643             NEXT;
1644           }
1645         CASE (Bstack_ref6):
1646           {
1647             Lisp_Object *ptr = top - (FETCH);
1648             PUSH (*ptr);
1649             NEXT;
1650           }
1651         CASE (Bstack_ref7):
1652           {
1653             Lisp_Object *ptr = top - (FETCH2);
1654             PUSH (*ptr);
1655             NEXT;
1656           }
1657         CASE (Bstack_set):
1658           /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos.  */
1659           {
1660             Lisp_Object *ptr = top - (FETCH);
1661             *ptr = POP;
1662             NEXT;
1663           }
1664         CASE (Bstack_set2):
1665           {
1666             Lisp_Object *ptr = top - (FETCH2);
1667             *ptr = POP;
1668             NEXT;
1669           }
1670         CASE (BdiscardN):
1671           op = FETCH;
1672           if (op & 0x80)
1673             {
1674               op &= 0x7F;
1675               top[-op] = TOP;
1676             }
1677           DISCARD (op);
1678           NEXT;
1679
1680         CASE_DEFAULT
1681         CASE (Bconstant):
1682           if (BYTE_CODE_SAFE
1683               && ! (Bconstant <= op && op < Bconstant + const_length))
1684             emacs_abort ();
1685           PUSH (vectorp[op - Bconstant]);
1686           NEXT;
1687         }
1688     }
1689
1690  exit:
1691
1692   byte_stack_list = byte_stack_list->next;
1693
1694   /* Binds and unbinds are supposed to be compiled balanced.  */
1695   if (SPECPDL_INDEX () != count)
1696     {
1697       if (SPECPDL_INDEX () > count)
1698         unbind_to (count, Qnil);
1699       error ("binding stack not balanced (serious byte compiler bug)");
1700     }
1701
1702   return result;
1703 }
1704
1705 /* `args_template' has the same meaning as in exec_byte_code() above.  */
1706 Lisp_Object
1707 get_byte_code_arity (Lisp_Object args_template)
1708 {
1709   eassert (NATNUMP (args_template));
1710   EMACS_INT at = XINT (args_template);
1711   bool rest = (at & 128) != 0;
1712   int mandatory = at & 127;
1713   EMACS_INT nonrest = at >> 8;
1714
1715   return Fcons (make_number (mandatory),
1716                 rest ? Qmany : make_number (nonrest));
1717 }
1718
1719 void
1720 syms_of_bytecode (void)
1721 {
1722   defsubr (&Sbyte_code);
1723
1724 #ifdef BYTE_CODE_METER
1725
1726   DEFVAR_LISP ("byte-code-meter", Vbyte_code_meter,
1727                doc: /* A vector of vectors which holds a histogram of byte-code usage.
1728 \(aref (aref byte-code-meter 0) CODE) indicates how many times the byte
1729 opcode CODE has been executed.
1730 \(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
1731 indicates how many times the byte opcodes CODE1 and CODE2 have been
1732 executed in succession.  */);
1733
1734   DEFVAR_BOOL ("byte-metering-on", byte_metering_on,
1735                doc: /* If non-nil, keep profiling information on byte code usage.
1736 The variable byte-code-meter indicates how often each byte opcode is used.
1737 If a symbol has a property named `byte-code-meter' whose value is an
1738 integer, it is incremented each time that symbol's function is called.  */);
1739
1740   byte_metering_on = 0;
1741   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
1742   DEFSYM (Qbyte_code_meter, "byte-code-meter");
1743   {
1744     int i = 256;
1745     while (i--)
1746       ASET (Vbyte_code_meter, i,
1747            Fmake_vector (make_number (256), make_number (0)));
1748   }
1749 #endif
1750 }