src/bytecode.c

   1 /* Execution of byte code produced by bytecomp.el.
   2    Copyright (C) 1985-1988, 1993, 2000-2017 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__ && !defined __CHKP__ \
  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 (Bswitch, 0267)                                                  \
 271                                                                         \
 272 DEFINE (Bconstant, 0300)
 273
 274 enum byte_code_op
 275 {
 276 #define DEFINE(name, value) name = value,
 277     BYTE_CODES
 278 #undef DEFINE
 279
 280 #if BYTE_CODE_SAFE
 281     Bscan_buffer = 0153, /* No longer generated as of v18.  */
 282     Bset_mark = 0163, /* this loser is no longer generated as of v18 */
 283 #endif
 284 };
 285 \f
 286 /* Fetch the next byte from the bytecode stream.  */
 287
 288 #define FETCH (*pc++)
 289
 290 /* Fetch two bytes from the bytecode stream and make a 16-bit number
 291    out of them.  */
 292
 293 #define FETCH2 (op = FETCH, op + (FETCH << 8))
 294
 295 /* Push X onto the execution stack.  The expression X should not
 296    contain TOP, to avoid competing side effects.  */
 297
 298 #define PUSH(x) (*++top = (x))
 299
 300 /* Pop a value off the execution stack.  */
 301
 302 #define POP (*top--)
 303
 304 /* Discard n values from the execution stack.  */
 305
 306 #define DISCARD(n) (top -= (n))
 307
 308 /* Get the value which is at the top of the execution stack, but don't
 309    pop it.  */
 310
 311 #define TOP (*top)
 312
 313 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
 314        doc: /* Function used internally in byte-compiled code.
 315 The first argument, BYTESTR, is a string of byte code;
 316 the second, VECTOR, a vector of constants;
 317 the third, MAXDEPTH, the maximum stack depth used in this function.
 318 If the third argument is incorrect, Emacs may crash.  */)
 319   (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth)
 320 {
 321   return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL);
 322 }
 323
 324 static void
 325 bcall0 (Lisp_Object f)
 326 {
 327   Ffuncall (1, &f);
 328 }
 329
 330 /* Execute the byte-code in BYTESTR.  VECTOR is the constant vector, and
 331    MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect,
 332    emacs may crash!).  If ARGS_TEMPLATE is non-nil, it should be a lisp
 333    argument list (including &rest, &optional, etc.), and ARGS, of size
 334    NARGS, should be a vector of the actual arguments.  The arguments in
 335    ARGS are pushed on the stack according to ARGS_TEMPLATE before
 336    executing BYTESTR.  */
 337
 338 Lisp_Object
 339 exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth,
 340                 Lisp_Object args_template, ptrdiff_t nargs, Lisp_Object *args)
 341 {
 342 #ifdef BYTE_CODE_METER
 343   int volatile this_op = 0;
 344 #endif
 345
 346   CHECK_STRING (bytestr);
 347   CHECK_VECTOR (vector);
 348   CHECK_NATNUM (maxdepth);
 349
 350   ptrdiff_t const_length = ASIZE (vector);
 351
 352   if (STRING_MULTIBYTE (bytestr))
 353     /* BYTESTR must have been produced by Emacs 20.2 or the earlier
 354        because they produced a raw 8-bit string for byte-code and now
 355        such a byte-code string is loaded as multibyte while raw 8-bit
 356        characters converted to multibyte form.  Thus, now we must
 357        convert them back to the originally intended unibyte form.  */
 358     bytestr = Fstring_as_unibyte (bytestr);
 359
 360   ptrdiff_t bytestr_length = SBYTES (bytestr);
 361   Lisp_Object *vectorp = XVECTOR (vector)->contents;
 362
 363   unsigned char quitcounter = 1;
 364   EMACS_INT stack_items = XFASTINT (maxdepth) + 1;
 365   USE_SAFE_ALLOCA;
 366   Lisp_Object *stack_base;
 367   SAFE_ALLOCA_LISP_EXTRA (stack_base, stack_items, bytestr_length);
 368   Lisp_Object *stack_lim = stack_base + stack_items;
 369   Lisp_Object *top = stack_base;
 370   memcpy (stack_lim, SDATA (bytestr), bytestr_length);
 371   void *void_stack_lim = stack_lim;
 372   unsigned char const *bytestr_data = void_stack_lim;
 373   unsigned char const *pc = bytestr_data;
 374   ptrdiff_t count = SPECPDL_INDEX ();
 375
 376   if (!NILP (args_template))
 377     {
 378       eassert (INTEGERP (args_template));
 379       ptrdiff_t at = XINT (args_template);
 380       bool rest = (at & 128) != 0;
 381       int mandatory = at & 127;
 382       ptrdiff_t nonrest = at >> 8;
 383       ptrdiff_t maxargs = rest ? PTRDIFF_MAX : nonrest;
 384       if (! (mandatory <= nargs && nargs <= maxargs))
 385         Fsignal (Qwrong_number_of_arguments,
 386                  list2 (Fcons (make_number (mandatory), make_number (nonrest)),
 387                         make_number (nargs)));
 388       ptrdiff_t pushedargs = min (nonrest, nargs);
 389       for (ptrdiff_t i = 0; i < pushedargs; i++, args++)
 390         PUSH (*args);
 391       if (nonrest < nargs)
 392         PUSH (Flist (nargs - nonrest, args));
 393       else
 394         for (ptrdiff_t i = nargs - rest; i < nonrest; i++)
 395           PUSH (Qnil);
 396     }
 397
 398   while (true)
 399     {
 400       int op;
 401       enum handlertype type;
 402
 403       if (BYTE_CODE_SAFE && ! (stack_base <= top && top < stack_lim))
 404         emacs_abort ();
 405
 406 #ifdef BYTE_CODE_METER
 407       int prev_op = this_op;
 408       this_op = op = FETCH;
 409       METER_CODE (prev_op, op);
 410 #elif !defined BYTE_CODE_THREADED
 411       op = FETCH;
 412 #endif
 413
 414       /* The interpreter can be compiled one of two ways: as an
 415          ordinary switch-based interpreter, or as a threaded
 416          interpreter.  The threaded interpreter relies on GCC's
 417          computed goto extension, so it is not available everywhere.
 418          Threading provides a performance boost.  These macros are how
 419          we allow the code to be compiled both ways.  */
 420 #ifdef BYTE_CODE_THREADED
 421       /* The CASE macro introduces an instruction's body.  It is
 422          either a label or a case label.  */
 423 #define CASE(OP) insn_ ## OP
 424       /* NEXT is invoked at the end of an instruction to go to the
 425          next instruction.  It is either a computed goto, or a
 426          plain break.  */
 427 #define NEXT goto *(targets[op = FETCH])
 428       /* FIRST is like NEXT, but is only used at the start of the
 429          interpreter body.  In the switch-based interpreter it is the
 430          switch, so the threaded definition must include a semicolon.  */
 431 #define FIRST NEXT;
 432       /* Most cases are labeled with the CASE macro, above.
 433          CASE_DEFAULT is one exception; it is used if the interpreter
 434          being built requires a default case.  The threaded
 435          interpreter does not, because the dispatch table is
 436          completely filled.  */
 437 #define CASE_DEFAULT
 438       /* This introduces an instruction that is known to call abort.  */
 439 #define CASE_ABORT CASE (Bstack_ref): CASE (default)
 440 #else
 441       /* See above for the meaning of the various defines.  */
 442 #define CASE(OP) case OP
 443 #define NEXT break
 444 #define FIRST switch (op)
 445 #define CASE_DEFAULT case 255: default:
 446 #define CASE_ABORT case 0
 447 #endif
 448
 449 #ifdef BYTE_CODE_THREADED
 450
 451       /* A convenience define that saves us a lot of typing and makes
 452          the table clearer.  */
 453 #define LABEL(OP) [OP] = &&insn_ ## OP
 454
 455 #if GNUC_PREREQ (4, 6, 0)
 456 # pragma GCC diagnostic push
 457 # pragma GCC diagnostic ignored "-Woverride-init"
 458 #elif defined __clang__
 459 # pragma GCC diagnostic push
 460 # pragma GCC diagnostic ignored "-Winitializer-overrides"
 461 #endif
 462
 463       /* This is the dispatch table for the threaded interpreter.  */
 464       static const void *const targets[256] =
 465         {
 466           [0 ... (Bconstant - 1)] = &&insn_default,
 467           [Bconstant ... 255] = &&insn_Bconstant,
 468
 469 #define DEFINE(name, value) LABEL (name) ,
 470           BYTE_CODES
 471 #undef DEFINE
 472         };
 473
 474 #if GNUC_PREREQ (4, 6, 0) || defined __clang__
 475 # pragma GCC diagnostic pop
 476 #endif
 477
 478 #endif
 479
 480
 481       FIRST
 482         {
 483         CASE (Bvarref7):
 484           op = FETCH2;
 485           goto varref;
 486
 487         CASE (Bvarref):
 488         CASE (Bvarref1):
 489         CASE (Bvarref2):
 490         CASE (Bvarref3):
 491         CASE (Bvarref4):
 492         CASE (Bvarref5):
 493           op -= Bvarref;
 494           goto varref;
 495
 496         /* This seems to be the most frequently executed byte-code
 497            among the Bvarref's, so avoid a goto here.  */
 498         CASE (Bvarref6):
 499           op = FETCH;
 500         varref:
 501           {
 502             Lisp_Object v1 = vectorp[op], v2;
 503             if (!SYMBOLP (v1)
 504                 || XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
 505                 || (v2 = SYMBOL_VAL (XSYMBOL (v1)), EQ (v2, Qunbound)))
 506               v2 = Fsymbol_value (v1);
 507             PUSH (v2);
 508             NEXT;
 509           }
 510
 511         CASE (Bgotoifnil):
 512           {
 513             Lisp_Object v1 = POP;
 514             op = FETCH2;
 515             if (NILP (v1))
 516               goto op_branch;
 517             NEXT;
 518           }
 519
 520         CASE (Bcar):
 521           if (CONSP (TOP))
 522             TOP = XCAR (TOP);
 523           else if (!NILP (TOP))
 524             wrong_type_argument (Qlistp, TOP);
 525           NEXT;
 526
 527         CASE (Beq):
 528           {
 529             Lisp_Object v1 = POP;
 530             TOP = EQ (v1, TOP) ? Qt : Qnil;
 531             NEXT;
 532           }
 533
 534         CASE (Bmemq):
 535           {
 536             Lisp_Object v1 = POP;
 537             TOP = Fmemq (TOP, v1);
 538             NEXT;
 539           }
 540
 541         CASE (Bcdr):
 542           {
 543             if (CONSP (TOP))
 544               TOP = XCDR (TOP);
 545             else if (!NILP (TOP))
 546               wrong_type_argument (Qlistp, TOP);
 547             NEXT;
 548           }
 549
 550         CASE (Bvarset):
 551         CASE (Bvarset1):
 552         CASE (Bvarset2):
 553         CASE (Bvarset3):
 554         CASE (Bvarset4):
 555         CASE (Bvarset5):
 556           op -= Bvarset;
 557           goto varset;
 558
 559         CASE (Bvarset7):
 560           op = FETCH2;
 561           goto varset;
 562
 563         CASE (Bvarset6):
 564           op = FETCH;
 565         varset:
 566           {
 567             Lisp_Object sym = vectorp[op];
 568             Lisp_Object val = POP;
 569
 570             /* Inline the most common case.  */
 571             if (SYMBOLP (sym)
 572                 && !EQ (val, Qunbound)
 573                 && !XSYMBOL (sym)->redirect
 574                 && !SYMBOL_TRAPPED_WRITE_P (sym))
 575               SET_SYMBOL_VAL (XSYMBOL (sym), val);
 576             else
 577               set_internal (sym, val, Qnil, SET_INTERNAL_SET);
 578           }
 579           NEXT;
 580
 581         CASE (Bdup):
 582           {
 583             Lisp_Object v1 = TOP;
 584             PUSH (v1);
 585             NEXT;
 586           }
 587
 588         /* ------------------ */
 589
 590         CASE (Bvarbind6):
 591           op = FETCH;
 592           goto varbind;
 593
 594         CASE (Bvarbind7):
 595           op = FETCH2;
 596           goto varbind;
 597
 598         CASE (Bvarbind):
 599         CASE (Bvarbind1):
 600         CASE (Bvarbind2):
 601         CASE (Bvarbind3):
 602         CASE (Bvarbind4):
 603         CASE (Bvarbind5):
 604           op -= Bvarbind;
 605         varbind:
 606           /* Specbind can signal and thus GC.  */
 607           specbind (vectorp[op], POP);
 608           NEXT;
 609
 610         CASE (Bcall6):
 611           op = FETCH;
 612           goto docall;
 613
 614         CASE (Bcall7):
 615           op = FETCH2;
 616           goto docall;
 617
 618         CASE (Bcall):
 619         CASE (Bcall1):
 620         CASE (Bcall2):
 621         CASE (Bcall3):
 622         CASE (Bcall4):
 623         CASE (Bcall5):
 624           op -= Bcall;
 625         docall:
 626           {
 627             DISCARD (op);
 628 #ifdef BYTE_CODE_METER
 629             if (byte_metering_on && SYMBOLP (TOP))
 630               {
 631                 Lisp_Object v1 = TOP;
 632                 Lisp_Object v2 = Fget (v1, Qbyte_code_meter);
 633                 if (INTEGERP (v2)
 634                     && XINT (v2) < MOST_POSITIVE_FIXNUM)
 635                   {
 636                     XSETINT (v2, XINT (v2) + 1);
 637                     Fput (v1, Qbyte_code_meter, v2);
 638                   }
 639               }
 640 #endif
 641             TOP = Ffuncall (op + 1, &TOP);
 642             NEXT;
 643           }
 644
 645         CASE (Bunbind6):
 646           op = FETCH;
 647           goto dounbind;
 648
 649         CASE (Bunbind7):
 650           op = FETCH2;
 651           goto dounbind;
 652
 653         CASE (Bunbind):
 654         CASE (Bunbind1):
 655         CASE (Bunbind2):
 656         CASE (Bunbind3):
 657         CASE (Bunbind4):
 658         CASE (Bunbind5):
 659           op -= Bunbind;
 660         dounbind:
 661           unbind_to (SPECPDL_INDEX () - op, Qnil);
 662           NEXT;
 663
 664         CASE (Bunbind_all):     /* Obsolete.  Never used.  */
 665           /* To unbind back to the beginning of this frame.  Not used yet,
 666              but will be needed for tail-recursion elimination.  */
 667           unbind_to (count, Qnil);
 668           NEXT;
 669
 670         CASE (Bgoto):
 671           op = FETCH2;
 672         op_branch:
 673           op -= pc - bytestr_data;
 674         op_relative_branch:
 675           if (BYTE_CODE_SAFE
 676               && ! (bytestr_data - pc <= op
 677                     && op < bytestr_data + bytestr_length - pc))
 678             emacs_abort ();
 679           quitcounter += op < 0;
 680           if (!quitcounter)
 681             {
 682               quitcounter = 1;
 683               maybe_gc ();
 684               maybe_quit ();
 685             }
 686           pc += op;
 687           NEXT;
 688
 689         CASE (Bgotoifnonnil):
 690           op = FETCH2;
 691           if (!NILP (POP))
 692             goto op_branch;
 693           NEXT;
 694
 695         CASE (Bgotoifnilelsepop):
 696           op = FETCH2;
 697           if (NILP (TOP))
 698             goto op_branch;
 699           DISCARD (1);
 700           NEXT;
 701
 702         CASE (Bgotoifnonnilelsepop):
 703           op = FETCH2;
 704           if (!NILP (TOP))
 705             goto op_branch;
 706           DISCARD (1);
 707           NEXT;
 708
 709         CASE (BRgoto):
 710           op = FETCH - 128;
 711           goto op_relative_branch;
 712
 713         CASE (BRgotoifnil):
 714           op = FETCH - 128;
 715           if (NILP (POP))
 716             goto op_relative_branch;
 717           NEXT;
 718
 719         CASE (BRgotoifnonnil):
 720           op = FETCH - 128;
 721           if (!NILP (POP))
 722             goto op_relative_branch;
 723           NEXT;
 724
 725         CASE (BRgotoifnilelsepop):
 726           op = FETCH - 128;
 727           if (NILP (TOP))
 728             goto op_relative_branch;
 729           DISCARD (1);
 730           NEXT;
 731
 732         CASE (BRgotoifnonnilelsepop):
 733           op = FETCH - 128;
 734           if (!NILP (TOP))
 735             goto op_relative_branch;
 736           DISCARD (1);
 737           NEXT;
 738
 739         CASE (Breturn):
 740           goto exit;
 741
 742         CASE (Bdiscard):
 743           DISCARD (1);
 744           NEXT;
 745
 746         CASE (Bconstant2):
 747           PUSH (vectorp[FETCH2]);
 748           NEXT;
 749
 750         CASE (Bsave_excursion):
 751           record_unwind_protect (save_excursion_restore,
 752                                  save_excursion_save ());
 753           NEXT;
 754
 755         CASE (Bsave_current_buffer): /* Obsolete since ??.  */
 756         CASE (Bsave_current_buffer_1):
 757           record_unwind_current_buffer ();
 758           NEXT;
 759
 760         CASE (Bsave_window_excursion): /* Obsolete since 24.1.  */
 761           {
 762             ptrdiff_t count1 = SPECPDL_INDEX ();
 763             record_unwind_protect (restore_window_configuration,
 764                                    Fcurrent_window_configuration (Qnil));
 765             TOP = Fprogn (TOP);
 766             unbind_to (count1, TOP);
 767             NEXT;
 768           }
 769
 770         CASE (Bsave_restriction):
 771           record_unwind_protect (save_restriction_restore,
 772                                  save_restriction_save ());
 773           NEXT;
 774
 775         CASE (Bcatch):          /* Obsolete since 24.4.  */
 776           {
 777             Lisp_Object v1 = POP;
 778             TOP = internal_catch (TOP, eval_sub, v1);
 779             NEXT;
 780           }
 781
 782         CASE (Bpushcatch):      /* New in 24.4.  */
 783           type = CATCHER;
 784           goto pushhandler;
 785         CASE (Bpushconditioncase): /* New in 24.4.  */
 786           type = CONDITION_CASE;
 787         pushhandler:
 788           {
 789             struct handler *c = push_handler (POP, type);
 790             c->bytecode_dest = FETCH2;
 791             c->bytecode_top = top;
 792
 793             if (sys_setjmp (c->jmp))
 794               {
 795                 struct handler *c = handlerlist;
 796                 top = c->bytecode_top;
 797                 op = c->bytecode_dest;
 798                 handlerlist = c->next;
 799                 PUSH (c->val);
 800                 goto op_branch;
 801               }
 802
 803             NEXT;
 804           }
 805
 806         CASE (Bpophandler):     /* New in 24.4.  */
 807           handlerlist = handlerlist->next;
 808           NEXT;
 809
 810         CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind.  */
 811           {
 812             Lisp_Object handler = POP;
 813             /* Support for a function here is new in 24.4.  */
 814             record_unwind_protect (FUNCTIONP (handler) ? bcall0 : prog_ignore,
 815                                    handler);
 816             NEXT;
 817           }
 818
 819         CASE (Bcondition_case):         /* Obsolete since 24.4.  */
 820           {
 821             Lisp_Object handlers = POP, body = POP;
 822             TOP = internal_lisp_condition_case (TOP, body, handlers);
 823             NEXT;
 824           }
 825
 826         CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1.  */
 827           CHECK_STRING (TOP);
 828           temp_output_buffer_setup (SSDATA (TOP));
 829           TOP = Vstandard_output;
 830           NEXT;
 831
 832         CASE (Btemp_output_buffer_show): /* Obsolete since 24.1.  */
 833           {
 834             Lisp_Object v1 = POP;
 835             temp_output_buffer_show (TOP);
 836             TOP = v1;
 837             /* pop binding of standard-output */
 838             unbind_to (SPECPDL_INDEX () - 1, Qnil);
 839             NEXT;
 840           }
 841
 842         CASE (Bnth):
 843           {
 844             Lisp_Object v2 = POP, v1 = TOP;
 845             CHECK_NUMBER (v1);
 846             for (EMACS_INT n = XINT (v1); 0 < n && CONSP (v2); n--)
 847               {
 848                 v2 = XCDR (v2);
 849                 rarely_quit (n);
 850               }
 851             TOP = CAR (v2);
 852             NEXT;
 853           }
 854
 855         CASE (Bsymbolp):
 856           TOP = SYMBOLP (TOP) ? Qt : Qnil;
 857           NEXT;
 858
 859         CASE (Bconsp):
 860           TOP = CONSP (TOP) ? Qt : Qnil;
 861           NEXT;
 862
 863         CASE (Bstringp):
 864           TOP = STRINGP (TOP) ? Qt : Qnil;
 865           NEXT;
 866
 867         CASE (Blistp):
 868           TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
 869           NEXT;
 870
 871         CASE (Bnot):
 872           TOP = NILP (TOP) ? Qt : Qnil;
 873           NEXT;
 874
 875         CASE (Bcons):
 876           {
 877             Lisp_Object v1 = POP;
 878             TOP = Fcons (TOP, v1);
 879             NEXT;
 880           }
 881
 882         CASE (Blist1):
 883           TOP = list1 (TOP);
 884           NEXT;
 885
 886         CASE (Blist2):
 887           {
 888             Lisp_Object v1 = POP;
 889             TOP = list2 (TOP, v1);
 890             NEXT;
 891           }
 892
 893         CASE (Blist3):
 894           DISCARD (2);
 895           TOP = Flist (3, &TOP);
 896           NEXT;
 897
 898         CASE (Blist4):
 899           DISCARD (3);
 900           TOP = Flist (4, &TOP);
 901           NEXT;
 902
 903         CASE (BlistN):
 904           op = FETCH;
 905           DISCARD (op - 1);
 906           TOP = Flist (op, &TOP);
 907           NEXT;
 908
 909         CASE (Blength):
 910           TOP = Flength (TOP);
 911           NEXT;
 912
 913         CASE (Baref):
 914           {
 915             Lisp_Object v1 = POP;
 916             TOP = Faref (TOP, v1);
 917             NEXT;
 918           }
 919
 920         CASE (Baset):
 921           {
 922             Lisp_Object v2 = POP, v1 = POP;
 923             TOP = Faset (TOP, v1, v2);
 924             NEXT;
 925           }
 926
 927         CASE (Bsymbol_value):
 928           TOP = Fsymbol_value (TOP);
 929           NEXT;
 930
 931         CASE (Bsymbol_function):
 932           TOP = Fsymbol_function (TOP);
 933           NEXT;
 934
 935         CASE (Bset):
 936           {
 937             Lisp_Object v1 = POP;
 938             TOP = Fset (TOP, v1);
 939             NEXT;
 940           }
 941
 942         CASE (Bfset):
 943           {
 944             Lisp_Object v1 = POP;
 945             TOP = Ffset (TOP, v1);
 946             NEXT;
 947           }
 948
 949         CASE (Bget):
 950           {
 951             Lisp_Object v1 = POP;
 952             TOP = Fget (TOP, v1);
 953             NEXT;
 954           }
 955
 956         CASE (Bsubstring):
 957           {
 958             Lisp_Object v2 = POP, v1 = POP;
 959             TOP = Fsubstring (TOP, v1, v2);
 960             NEXT;
 961           }
 962
 963         CASE (Bconcat2):
 964           DISCARD (1);
 965           TOP = Fconcat (2, &TOP);
 966           NEXT;
 967
 968         CASE (Bconcat3):
 969           DISCARD (2);
 970           TOP = Fconcat (3, &TOP);
 971           NEXT;
 972
 973         CASE (Bconcat4):
 974           DISCARD (3);
 975           TOP = Fconcat (4, &TOP);
 976           NEXT;
 977
 978         CASE (BconcatN):
 979           op = FETCH;
 980           DISCARD (op - 1);
 981           TOP = Fconcat (op, &TOP);
 982           NEXT;
 983
 984         CASE (Bsub1):
 985           TOP = INTEGERP (TOP) ? make_number (XINT (TOP) - 1) : Fsub1 (TOP);
 986           NEXT;
 987
 988         CASE (Badd1):
 989           TOP = INTEGERP (TOP) ? make_number (XINT (TOP) + 1) : Fadd1 (TOP);
 990           NEXT;
 991
 992         CASE (Beqlsign):
 993           {
 994             Lisp_Object v2 = POP, v1 = TOP;
 995             if (FLOATP (v1) || FLOATP (v2))
 996               TOP = arithcompare (v1, v2, ARITH_EQUAL);
 997             else
 998               {
 999                 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
1000                 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
1001                 TOP = EQ (v1, v2) ? Qt : Qnil;
1002               }
1003             NEXT;
1004           }
1005
1006         CASE (Bgtr):
1007           {
1008             Lisp_Object v1 = POP;
1009             TOP = arithcompare (TOP, v1, ARITH_GRTR);
1010             NEXT;
1011           }
1012
1013         CASE (Blss):
1014           {
1015             Lisp_Object v1 = POP;
1016             TOP = arithcompare (TOP, v1, ARITH_LESS);
1017             NEXT;
1018           }
1019
1020         CASE (Bleq):
1021           {
1022             Lisp_Object v1 = POP;
1023             TOP = arithcompare (TOP, v1, ARITH_LESS_OR_EQUAL);
1024             NEXT;
1025           }
1026
1027         CASE (Bgeq):
1028           {
1029             Lisp_Object v1 = POP;
1030             TOP = arithcompare (TOP, v1, ARITH_GRTR_OR_EQUAL);
1031             NEXT;
1032           }
1033
1034         CASE (Bdiff):
1035           DISCARD (1);
1036           TOP = Fminus (2, &TOP);
1037           NEXT;
1038
1039         CASE (Bnegate):
1040           TOP = INTEGERP (TOP) ? make_number (- XINT (TOP)) : Fminus (1, &TOP);
1041           NEXT;
1042
1043         CASE (Bplus):
1044           DISCARD (1);
1045           TOP = Fplus (2, &TOP);
1046           NEXT;
1047
1048         CASE (Bmax):
1049           DISCARD (1);
1050           TOP = Fmax (2, &TOP);
1051           NEXT;
1052
1053         CASE (Bmin):
1054           DISCARD (1);
1055           TOP = Fmin (2, &TOP);
1056           NEXT;
1057
1058         CASE (Bmult):
1059           DISCARD (1);
1060           TOP = Ftimes (2, &TOP);
1061           NEXT;
1062
1063         CASE (Bquo):
1064           DISCARD (1);
1065           TOP = Fquo (2, &TOP);
1066           NEXT;
1067
1068         CASE (Brem):
1069           {
1070             Lisp_Object v1 = POP;
1071             TOP = Frem (TOP, v1);
1072             NEXT;
1073           }
1074
1075         CASE (Bpoint):
1076           PUSH (make_natnum (PT));
1077           NEXT;
1078
1079         CASE (Bgoto_char):
1080           TOP = Fgoto_char (TOP);
1081           NEXT;
1082
1083         CASE (Binsert):
1084           TOP = Finsert (1, &TOP);
1085           NEXT;
1086
1087         CASE (BinsertN):
1088           op = FETCH;
1089           DISCARD (op - 1);
1090           TOP = Finsert (op, &TOP);
1091           NEXT;
1092
1093         CASE (Bpoint_max):
1094           {
1095             Lisp_Object v1;
1096             XSETFASTINT (v1, ZV);
1097             PUSH (v1);
1098             NEXT;
1099           }
1100
1101         CASE (Bpoint_min):
1102           PUSH (make_natnum (BEGV));
1103           NEXT;
1104
1105         CASE (Bchar_after):
1106           TOP = Fchar_after (TOP);
1107           NEXT;
1108
1109         CASE (Bfollowing_char):
1110           PUSH (Ffollowing_char ());
1111           NEXT;
1112
1113         CASE (Bpreceding_char):
1114           PUSH (Fprevious_char ());
1115           NEXT;
1116
1117         CASE (Bcurrent_column):
1118           PUSH (make_natnum (current_column ()));
1119           NEXT;
1120
1121         CASE (Bindent_to):
1122           TOP = Findent_to (TOP, Qnil);
1123           NEXT;
1124
1125         CASE (Beolp):
1126           PUSH (Feolp ());
1127           NEXT;
1128
1129         CASE (Beobp):
1130           PUSH (Feobp ());
1131           NEXT;
1132
1133         CASE (Bbolp):
1134           PUSH (Fbolp ());
1135           NEXT;
1136
1137         CASE (Bbobp):
1138           PUSH (Fbobp ());
1139           NEXT;
1140
1141         CASE (Bcurrent_buffer):
1142           PUSH (Fcurrent_buffer ());
1143           NEXT;
1144
1145         CASE (Bset_buffer):
1146           TOP = Fset_buffer (TOP);
1147           NEXT;
1148
1149         CASE (Binteractive_p):  /* Obsolete since 24.1.  */
1150           PUSH (call0 (intern ("interactive-p")));
1151           NEXT;
1152
1153         CASE (Bforward_char):
1154           TOP = Fforward_char (TOP);
1155           NEXT;
1156
1157         CASE (Bforward_word):
1158           TOP = Fforward_word (TOP);
1159           NEXT;
1160
1161         CASE (Bskip_chars_forward):
1162           {
1163             Lisp_Object v1 = POP;
1164             TOP = Fskip_chars_forward (TOP, v1);
1165             NEXT;
1166           }
1167
1168         CASE (Bskip_chars_backward):
1169           {
1170             Lisp_Object v1 = POP;
1171             TOP = Fskip_chars_backward (TOP, v1);
1172             NEXT;
1173           }
1174
1175         CASE (Bforward_line):
1176           TOP = Fforward_line (TOP);
1177           NEXT;
1178
1179         CASE (Bchar_syntax):
1180           {
1181             CHECK_CHARACTER (TOP);
1182             int c = XFASTINT (TOP);
1183             if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1184               MAKE_CHAR_MULTIBYTE (c);
1185             XSETFASTINT (TOP, syntax_code_spec[SYNTAX (c)]);
1186           }
1187           NEXT;
1188
1189         CASE (Bbuffer_substring):
1190           {
1191             Lisp_Object v1 = POP;
1192             TOP = Fbuffer_substring (TOP, v1);
1193             NEXT;
1194           }
1195
1196         CASE (Bdelete_region):
1197           {
1198             Lisp_Object v1 = POP;
1199             TOP = Fdelete_region (TOP, v1);
1200             NEXT;
1201           }
1202
1203         CASE (Bnarrow_to_region):
1204           {
1205             Lisp_Object v1 = POP;
1206             TOP = Fnarrow_to_region (TOP, v1);
1207             NEXT;
1208           }
1209
1210         CASE (Bwiden):
1211           PUSH (Fwiden ());
1212           NEXT;
1213
1214         CASE (Bend_of_line):
1215           TOP = Fend_of_line (TOP);
1216           NEXT;
1217
1218         CASE (Bset_marker):
1219           {
1220             Lisp_Object v2 = POP, v1 = POP;
1221             TOP = Fset_marker (TOP, v1, v2);
1222             NEXT;
1223           }
1224
1225         CASE (Bmatch_beginning):
1226           TOP = Fmatch_beginning (TOP);
1227           NEXT;
1228
1229         CASE (Bmatch_end):
1230           TOP = Fmatch_end (TOP);
1231           NEXT;
1232
1233         CASE (Bupcase):
1234           TOP = Fupcase (TOP);
1235           NEXT;
1236
1237         CASE (Bdowncase):
1238           TOP = Fdowncase (TOP);
1239           NEXT;
1240
1241         CASE (Bstringeqlsign):
1242           {
1243             Lisp_Object v1 = POP;
1244             TOP = Fstring_equal (TOP, v1);
1245             NEXT;
1246           }
1247
1248         CASE (Bstringlss):
1249           {
1250             Lisp_Object v1 = POP;
1251             TOP = Fstring_lessp (TOP, v1);
1252             NEXT;
1253           }
1254
1255         CASE (Bequal):
1256           {
1257             Lisp_Object v1 = POP;
1258             TOP = Fequal (TOP, v1);
1259             NEXT;
1260           }
1261
1262         CASE (Bnthcdr):
1263           {
1264             Lisp_Object v1 = POP;
1265             TOP = Fnthcdr (TOP, v1);
1266             NEXT;
1267           }
1268
1269         CASE (Belt):
1270           {
1271             if (CONSP (TOP))
1272               {
1273                 /* Exchange args and then do nth.  */
1274                 Lisp_Object v2 = POP, v1 = TOP;
1275                 CHECK_NUMBER (v2);
1276                 for (EMACS_INT n = XINT (v2); 0 < n && CONSP (v1); n--)
1277                   {
1278                     v1 = XCDR (v1);
1279                     rarely_quit (n);
1280                   }
1281                 TOP = CAR (v1);
1282               }
1283             else
1284               {
1285                 Lisp_Object v1 = POP;
1286                 TOP = Felt (TOP, v1);
1287               }
1288             NEXT;
1289           }
1290
1291         CASE (Bmember):
1292           {
1293             Lisp_Object v1 = POP;
1294             TOP = Fmember (TOP, v1);
1295             NEXT;
1296           }
1297
1298         CASE (Bassq):
1299           {
1300             Lisp_Object v1 = POP;
1301             TOP = Fassq (TOP, v1);
1302             NEXT;
1303           }
1304
1305         CASE (Bnreverse):
1306           TOP = Fnreverse (TOP);
1307           NEXT;
1308
1309         CASE (Bsetcar):
1310           {
1311             Lisp_Object v1 = POP;
1312             TOP = Fsetcar (TOP, v1);
1313             NEXT;
1314           }
1315
1316         CASE (Bsetcdr):
1317           {
1318             Lisp_Object v1 = POP;
1319             TOP = Fsetcdr (TOP, v1);
1320             NEXT;
1321           }
1322
1323         CASE (Bcar_safe):
1324           TOP = CAR_SAFE (TOP);
1325           NEXT;
1326
1327         CASE (Bcdr_safe):
1328           TOP = CDR_SAFE (TOP);
1329           NEXT;
1330
1331         CASE (Bnconc):
1332           DISCARD (1);
1333           TOP = Fnconc (2, &TOP);
1334           NEXT;
1335
1336         CASE (Bnumberp):
1337           TOP = NUMBERP (TOP) ? Qt : Qnil;
1338           NEXT;
1339
1340         CASE (Bintegerp):
1341           TOP = INTEGERP (TOP) ? Qt : Qnil;
1342           NEXT;
1343
1344 #if BYTE_CODE_SAFE
1345           /* These are intentionally written using 'case' syntax,
1346              because they are incompatible with the threaded
1347              interpreter.  */
1348
1349         case Bset_mark:
1350           error ("set-mark is an obsolete bytecode");
1351           break;
1352         case Bscan_buffer:
1353           error ("scan-buffer is an obsolete bytecode");
1354           break;
1355 #endif
1356
1357         CASE_ABORT:
1358           /* Actually this is Bstack_ref with offset 0, but we use Bdup
1359              for that instead.  */
1360           /* CASE (Bstack_ref): */
1361           call3 (Qerror,
1362                  build_string ("Invalid byte opcode: op=%s, ptr=%d"),
1363                  make_number (op),
1364                  make_number (pc - 1 - bytestr_data));
1365
1366           /* Handy byte-codes for lexical binding.  */
1367         CASE (Bstack_ref1):
1368         CASE (Bstack_ref2):
1369         CASE (Bstack_ref3):
1370         CASE (Bstack_ref4):
1371         CASE (Bstack_ref5):
1372           {
1373             Lisp_Object v1 = top[Bstack_ref - op];
1374             PUSH (v1);
1375             NEXT;
1376           }
1377         CASE (Bstack_ref6):
1378           {
1379             Lisp_Object v1 = top[- FETCH];
1380             PUSH (v1);
1381             NEXT;
1382           }
1383         CASE (Bstack_ref7):
1384           {
1385             Lisp_Object v1 = top[- FETCH2];
1386             PUSH (v1);
1387             NEXT;
1388           }
1389         CASE (Bstack_set):
1390           /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos.  */
1391           {
1392             Lisp_Object *ptr = top - FETCH;
1393             *ptr = POP;
1394             NEXT;
1395           }
1396         CASE (Bstack_set2):
1397           {
1398             Lisp_Object *ptr = top - FETCH2;
1399             *ptr = POP;
1400             NEXT;
1401           }
1402         CASE (BdiscardN):
1403           op = FETCH;
1404           if (op & 0x80)
1405             {
1406               op &= 0x7F;
1407               top[-op] = TOP;
1408             }
1409           DISCARD (op);
1410           NEXT;
1411
1412         CASE (Bswitch):
1413           {
1414             /* TODO: Perhaps introduce another byte-code for switch when the
1415                number of cases is less, which uses a simple vector for linear
1416                search as the jump table.  */
1417             Lisp_Object jmp_table = POP;
1418             if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table))
1419               emacs_abort ();
1420             Lisp_Object v1 = POP;
1421             ptrdiff_t i;
1422             struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table);
1423
1424             /* h->count is a faster approximation for HASH_TABLE_SIZE (h)
1425                here. */
1426             if (h->count <= 5)
1427               { /* Do a linear search if there are not many cases
1428                    FIXME: 5 is arbitrarily chosen.  */
1429                 Lisp_Object hash_code = h->test.cmpfn
1430                   ? make_number (h->test.hashfn (&h->test, v1)) : Qnil;
1431
1432                 for (i = h->count; 0 <= --i; )
1433                   if (EQ (v1, HASH_KEY (h, i))
1434                       || (h->test.cmpfn
1435                           && EQ (hash_code, HASH_HASH (h, i))
1436                           && h->test.cmpfn (&h->test, v1, HASH_KEY (h, i))))
1437                     break;
1438
1439               }
1440             else
1441               i = hash_lookup (h, v1, NULL);
1442
1443             if (i >= 0)
1444               {
1445                 Lisp_Object val = HASH_VALUE (h, i);
1446                 if (BYTE_CODE_SAFE && !INTEGERP (val))
1447                   emacs_abort ();
1448                 op = XINT (val);
1449                 goto op_branch;
1450               }
1451           }
1452           NEXT;
1453
1454         CASE_DEFAULT
1455         CASE (Bconstant):
1456           if (BYTE_CODE_SAFE
1457               && ! (Bconstant <= op && op < Bconstant + const_length))
1458             emacs_abort ();
1459           PUSH (vectorp[op - Bconstant]);
1460           NEXT;
1461         }
1462     }
1463
1464  exit:
1465
1466   /* Binds and unbinds are supposed to be compiled balanced.  */
1467   if (SPECPDL_INDEX () != count)
1468     {
1469       if (SPECPDL_INDEX () > count)
1470         unbind_to (count, Qnil);
1471       error ("binding stack not balanced (serious byte compiler bug)");
1472     }
1473
1474   Lisp_Object result = TOP;
1475   SAFE_FREE ();
1476   return result;
1477 }
1478
1479 /* `args_template' has the same meaning as in exec_byte_code() above.  */
1480 Lisp_Object
1481 get_byte_code_arity (Lisp_Object args_template)
1482 {
1483   eassert (NATNUMP (args_template));
1484   EMACS_INT at = XINT (args_template);
1485   bool rest = (at & 128) != 0;
1486   int mandatory = at & 127;
1487   EMACS_INT nonrest = at >> 8;
1488
1489   return Fcons (make_number (mandatory),
1490                 rest ? Qmany : make_number (nonrest));
1491 }
1492
1493 void
1494 syms_of_bytecode (void)
1495 {
1496   defsubr (&Sbyte_code);
1497
1498 #ifdef BYTE_CODE_METER
1499
1500   DEFVAR_LISP ("byte-code-meter", Vbyte_code_meter,
1501                doc: /* A vector of vectors which holds a histogram of byte-code usage.
1502 \(aref (aref byte-code-meter 0) CODE) indicates how many times the byte
1503 opcode CODE has been executed.
1504 \(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
1505 indicates how many times the byte opcodes CODE1 and CODE2 have been
1506 executed in succession.  */);
1507
1508   DEFVAR_BOOL ("byte-metering-on", byte_metering_on,
1509                doc: /* If non-nil, keep profiling information on byte code usage.
1510 The variable byte-code-meter indicates how often each byte opcode is used.
1511 If a symbol has a property named `byte-code-meter' whose value is an
1512 integer, it is incremented each time that symbol's function is called.  */);
1513
1514   byte_metering_on = false;
1515   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
1516   DEFSYM (Qbyte_code_meter, "byte-code-meter");
1517   {
1518     int i = 256;
1519     while (i--)
1520       ASET (Vbyte_code_meter, i,
1521            Fmake_vector (make_number (256), make_number (0)));
1522   }
1523 #endif
1524 }