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