root/src/bytecode.c

DEFINITIONS

1. bcall0
2. init_bc_thread
3. free_bc_thread
4. mark_bytecode
5. DEFUN
6. valid_sp
7. exec_byte_code
8. get_byte_code_arity
9. syms_of_bytecode

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