src/bytecode.c

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