src/bytecode.c

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