src/bytecode.c

/* [<][>][^][v][top][bottom][index][help] */
This source file includes following definitions.
bcall0
init_bc_thread
free_bc_thread
mark_bytecode
DEFUN
valid_sp
exec_byte_code
get_byte_code_arity
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             wrong_type_argument (Qlistp, TOP);
   650           NEXT;
   651 
   652         CASE (Beq):
   653           {
   654             Lisp_Object v1 = POP;
   655             TOP = EQ (v1, TOP) ? Qt : Qnil;
   656             NEXT;
   657           }
   658 
   659         CASE (Bmemq):
   660           {
   661             Lisp_Object v1 = POP;
   662             TOP = Fmemq (TOP, v1);
   663             NEXT;
   664           }
   665 
   666         CASE (Bcdr):
   667           {
   668             if (CONSP (TOP))
   669               TOP = XCDR (TOP);
   670             else if (!NILP (TOP))
   671               wrong_type_argument (Qlistp, TOP);
   672             NEXT;
   673           }
   674 
   675         CASE (Bvarset):
   676         CASE (Bvarset1):
   677         CASE (Bvarset2):
   678         CASE (Bvarset3):
   679         CASE (Bvarset4):
   680         CASE (Bvarset5):
   681           op -= Bvarset;
   682           goto varset;
   683 
   684         CASE (Bvarset7):
   685           op = FETCH2;
   686           goto varset;
   687 
   688         CASE (Bvarset6):
   689           op = FETCH;
   690         varset:
   691           {
   692             Lisp_Object sym = vectorp[op];
   693             Lisp_Object val = POP;
   694 
   695             /* Inline the most common case.  */
   696             if (SYMBOLP (sym)
   697                 && !BASE_EQ (val, Qunbound)
   698                 && XSYMBOL (sym)->u.s.redirect == SYMBOL_PLAINVAL
   699                 && !SYMBOL_TRAPPED_WRITE_P (sym))
   700               SET_SYMBOL_VAL (XSYMBOL (sym), val);
   701             else
   702               set_internal (sym, val, Qnil, SET_INTERNAL_SET);
   703           }
   704           NEXT;
   705 
   706         CASE (Bdup):
   707           {
   708             Lisp_Object v1 = TOP;
   709             PUSH (v1);
   710             NEXT;
   711           }
   712 
   713         /* ------------------ */
   714 
   715         CASE (Bvarbind6):
   716           op = FETCH;
   717           goto varbind;
   718 
   719         CASE (Bvarbind7):
   720           op = FETCH2;
   721           goto varbind;
   722 
   723         CASE (Bvarbind):
   724         CASE (Bvarbind1):
   725         CASE (Bvarbind2):
   726         CASE (Bvarbind3):
   727         CASE (Bvarbind4):
   728         CASE (Bvarbind5):
   729           op -= Bvarbind;
   730         varbind:
   731           /* Specbind can signal and thus GC.  */
   732           specbind (vectorp[op], POP);
   733           NEXT;
   734 
   735         CASE (Bcall6):
   736           op = FETCH;
   737           goto docall;
   738 
   739         CASE (Bcall7):
   740           op = FETCH2;
   741           goto docall;
   742 
   743         CASE (Bcall):
   744         CASE (Bcall1):
   745         CASE (Bcall2):
   746         CASE (Bcall3):
   747         CASE (Bcall4):
   748         CASE (Bcall5):
   749           op -= Bcall;
   750         docall:
   751           {
   752             DISCARD (op);
   753 #ifdef BYTE_CODE_METER
   754             if (byte_metering_on && SYMBOLP (TOP))
   755               {
   756                 Lisp_Object v1 = TOP;
   757                 Lisp_Object v2 = Fget (v1, Qbyte_code_meter);
   758                 if (FIXNUMP (v2)
   759                     && XFIXNUM (v2) < MOST_POSITIVE_FIXNUM)
   760                   {
   761                     XSETINT (v2, XFIXNUM (v2) + 1);
   762                     Fput (v1, Qbyte_code_meter, v2);
   763                   }
   764               }
   765 #endif
   766             maybe_quit ();
   767 
   768             if (++lisp_eval_depth > max_lisp_eval_depth)
   769               {
   770                 if (max_lisp_eval_depth < 100)
   771                   max_lisp_eval_depth = 100;
   772                 if (lisp_eval_depth > max_lisp_eval_depth)
   773                   error ("Lisp nesting exceeds `max-lisp-eval-depth'");
   774               }
   775 
   776             ptrdiff_t call_nargs = op;
   777             Lisp_Object call_fun = TOP;
   778             Lisp_Object *call_args = &TOP + 1;
   779 
   780             specpdl_ref count1 = record_in_backtrace (call_fun,
   781                                                       call_args, call_nargs);
   782             maybe_gc ();
   783             if (debug_on_next_call)
   784               do_debug_on_call (Qlambda, count1);
   785 
   786             Lisp_Object original_fun = call_fun;
   787             if (SYMBOLP (call_fun))
   788               call_fun = XSYMBOL (call_fun)->u.s.function;
   789             Lisp_Object template;
   790             Lisp_Object bytecode;
   791             if (COMPILEDP (call_fun)
   792                 /* Lexical binding only.  */
   793                 && (template = AREF (call_fun, COMPILED_ARGLIST),
   794                     FIXNUMP (template))
   795                 /* No autoloads.  */
   796                 && (bytecode = AREF (call_fun, COMPILED_BYTECODE),
   797                     !CONSP (bytecode)))
   798               {
   799                 fun = call_fun;
   800                 bytestr = bytecode;
   801                 args_template = XFIXNUM (template);
   802                 nargs = call_nargs;
   803                 args = call_args;
   804                 goto setup_frame;
   805               }
   806 
   807             Lisp_Object val;
   808             if (SUBRP (call_fun) && !SUBR_NATIVE_COMPILED_DYNP (call_fun))
   809               val = funcall_subr (XSUBR (call_fun), call_nargs, call_args);
   810             else
   811               val = funcall_general (original_fun, call_nargs, call_args);
   812 
   813             lisp_eval_depth--;
   814             if (backtrace_debug_on_exit (specpdl_ptr - 1))
   815               val = call_debugger (list2 (Qexit, val));
   816             specpdl_ptr--;
   817 
   818             TOP = val;
   819             NEXT;
   820           }
   821 
   822         CASE (Bunbind6):
   823           op = FETCH;
   824           goto dounbind;
   825 
   826         CASE (Bunbind7):
   827           op = FETCH2;
   828           goto dounbind;
   829 
   830         CASE (Bunbind):
   831         CASE (Bunbind1):
   832         CASE (Bunbind2):
   833         CASE (Bunbind3):
   834         CASE (Bunbind4):
   835         CASE (Bunbind5):
   836           op -= Bunbind;
   837         dounbind:
   838           unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -op), Qnil);
   839           NEXT;
   840 
   841         CASE (Bgoto):
   842           op = FETCH2;
   843         op_branch:
   844           op -= pc - bytestr_data;
   845           if (BYTE_CODE_SAFE
   846               && ! (bytestr_data - pc <= op
   847                     && op < bytestr_data + bytestr_length - pc))
   848             emacs_abort ();
   849           quitcounter += op < 0;
   850           if (!quitcounter)
   851             {
   852               quitcounter = 1;
   853               maybe_gc ();
   854               maybe_quit ();
   855             }
   856           pc += op;
   857           NEXT;
   858 
   859         CASE (Bgotoifnonnil):
   860           op = FETCH2;
   861           if (!NILP (POP))
   862             goto op_branch;
   863           NEXT;
   864 
   865         CASE (Bgotoifnilelsepop):
   866           op = FETCH2;
   867           if (NILP (TOP))
   868             goto op_branch;
   869           DISCARD (1);
   870           NEXT;
   871 
   872         CASE (Bgotoifnonnilelsepop):
   873           op = FETCH2;
   874           if (!NILP (TOP))
   875             goto op_branch;
   876           DISCARD (1);
   877           NEXT;
   878 
   879         CASE (Breturn):
   880           {
   881             Lisp_Object *saved_top = bc->fp->saved_top;
   882             if (saved_top)
   883               {
   884                 Lisp_Object val = TOP;
   885 
   886                 lisp_eval_depth--;
   887                 if (backtrace_debug_on_exit (specpdl_ptr - 1))
   888                   val = call_debugger (list2 (Qexit, val));
   889                 specpdl_ptr--;
   890 
   891                 top = saved_top;
   892                 pc = bc->fp->saved_pc;
   893                 struct bc_frame *fp = bc->fp->saved_fp;
   894                 bc->fp = fp;
   895 
   896                 Lisp_Object fun = fp->fun;
   897                 Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE);
   898                 Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS);
   899                 bytestr_data = SDATA (bytestr);
   900                 vectorp = XVECTOR (vector)->contents;
   901                 if (BYTE_CODE_SAFE)
   902                   {
   903                     /* Only required for checking, not for execution.  */
   904                     const_length = ASIZE (vector);
   905                     bytestr_length = SCHARS (bytestr);
   906                   }
   907 
   908                 TOP = val;
   909                 NEXT;
   910               }
   911             else
   912               goto exit;
   913           }
   914 
   915         CASE (Bdiscard):
   916           DISCARD (1);
   917           NEXT;
   918 
   919         CASE (Bconstant2):
   920           PUSH (vectorp[FETCH2]);
   921           NEXT;
   922 
   923         CASE (Bsave_excursion):
   924           record_unwind_protect_excursion ();
   925           NEXT;
   926 
   927         CASE (Bsave_current_buffer_OBSOLETE): /* Obsolete since 20.  */
   928         CASE (Bsave_current_buffer):
   929           record_unwind_current_buffer ();
   930           NEXT;
   931 
   932         CASE (Bsave_window_excursion): /* Obsolete since 24.1.  */
   933           {
   934             specpdl_ref count1 = SPECPDL_INDEX ();
   935             record_unwind_protect (restore_window_configuration,
   936                                    Fcurrent_window_configuration (Qnil));
   937             TOP = Fprogn (TOP);
   938             unbind_to (count1, TOP);
   939             NEXT;
   940           }
   941 
   942         CASE (Bsave_restriction):
   943           record_unwind_protect (save_restriction_restore,
   944                                  save_restriction_save ());
   945           NEXT;
   946 
   947         CASE (Bcatch):          /* Obsolete since 25.  */
   948           {
   949             Lisp_Object v1 = POP;
   950             TOP = internal_catch (TOP, eval_sub, v1);
   951             NEXT;
   952           }
   953 
   954         CASE (Bpushcatch):      /* New in 24.4.  */
   955           type = CATCHER;
   956           goto pushhandler;
   957         CASE (Bpushconditioncase): /* New in 24.4.  */
   958           type = CONDITION_CASE;
   959         pushhandler:
   960           {
   961             struct handler *c = push_handler (POP, type);
   962             c->bytecode_dest = FETCH2;
   963             c->bytecode_top = top;
   964 
   965             if (sys_setjmp (c->jmp))
   966               {
   967                 struct handler *c = handlerlist;
   968                 handlerlist = c->next;
   969                 top = c->bytecode_top;
   970                 op = c->bytecode_dest;
   971                 struct bc_frame *fp = bc->fp;
   972 
   973                 Lisp_Object fun = fp->fun;
   974                 Lisp_Object bytestr = AREF (fun, COMPILED_BYTECODE);
   975                 Lisp_Object vector = AREF (fun, COMPILED_CONSTANTS);
   976                 bytestr_data = SDATA (bytestr);
   977                 vectorp = XVECTOR (vector)->contents;
   978                 if (BYTE_CODE_SAFE)
   979                   {
   980                     /* Only required for checking, not for execution.  */
   981                     const_length = ASIZE (vector);
   982                     bytestr_length = SCHARS (bytestr);
   983                   }
   984                 pc = bytestr_data;
   985                 PUSH (c->val);
   986                 goto op_branch;
   987               }
   988 
   989             NEXT;
   990           }
   991 
   992         CASE (Bpophandler):     /* New in 24.4.  */
   993           handlerlist = handlerlist->next;
   994           NEXT;
   995 
   996         CASE (Bunwind_protect): /* FIXME: avoid closure for lexbind.  */
   997           {
   998             Lisp_Object handler = POP;
   999             /* Support for a function here is new in 24.4.  */
  1000             record_unwind_protect (FUNCTIONP (handler) ? bcall0 : prog_ignore,
  1001                                    handler);
  1002             NEXT;
  1003           }
  1004 
  1005         CASE (Bcondition_case):         /* Obsolete since 25.  */
  1006           {
  1007             Lisp_Object handlers = POP, body = POP;
  1008             TOP = internal_lisp_condition_case (TOP, body, handlers);
  1009             NEXT;
  1010           }
  1011 
  1012         CASE (Btemp_output_buffer_setup): /* Obsolete since 24.1.  */
  1013           CHECK_STRING (TOP);
  1014           temp_output_buffer_setup (SSDATA (TOP));
  1015           TOP = Vstandard_output;
  1016           NEXT;
  1017 
  1018         CASE (Btemp_output_buffer_show): /* Obsolete since 24.1.  */
  1019           {
  1020             Lisp_Object v1 = POP;
  1021             temp_output_buffer_show (TOP);
  1022             TOP = v1;
  1023             /* pop binding of standard-output */
  1024             unbind_to (specpdl_ref_add (SPECPDL_INDEX (), -1), Qnil);
  1025             NEXT;
  1026           }
  1027 
  1028         CASE (Bnth):
  1029           {
  1030             Lisp_Object v2 = POP, v1 = TOP;
  1031             if (RANGED_FIXNUMP (0, v1, SMALL_LIST_LEN_MAX))
  1032               {
  1033                 for (EMACS_INT n = XFIXNUM (v1); 0 < n && CONSP (v2); n--)
  1034                   v2 = XCDR (v2);
  1035                 TOP = CAR (v2);
  1036               }
  1037             else
  1038               TOP = Fnth (v1, v2);
  1039             NEXT;
  1040           }
  1041 
  1042         CASE (Bsymbolp):
  1043           TOP = SYMBOLP (TOP) ? Qt : Qnil;
  1044           NEXT;
  1045 
  1046         CASE (Bconsp):
  1047           TOP = CONSP (TOP) ? Qt : Qnil;
  1048           NEXT;
  1049 
  1050         CASE (Bstringp):
  1051           TOP = STRINGP (TOP) ? Qt : Qnil;
  1052           NEXT;
  1053 
  1054         CASE (Blistp):
  1055           TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
  1056           NEXT;
  1057 
  1058         CASE (Bnot):
  1059           TOP = NILP (TOP) ? Qt : Qnil;
  1060           NEXT;
  1061 
  1062         CASE (Bcons):
  1063           {
  1064             Lisp_Object v1 = POP;
  1065             TOP = Fcons (TOP, v1);
  1066             NEXT;
  1067           }
  1068 
  1069         CASE (Blist1):
  1070           TOP = list1 (TOP);
  1071           NEXT;
  1072 
  1073         CASE (Blist2):
  1074           {
  1075             Lisp_Object v1 = POP;
  1076             TOP = list2 (TOP, v1);
  1077             NEXT;
  1078           }
  1079 
  1080         CASE (Blist3):
  1081           DISCARD (2);
  1082           TOP = list3 (TOP, top[1], top[2]);
  1083           NEXT;
  1084 
  1085         CASE (Blist4):
  1086           DISCARD (3);
  1087           TOP = list4 (TOP, top[1], top[2], top[3]);
  1088           NEXT;
  1089 
  1090         CASE (BlistN):
  1091           op = FETCH;
  1092           DISCARD (op - 1);
  1093           TOP = Flist (op, &TOP);
  1094           NEXT;
  1095 
  1096         CASE (Blength):
  1097           TOP = Flength (TOP);
  1098           NEXT;
  1099 
  1100         CASE (Baref):
  1101           {
  1102             Lisp_Object idxval = POP;
  1103             Lisp_Object arrayval = TOP;
  1104             ptrdiff_t size;
  1105             ptrdiff_t idx;
  1106             if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true))
  1107                  || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true)))
  1108                 && FIXNUMP (idxval)
  1109                 && (idx = XFIXNUM (idxval),
  1110                     idx >= 0 && idx < size))
  1111               TOP = AREF (arrayval, idx);
  1112             else
  1113               TOP = Faref (arrayval, idxval);
  1114             NEXT;
  1115           }
  1116 
  1117         CASE (Baset):
  1118           {
  1119             Lisp_Object newelt = POP;
  1120             Lisp_Object idxval = POP;
  1121             Lisp_Object arrayval = TOP;
  1122             ptrdiff_t size;
  1123             ptrdiff_t idx;
  1124             if (((VECTORP (arrayval) && (size = ASIZE (arrayval), true))
  1125                  || (RECORDP (arrayval) && (size = PVSIZE (arrayval), true)))
  1126                 && FIXNUMP (idxval)
  1127                 && (idx = XFIXNUM (idxval),
  1128                     idx >= 0 && idx < size))
  1129               {
  1130                 ASET (arrayval, idx, newelt);
  1131                 TOP = newelt;
  1132               }
  1133             else
  1134               TOP = Faset (arrayval, idxval, newelt);
  1135             NEXT;
  1136           }
  1137 
  1138         CASE (Bsymbol_value):
  1139           TOP = Fsymbol_value (TOP);
  1140           NEXT;
  1141 
  1142         CASE (Bsymbol_function):
  1143           TOP = Fsymbol_function (TOP);
  1144           NEXT;
  1145 
  1146         CASE (Bset):
  1147           {
  1148             Lisp_Object v1 = POP;
  1149             TOP = Fset (TOP, v1);
  1150             NEXT;
  1151           }
  1152 
  1153         CASE (Bfset):
  1154           {
  1155             Lisp_Object v1 = POP;
  1156             TOP = Ffset (TOP, v1);
  1157             NEXT;
  1158           }
  1159 
  1160         CASE (Bget):
  1161           {
  1162             Lisp_Object v1 = POP;
  1163             TOP = Fget (TOP, v1);
  1164             NEXT;
  1165           }
  1166 
  1167         CASE (Bsubstring):
  1168           {
  1169             Lisp_Object v2 = POP, v1 = POP;
  1170             TOP = Fsubstring (TOP, v1, v2);
  1171             NEXT;
  1172           }
  1173 
  1174         CASE (Bconcat2):
  1175           DISCARD (1);
  1176           TOP = Fconcat (2, &TOP);
  1177           NEXT;
  1178 
  1179         CASE (Bconcat3):
  1180           DISCARD (2);
  1181           TOP = Fconcat (3, &TOP);
  1182           NEXT;
  1183 
  1184         CASE (Bconcat4):
  1185           DISCARD (3);
  1186           TOP = Fconcat (4, &TOP);
  1187           NEXT;
  1188 
  1189         CASE (BconcatN):
  1190           op = FETCH;
  1191           DISCARD (op - 1);
  1192           TOP = Fconcat (op, &TOP);
  1193           NEXT;
  1194 
  1195         CASE (Bsub1):
  1196           TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM
  1197                  ? make_fixnum (XFIXNUM (TOP) - 1)
  1198                  : Fsub1 (TOP));
  1199           NEXT;
  1200 
  1201         CASE (Badd1):
  1202           TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_POSITIVE_FIXNUM
  1203                  ? make_fixnum (XFIXNUM (TOP) + 1)
  1204                  : Fadd1 (TOP));
  1205           NEXT;
  1206 
  1207         CASE (Beqlsign):
  1208           {
  1209             Lisp_Object v2 = POP;
  1210             Lisp_Object v1 = TOP;
  1211             if (FIXNUMP (v1) && FIXNUMP (v2))
  1212               TOP = BASE_EQ (v1, v2) ? Qt : Qnil;
  1213             else
  1214               TOP = arithcompare (v1, v2, ARITH_EQUAL);
  1215             NEXT;
  1216           }
  1217 
  1218         CASE (Bgtr):
  1219           {
  1220             Lisp_Object v2 = POP;
  1221             Lisp_Object v1 = TOP;
  1222             if (FIXNUMP (v1) && FIXNUMP (v2))
  1223               TOP = XFIXNUM (v1) > XFIXNUM (v2) ? Qt : Qnil;
  1224             else
  1225               TOP = arithcompare (v1, v2, ARITH_GRTR);
  1226             NEXT;
  1227           }
  1228 
  1229         CASE (Blss):
  1230           {
  1231             Lisp_Object v2 = POP;
  1232             Lisp_Object v1 = TOP;
  1233             if (FIXNUMP (v1) && FIXNUMP (v2))
  1234               TOP = XFIXNUM (v1) < XFIXNUM (v2) ? Qt : Qnil;
  1235             else
  1236               TOP = arithcompare (v1, v2, ARITH_LESS);
  1237             NEXT;
  1238           }
  1239 
  1240         CASE (Bleq):
  1241           {
  1242             Lisp_Object v2 = POP;
  1243             Lisp_Object v1 = TOP;
  1244             if (FIXNUMP (v1) && FIXNUMP (v2))
  1245               TOP = XFIXNUM (v1) <= XFIXNUM (v2) ? Qt : Qnil;
  1246             else
  1247               TOP = arithcompare (v1, v2, ARITH_LESS_OR_EQUAL);
  1248             NEXT;
  1249           }
  1250 
  1251         CASE (Bgeq):
  1252           {
  1253             Lisp_Object v2 = POP;
  1254             Lisp_Object v1 = TOP;
  1255             if (FIXNUMP (v1) && FIXNUMP (v2))
  1256               TOP = XFIXNUM (v1) >= XFIXNUM (v2) ? Qt : Qnil;
  1257             else
  1258               TOP = arithcompare (v1, v2, ARITH_GRTR_OR_EQUAL);
  1259             NEXT;
  1260           }
  1261 
  1262         CASE (Bdiff):
  1263           {
  1264             Lisp_Object v2 = POP;
  1265             Lisp_Object v1 = TOP;
  1266             EMACS_INT res;
  1267             if (FIXNUMP (v1) && FIXNUMP (v2)
  1268                 && (res = XFIXNUM (v1) - XFIXNUM (v2),
  1269                     !FIXNUM_OVERFLOW_P (res)))
  1270               TOP = make_fixnum (res);
  1271             else
  1272               TOP = Fminus (2, &TOP);
  1273             NEXT;
  1274           }
  1275 
  1276         CASE (Bnegate):
  1277           TOP = (FIXNUMP (TOP) && XFIXNUM (TOP) != MOST_NEGATIVE_FIXNUM
  1278                  ? make_fixnum (- XFIXNUM (TOP))
  1279                  : Fminus (1, &TOP));
  1280           NEXT;
  1281 
  1282         CASE (Bplus):
  1283           {
  1284             Lisp_Object v2 = POP;
  1285             Lisp_Object v1 = TOP;
  1286             EMACS_INT res;
  1287             if (FIXNUMP (v1) && FIXNUMP (v2)
  1288                 && (res = XFIXNUM (v1) + XFIXNUM (v2),
  1289                     !FIXNUM_OVERFLOW_P (res)))
  1290               TOP = make_fixnum (res);
  1291             else
  1292               TOP = Fplus (2, &TOP);
  1293             NEXT;
  1294           }
  1295 
  1296         CASE (Bmax):
  1297           {
  1298             Lisp_Object v2 = POP;
  1299             Lisp_Object v1 = TOP;
  1300             if (FIXNUMP (v1) && FIXNUMP (v2))
  1301               {
  1302                 if (XFIXNUM (v2) > XFIXNUM (v1))
  1303                   TOP = v2;
  1304               }
  1305             else
  1306               TOP = Fmax (2, &TOP);
  1307             NEXT;
  1308           }
  1309 
  1310         CASE (Bmin):
  1311           {
  1312             Lisp_Object v2 = POP;
  1313             Lisp_Object v1 = TOP;
  1314             if (FIXNUMP (v1) && FIXNUMP (v2))
  1315               {
  1316                 if (XFIXNUM (v2) < XFIXNUM (v1))
  1317                   TOP = v2;
  1318               }
  1319             else
  1320               TOP = Fmin (2, &TOP);
  1321             NEXT;
  1322           }
  1323 
  1324         CASE (Bmult):
  1325           {
  1326             Lisp_Object v2 = POP;
  1327             Lisp_Object v1 = TOP;
  1328             intmax_t res;
  1329             if (FIXNUMP (v1) && FIXNUMP (v2)
  1330                 && !INT_MULTIPLY_WRAPV (XFIXNUM (v1), XFIXNUM (v2), &res)
  1331                 && !FIXNUM_OVERFLOW_P (res))
  1332               TOP = make_fixnum (res);
  1333             else
  1334               TOP = Ftimes (2, &TOP);
  1335             NEXT;
  1336           }
  1337 
  1338         CASE (Bquo):
  1339           {
  1340             Lisp_Object v2 = POP;
  1341             Lisp_Object v1 = TOP;
  1342             EMACS_INT res;
  1343             if (FIXNUMP (v1) && FIXNUMP (v2) && XFIXNUM (v2) != 0
  1344                 && (res = XFIXNUM (v1) / XFIXNUM (v2),
  1345                     !FIXNUM_OVERFLOW_P (res)))
  1346               TOP = make_fixnum (res);
  1347             else
  1348               TOP = Fquo (2, &TOP);
  1349             NEXT;
  1350           }
  1351 
  1352         CASE (Brem):
  1353           {
  1354             Lisp_Object v2 = POP;
  1355             Lisp_Object v1 = TOP;
  1356             if (FIXNUMP (v1) && FIXNUMP (v2) && XFIXNUM (v2) != 0)
  1357               TOP = make_fixnum (XFIXNUM (v1) % XFIXNUM (v2));
  1358             else
  1359               TOP = Frem (v1, v2);
  1360             NEXT;
  1361           }
  1362 
  1363         CASE (Bpoint):
  1364           PUSH (make_fixed_natnum (PT));
  1365           NEXT;
  1366 
  1367         CASE (Bgoto_char):
  1368           TOP = Fgoto_char (TOP);
  1369           NEXT;
  1370 
  1371         CASE (Binsert):
  1372           TOP = Finsert (1, &TOP);
  1373           NEXT;
  1374 
  1375         CASE (BinsertN):
  1376           op = FETCH;
  1377           DISCARD (op - 1);
  1378           TOP = Finsert (op, &TOP);
  1379           NEXT;
  1380 
  1381         CASE (Bpoint_max):
  1382           PUSH (make_fixed_natnum (ZV));
  1383           NEXT;
  1384 
  1385         CASE (Bpoint_min):
  1386           PUSH (make_fixed_natnum (BEGV));
  1387           NEXT;
  1388 
  1389         CASE (Bchar_after):
  1390           TOP = Fchar_after (TOP);
  1391           NEXT;
  1392 
  1393         CASE (Bfollowing_char):
  1394           PUSH (Ffollowing_char ());
  1395           NEXT;
  1396 
  1397         CASE (Bpreceding_char):
  1398           PUSH (Fprevious_char ());
  1399           NEXT;
  1400 
  1401         CASE (Bcurrent_column):
  1402           PUSH (make_fixed_natnum (current_column ()));
  1403           NEXT;
  1404 
  1405         CASE (Bindent_to):
  1406           TOP = Findent_to (TOP, Qnil);
  1407           NEXT;
  1408 
  1409         CASE (Beolp):
  1410           PUSH (Feolp ());
  1411           NEXT;
  1412 
  1413         CASE (Beobp):
  1414           PUSH (Feobp ());
  1415           NEXT;
  1416 
  1417         CASE (Bbolp):
  1418           PUSH (Fbolp ());
  1419           NEXT;
  1420 
  1421         CASE (Bbobp):
  1422           PUSH (Fbobp ());
  1423           NEXT;
  1424 
  1425         CASE (Bcurrent_buffer):
  1426           PUSH (Fcurrent_buffer ());
  1427           NEXT;
  1428 
  1429         CASE (Bset_buffer):
  1430           TOP = Fset_buffer (TOP);
  1431           NEXT;
  1432 
  1433         CASE (Binteractive_p):  /* Obsolete since 24.1.  */
  1434           PUSH (call0 (Qinteractive_p));
  1435           NEXT;
  1436 
  1437         CASE (Bforward_char):
  1438           TOP = Fforward_char (TOP);
  1439           NEXT;
  1440 
  1441         CASE (Bforward_word):
  1442           TOP = Fforward_word (TOP);
  1443           NEXT;
  1444 
  1445         CASE (Bskip_chars_forward):
  1446           {
  1447             Lisp_Object v1 = POP;
  1448             TOP = Fskip_chars_forward (TOP, v1);
  1449             NEXT;
  1450           }
  1451 
  1452         CASE (Bskip_chars_backward):
  1453           {
  1454             Lisp_Object v1 = POP;
  1455             TOP = Fskip_chars_backward (TOP, v1);
  1456             NEXT;
  1457           }
  1458 
  1459         CASE (Bforward_line):
  1460           TOP = Fforward_line (TOP);
  1461           NEXT;
  1462 
  1463         CASE (Bchar_syntax):
  1464           TOP = Fchar_syntax (TOP);
  1465           NEXT;
  1466 
  1467         CASE (Bbuffer_substring):
  1468           {
  1469             Lisp_Object v1 = POP;
  1470             TOP = Fbuffer_substring (TOP, v1);
  1471             NEXT;
  1472           }
  1473 
  1474         CASE (Bdelete_region):
  1475           {
  1476             Lisp_Object v1 = POP;
  1477             TOP = Fdelete_region (TOP, v1);
  1478             NEXT;
  1479           }
  1480 
  1481         CASE (Bnarrow_to_region):
  1482           {
  1483             Lisp_Object v1 = POP;
  1484             TOP = Fnarrow_to_region (TOP, v1);
  1485             NEXT;
  1486           }
  1487 
  1488         CASE (Bwiden):
  1489           PUSH (Fwiden ());
  1490           NEXT;
  1491 
  1492         CASE (Bend_of_line):
  1493           TOP = Fend_of_line (TOP);
  1494           NEXT;
  1495 
  1496         CASE (Bset_marker):
  1497           {
  1498             Lisp_Object v2 = POP, v1 = POP;
  1499             TOP = Fset_marker (TOP, v1, v2);
  1500             NEXT;
  1501           }
  1502 
  1503         CASE (Bmatch_beginning):
  1504           TOP = Fmatch_beginning (TOP);
  1505           NEXT;
  1506 
  1507         CASE (Bmatch_end):
  1508           TOP = Fmatch_end (TOP);
  1509           NEXT;
  1510 
  1511         CASE (Bupcase):
  1512           TOP = Fupcase (TOP);
  1513           NEXT;
  1514 
  1515         CASE (Bdowncase):
  1516           TOP = Fdowncase (TOP);
  1517           NEXT;
  1518 
  1519         CASE (Bstringeqlsign):
  1520           {
  1521             Lisp_Object v1 = POP;
  1522             TOP = Fstring_equal (TOP, v1);
  1523             NEXT;
  1524           }
  1525 
  1526         CASE (Bstringlss):
  1527           {
  1528             Lisp_Object v1 = POP;
  1529             TOP = Fstring_lessp (TOP, v1);
  1530             NEXT;
  1531           }
  1532 
  1533         CASE (Bequal):
  1534           {
  1535             Lisp_Object v1 = POP;
  1536             TOP = Fequal (TOP, v1);
  1537             NEXT;
  1538           }
  1539 
  1540         CASE (Bnthcdr):
  1541           {
  1542             Lisp_Object v1 = POP;
  1543             TOP = Fnthcdr (TOP, v1);
  1544             NEXT;
  1545           }
  1546 
  1547         CASE (Belt):
  1548           {
  1549             Lisp_Object v2 = POP, v1 = TOP;
  1550             if (CONSP (v1) && RANGED_FIXNUMP (0, v2, SMALL_LIST_LEN_MAX))
  1551               {
  1552                 /* Like the fast case for Bnth, but with args reversed.  */
  1553                 for (EMACS_INT n = XFIXNUM (v2); 0 < n && CONSP (v1); n--)
  1554                   v1 = XCDR (v1);
  1555                 TOP = CAR (v1);
  1556               }
  1557             else
  1558               TOP = Felt (v1, v2);
  1559             NEXT;
  1560           }
  1561 
  1562         CASE (Bmember):
  1563           {
  1564             Lisp_Object v1 = POP;
  1565             TOP = Fmember (TOP, v1);
  1566             NEXT;
  1567           }
  1568 
  1569         CASE (Bassq):
  1570           {
  1571             Lisp_Object v1 = POP;
  1572             TOP = Fassq (TOP, v1);
  1573             NEXT;
  1574           }
  1575 
  1576         CASE (Bnreverse):
  1577           TOP = Fnreverse (TOP);
  1578           NEXT;
  1579 
  1580         CASE (Bsetcar):
  1581           {
  1582             Lisp_Object newval = POP;
  1583             Lisp_Object cell = TOP;
  1584             CHECK_CONS (cell);
  1585             CHECK_IMPURE (cell, XCONS (cell));
  1586             XSETCAR (cell, newval);
  1587             TOP = newval;
  1588             NEXT;
  1589           }
  1590 
  1591         CASE (Bsetcdr):
  1592           {
  1593             Lisp_Object newval = POP;
  1594             Lisp_Object cell = TOP;
  1595             CHECK_CONS (cell);
  1596             CHECK_IMPURE (cell, XCONS (cell));
  1597             XSETCDR (cell, newval);
  1598             TOP = newval;
  1599             NEXT;
  1600           }
  1601 
  1602         CASE (Bcar_safe):
  1603           TOP = CAR_SAFE (TOP);
  1604           NEXT;
  1605 
  1606         CASE (Bcdr_safe):
  1607           TOP = CDR_SAFE (TOP);
  1608           NEXT;
  1609 
  1610         CASE (Bnconc):
  1611           DISCARD (1);
  1612           TOP = Fnconc (2, &TOP);
  1613           NEXT;
  1614 
  1615         CASE (Bnumberp):
  1616           TOP = NUMBERP (TOP) ? Qt : Qnil;
  1617           NEXT;
  1618 
  1619         CASE (Bintegerp):
  1620           TOP = INTEGERP (TOP) ? Qt : Qnil;
  1621           NEXT;
  1622 
  1623         CASE_ABORT:
  1624           /* Actually this is Bstack_ref with offset 0, but we use Bdup
  1625              for that instead.  */
  1626           /* CASE (Bstack_ref): */
  1627           error ("Invalid byte opcode: op=%d, ptr=%"pD"d",
  1628                  op, pc - 1 - bytestr_data);
  1629 
  1630           /* Handy byte-codes for lexical binding.  */
  1631         CASE (Bstack_ref1):
  1632         CASE (Bstack_ref2):
  1633         CASE (Bstack_ref3):
  1634         CASE (Bstack_ref4):
  1635         CASE (Bstack_ref5):
  1636           {
  1637             Lisp_Object v1 = top[Bstack_ref - op];
  1638             PUSH (v1);
  1639             NEXT;
  1640           }
  1641         CASE (Bstack_ref6):
  1642           {
  1643             Lisp_Object v1 = top[- FETCH];
  1644             PUSH (v1);
  1645             NEXT;
  1646           }
  1647         CASE (Bstack_ref7):
  1648           {
  1649             Lisp_Object v1 = top[- FETCH2];
  1650             PUSH (v1);
  1651             NEXT;
  1652           }
  1653         CASE (Bstack_set):
  1654           /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos.  */
  1655           {
  1656             Lisp_Object *ptr = top - FETCH;
  1657             *ptr = POP;
  1658             NEXT;
  1659           }
  1660         CASE (Bstack_set2):
  1661           {
  1662             Lisp_Object *ptr = top - FETCH2;
  1663             *ptr = POP;
  1664             NEXT;
  1665           }
  1666         CASE (BdiscardN):
  1667           op = FETCH;
  1668           if (op & 0x80)
  1669             {
  1670               op &= 0x7F;
  1671               top[-op] = TOP;
  1672             }
  1673           DISCARD (op);
  1674           NEXT;
  1675 
  1676         CASE (Bswitch):
  1677           {
  1678             /* TODO: Perhaps introduce another byte-code for switch when the
  1679                number of cases is less, which uses a simple vector for linear
  1680                search as the jump table.  */
  1681 
  1682             /* TODO: Instead of pushing the table in a separate
  1683                Bconstant op, use an immediate argument (maybe separate
  1684                switch opcodes for 1-byte and 2-byte constant indices).
  1685                This would also get rid of some hacks that assume each
  1686                Bswitch to be preceded by a Bconstant.  */
  1687             Lisp_Object jmp_table = POP;
  1688             if (BYTE_CODE_SAFE && !HASH_TABLE_P (jmp_table))
  1689               emacs_abort ();
  1690             Lisp_Object v1 = POP;
  1691             ptrdiff_t i;
  1692             struct Lisp_Hash_Table *h = XHASH_TABLE (jmp_table);
  1693 
  1694             /* h->count is a faster approximation for HASH_TABLE_SIZE (h)
  1695                here. */
  1696             if (h->count <= 5 && !h->test.cmpfn)
  1697               { /* Do a linear search if there are not many cases
  1698                    FIXME: 5 is arbitrarily chosen.  */
  1699                 for (i = h->count; 0 <= --i; )
  1700                   if (EQ (v1, HASH_KEY (h, i)))
  1701                     break;
  1702               }
  1703             else
  1704               i = hash_lookup (h, v1, NULL);
  1705 
  1706             if (i >= 0)
  1707               {
  1708                 Lisp_Object val = HASH_VALUE (h, i);
  1709                 if (BYTE_CODE_SAFE && !FIXNUMP (val))
  1710                   emacs_abort ();
  1711                 op = XFIXNUM (val);
  1712                 goto op_branch;
  1713               }
  1714           }
  1715           NEXT;
  1716 
  1717         CASE_DEFAULT
  1718         CASE (Bconstant):
  1719           if (BYTE_CODE_SAFE
  1720               && ! (Bconstant <= op && op < Bconstant + const_length))
  1721             emacs_abort ();
  1722           PUSH (vectorp[op - Bconstant]);
  1723           NEXT;
  1724         }
  1725     }
  1726 
  1727  exit:
  1728 
  1729   bc->fp = bc->fp->saved_fp;
  1730 
  1731   Lisp_Object result = TOP;
  1732   return result;
  1733 }
  1734 
  1735 /* `args_template' has the same meaning as in exec_byte_code() above.  */
  1736 Lisp_Object
  1737 get_byte_code_arity (Lisp_Object args_template)
  1738 {
  1739   eassert (FIXNATP (args_template));
  1740   EMACS_INT at = XFIXNUM (args_template);
  1741   bool rest = (at & 128) != 0;
  1742   int mandatory = at & 127;
  1743   EMACS_INT nonrest = at >> 8;
  1744 
  1745   return Fcons (make_fixnum (mandatory),
  1746                 rest ? Qmany : make_fixnum (nonrest));
  1747 }
  1748 
  1749 void
  1750 syms_of_bytecode (void)
  1751 {
  1752   DEFSYM (Qinteractive_p, "interactive-p");
  1753 
  1754   defsubr (&Sbyte_code);
  1755   defsubr (&Sinternal_stack_stats);
  1756 
  1757 #ifdef BYTE_CODE_METER
  1758 
  1759   DEFVAR_LISP ("byte-code-meter", Vbyte_code_meter,
  1760                doc: /* A vector of vectors which holds a histogram of byte-code usage.
  1761 \(aref (aref byte-code-meter 0) CODE) indicates how many times the byte
  1762 opcode CODE has been executed.
  1763 \(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
  1764 indicates how many times the byte opcodes CODE1 and CODE2 have been
  1765 executed in succession.  */);
  1766 
  1767   DEFVAR_BOOL ("byte-metering-on", byte_metering_on,
  1768                doc: /* If non-nil, keep profiling information on byte code usage.
  1769 The variable byte-code-meter indicates how often each byte opcode is used.
  1770 If a symbol has a property named `byte-code-meter' whose value is an
  1771 integer, it is incremented each time that symbol's function is called.  */);
  1772 
  1773   byte_metering_on = false;
  1774   Vbyte_code_meter = make_nil_vector (256);
  1775   DEFSYM (Qbyte_code_meter, "byte-code-meter");
  1776   for (int i = 0; i < 256; i++)
  1777     ASET (Vbyte_code_meter, i, make_vector (256, make_fixnum (0)));
  1778 #endif
  1779 }
/* [<][>][^][v][top][bottom][index][help] */
root/src/bytecode.c

DEFINITIONS
