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