src/bytecode.c

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