src/bytecode.c

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