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