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   int bytestr_length;
 429 #endif
 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 #ifdef BYTE_CODE_SAFE
 457   bytestr_length = SBYTES (bytestr);
 458 #endif
 459   vectorp = XVECTOR (vector)->contents;
 460
 461   stack.byte_string = bytestr;
 462   stack.pc = stack.byte_string_start = SDATA (bytestr);
 463   stack.constants = vector;
 464   top = (Lisp_Object *) alloca (XFASTINT (maxdepth)
 465                                          * sizeof (Lisp_Object));
 466 #if BYTE_MAINTAIN_TOP
 467   stack.bottom = top;
 468   stack.top = NULL;
 469 #endif
 470   top -= 1;
 471   stack.next = byte_stack_list;
 472   byte_stack_list = &stack;
 473
 474 #ifdef BYTE_CODE_SAFE
 475   stacke = stack.bottom - 1 + XFASTINT (maxdepth);
 476 #endif
 477
 478   while (1)
 479     {
 480 #ifdef BYTE_CODE_SAFE
 481       if (top > stacke)
 482         abort ();
 483       else if (top < stack.bottom - 1)
 484         abort ();
 485 #endif
 486
 487 #ifdef BYTE_CODE_METER
 488       prev_op = this_op;
 489       this_op = op = FETCH;
 490       METER_CODE (prev_op, op);
 491 #else
 492       op = FETCH;
 493 #endif
 494
 495       switch (op)
 496         {
 497         case Bvarref + 7:
 498           op = FETCH2;
 499           goto varref;
 500
 501         case Bvarref:
 502         case Bvarref + 1:
 503         case Bvarref + 2:
 504         case Bvarref + 3:
 505         case Bvarref + 4:
 506         case Bvarref + 5:
 507           op = op - Bvarref;
 508           goto varref;
 509
 510         /* This seems to be the most frequently executed byte-code
 511            among the Bvarref's, so avoid a goto here.  */
 512         case Bvarref+6:
 513           op = FETCH;
 514         varref:
 515           {
 516             Lisp_Object v1, v2;
 517
 518             v1 = vectorp[op];
 519             if (SYMBOLP (v1))
 520               {
 521                 if (XSYMBOL (v1)->redirect != SYMBOL_PLAINVAL
 522                     || (v2 = SYMBOL_VAL (XSYMBOL (v1)),
 523                         EQ (v2, Qunbound)))
 524                   {
 525                     BEFORE_POTENTIAL_GC ();
 526                     v2 = Fsymbol_value (v1);
 527                     AFTER_POTENTIAL_GC ();
 528                   }
 529               }
 530             else
 531               {
 532                 BEFORE_POTENTIAL_GC ();
 533                 v2 = Fsymbol_value (v1);
 534                 AFTER_POTENTIAL_GC ();
 535               }
 536             PUSH (v2);
 537             break;
 538           }
 539
 540         case Bgotoifnil:
 541           {
 542             Lisp_Object v1;
 543             MAYBE_GC ();
 544             op = FETCH2;
 545             v1 = POP;
 546             if (NILP (v1))
 547               {
 548                 BYTE_CODE_QUIT;
 549                 CHECK_RANGE (op);
 550                 stack.pc = stack.byte_string_start + op;
 551               }
 552             break;
 553           }
 554
 555         case Bcar:
 556           {
 557             Lisp_Object v1;
 558             v1 = TOP;
 559             if (CONSP (v1))
 560               TOP = XCAR (v1);
 561             else if (NILP (v1))
 562               TOP = Qnil;
 563             else
 564               {
 565                 BEFORE_POTENTIAL_GC ();
 566                 wrong_type_argument (Qlistp, v1);
 567                 AFTER_POTENTIAL_GC ();
 568               }
 569             break;
 570           }
 571
 572         case Beq:
 573           {
 574             Lisp_Object v1;
 575             v1 = POP;
 576             TOP = EQ (v1, TOP) ? Qt : Qnil;
 577             break;
 578           }
 579
 580         case Bmemq:
 581           {
 582             Lisp_Object v1;
 583             BEFORE_POTENTIAL_GC ();
 584             v1 = POP;
 585             TOP = Fmemq (TOP, v1);
 586             AFTER_POTENTIAL_GC ();
 587             break;
 588           }
 589
 590         case Bcdr:
 591           {
 592             Lisp_Object v1;
 593             v1 = TOP;
 594             if (CONSP (v1))
 595               TOP = XCDR (v1);
 596             else if (NILP (v1))
 597               TOP = Qnil;
 598             else
 599               {
 600                 BEFORE_POTENTIAL_GC ();
 601                 wrong_type_argument (Qlistp, v1);
 602                 AFTER_POTENTIAL_GC ();
 603               }
 604             break;
 605             break;
 606           }
 607
 608         case Bvarset:
 609         case Bvarset+1:
 610         case Bvarset+2:
 611         case Bvarset+3:
 612         case Bvarset+4:
 613         case Bvarset+5:
 614           op -= Bvarset;
 615           goto varset;
 616
 617         case Bvarset+7:
 618           op = FETCH2;
 619           goto varset;
 620
 621         case Bvarset+6:
 622           op = FETCH;
 623         varset:
 624           {
 625             Lisp_Object sym, val;
 626
 627             sym = vectorp[op];
 628             val = TOP;
 629
 630             /* Inline the most common case.  */
 631             if (SYMBOLP (sym)
 632                 && !EQ (val, Qunbound)
 633                 && !XSYMBOL (sym)->redirect
 634                 && !SYMBOL_CONSTANT_P (sym))
 635               XSYMBOL (sym)->val.value = val;
 636             else
 637               {
 638                 BEFORE_POTENTIAL_GC ();
 639                 set_internal (sym, val, Qnil, 0);
 640                 AFTER_POTENTIAL_GC ();
 641               }
 642           }
 643           (void) POP;
 644           break;
 645
 646         case Bdup:
 647           {
 648             Lisp_Object v1;
 649             v1 = TOP;
 650             PUSH (v1);
 651             break;
 652           }
 653
 654         /* ------------------ */
 655
 656         case Bvarbind+6:
 657           op = FETCH;
 658           goto varbind;
 659
 660         case Bvarbind+7:
 661           op = FETCH2;
 662           goto varbind;
 663
 664         case Bvarbind:
 665         case Bvarbind+1:
 666         case Bvarbind+2:
 667         case Bvarbind+3:
 668         case Bvarbind+4:
 669         case Bvarbind+5:
 670           op -= Bvarbind;
 671         varbind:
 672           /* Specbind can signal and thus GC.  */
 673           BEFORE_POTENTIAL_GC ();
 674           specbind (vectorp[op], POP);
 675           AFTER_POTENTIAL_GC ();
 676           break;
 677
 678         case Bcall+6:
 679           op = FETCH;
 680           goto docall;
 681
 682         case Bcall+7:
 683           op = FETCH2;
 684           goto docall;
 685
 686         case Bcall:
 687         case Bcall+1:
 688         case Bcall+2:
 689         case Bcall+3:
 690         case Bcall+4:
 691         case Bcall+5:
 692           op -= Bcall;
 693         docall:
 694           {
 695             BEFORE_POTENTIAL_GC ();
 696             DISCARD (op);
 697 #ifdef BYTE_CODE_METER
 698             if (byte_metering_on && SYMBOLP (TOP))
 699               {
 700                 Lisp_Object v1, v2;
 701
 702                 v1 = TOP;
 703                 v2 = Fget (v1, Qbyte_code_meter);
 704                 if (INTEGERP (v2)
 705                     && XINT (v2) < MOST_POSITIVE_FIXNUM)
 706                   {
 707                     XSETINT (v2, XINT (v2) + 1);
 708                     Fput (v1, Qbyte_code_meter, v2);
 709                   }
 710               }
 711 #endif
 712             TOP = Ffuncall (op + 1, &TOP);
 713             AFTER_POTENTIAL_GC ();
 714             break;
 715           }
 716
 717         case Bunbind+6:
 718           op = FETCH;
 719           goto dounbind;
 720
 721         case Bunbind+7:
 722           op = FETCH2;
 723           goto dounbind;
 724
 725         case Bunbind:
 726         case Bunbind+1:
 727         case Bunbind+2:
 728         case Bunbind+3:
 729         case Bunbind+4:
 730         case Bunbind+5:
 731           op -= Bunbind;
 732         dounbind:
 733           BEFORE_POTENTIAL_GC ();
 734           unbind_to (SPECPDL_INDEX () - op, Qnil);
 735           AFTER_POTENTIAL_GC ();
 736           break;
 737
 738         case Bunbind_all:
 739           /* To unbind back to the beginning of this frame.  Not used yet,
 740              but will be needed for tail-recursion elimination.  */
 741           BEFORE_POTENTIAL_GC ();
 742           unbind_to (count, Qnil);
 743           AFTER_POTENTIAL_GC ();
 744           break;
 745
 746         case Bgoto:
 747           MAYBE_GC ();
 748           BYTE_CODE_QUIT;
 749           op = FETCH2;    /* pc = FETCH2 loses since FETCH2 contains pc++ */
 750           CHECK_RANGE (op);
 751           stack.pc = stack.byte_string_start + op;
 752           break;
 753
 754         case Bgotoifnonnil:
 755           {
 756             Lisp_Object v1;
 757             MAYBE_GC ();
 758             op = FETCH2;
 759             v1 = POP;
 760             if (!NILP (v1))
 761               {
 762                 BYTE_CODE_QUIT;
 763                 CHECK_RANGE (op);
 764                 stack.pc = stack.byte_string_start + op;
 765               }
 766             break;
 767           }
 768
 769         case Bgotoifnilelsepop:
 770           MAYBE_GC ();
 771           op = FETCH2;
 772           if (NILP (TOP))
 773             {
 774               BYTE_CODE_QUIT;
 775               CHECK_RANGE (op);
 776               stack.pc = stack.byte_string_start + op;
 777             }
 778           else DISCARD (1);
 779           break;
 780
 781         case Bgotoifnonnilelsepop:
 782           MAYBE_GC ();
 783           op = FETCH2;
 784           if (!NILP (TOP))
 785             {
 786               BYTE_CODE_QUIT;
 787               CHECK_RANGE (op);
 788               stack.pc = stack.byte_string_start + op;
 789             }
 790           else DISCARD (1);
 791           break;
 792
 793         case BRgoto:
 794           MAYBE_GC ();
 795           BYTE_CODE_QUIT;
 796           stack.pc += (int) *stack.pc - 127;
 797           break;
 798
 799         case BRgotoifnil:
 800           {
 801             Lisp_Object v1;
 802             MAYBE_GC ();
 803             v1 = POP;
 804             if (NILP (v1))
 805               {
 806                 BYTE_CODE_QUIT;
 807                 stack.pc += (int) *stack.pc - 128;
 808               }
 809             stack.pc++;
 810             break;
 811           }
 812
 813         case BRgotoifnonnil:
 814           {
 815             Lisp_Object v1;
 816             MAYBE_GC ();
 817             v1 = POP;
 818             if (!NILP (v1))
 819               {
 820                 BYTE_CODE_QUIT;
 821                 stack.pc += (int) *stack.pc - 128;
 822               }
 823             stack.pc++;
 824             break;
 825           }
 826
 827         case BRgotoifnilelsepop:
 828           MAYBE_GC ();
 829           op = *stack.pc++;
 830           if (NILP (TOP))
 831             {
 832               BYTE_CODE_QUIT;
 833               stack.pc += op - 128;
 834             }
 835           else DISCARD (1);
 836           break;
 837
 838         case BRgotoifnonnilelsepop:
 839           MAYBE_GC ();
 840           op = *stack.pc++;
 841           if (!NILP (TOP))
 842             {
 843               BYTE_CODE_QUIT;
 844               stack.pc += op - 128;
 845             }
 846           else DISCARD (1);
 847           break;
 848
 849         case Breturn:
 850           result = POP;
 851           goto exit;
 852
 853         case Bdiscard:
 854           DISCARD (1);
 855           break;
 856
 857         case Bconstant2:
 858           PUSH (vectorp[FETCH2]);
 859           break;
 860
 861         case Bsave_excursion:
 862           record_unwind_protect (save_excursion_restore,
 863                                  save_excursion_save ());
 864           break;
 865
 866         case Bsave_current_buffer:
 867         case Bsave_current_buffer_1:
 868           record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
 869           break;
 870
 871         case Bsave_window_excursion:
 872           BEFORE_POTENTIAL_GC ();
 873           TOP = Fsave_window_excursion (TOP);
 874           AFTER_POTENTIAL_GC ();
 875           break;
 876
 877         case Bsave_restriction:
 878           record_unwind_protect (save_restriction_restore,
 879                                  save_restriction_save ());
 880           break;
 881
 882         case Bcatch:
 883           {
 884             Lisp_Object v1;
 885             BEFORE_POTENTIAL_GC ();
 886             v1 = POP;
 887             TOP = internal_catch (TOP, Feval, v1);
 888             AFTER_POTENTIAL_GC ();
 889             break;
 890           }
 891
 892         case Bunwind_protect:
 893           record_unwind_protect (Fprogn, POP);
 894           break;
 895
 896         case Bcondition_case:
 897           {
 898             Lisp_Object handlers, body;
 899             handlers = POP;
 900             body = POP;
 901             BEFORE_POTENTIAL_GC ();
 902             TOP = internal_lisp_condition_case (TOP, body, handlers);
 903             AFTER_POTENTIAL_GC ();
 904             break;
 905           }
 906
 907         case Btemp_output_buffer_setup:
 908           BEFORE_POTENTIAL_GC ();
 909           CHECK_STRING (TOP);
 910           temp_output_buffer_setup (SSDATA (TOP));
 911           AFTER_POTENTIAL_GC ();
 912           TOP = Vstandard_output;
 913           break;
 914
 915         case Btemp_output_buffer_show:
 916           {
 917             Lisp_Object v1;
 918             BEFORE_POTENTIAL_GC ();
 919             v1 = POP;
 920             temp_output_buffer_show (TOP);
 921             TOP = v1;
 922             /* pop binding of standard-output */
 923             unbind_to (SPECPDL_INDEX () - 1, Qnil);
 924             AFTER_POTENTIAL_GC ();
 925             break;
 926           }
 927
 928         case Bnth:
 929           {
 930             Lisp_Object v1, v2;
 931             BEFORE_POTENTIAL_GC ();
 932             v1 = POP;
 933             v2 = TOP;
 934             CHECK_NUMBER (v2);
 935             op = XINT (v2);
 936             immediate_quit = 1;
 937             while (--op >= 0 && CONSP (v1))
 938               v1 = XCDR (v1);
 939             immediate_quit = 0;
 940             TOP = CAR (v1);
 941             AFTER_POTENTIAL_GC ();
 942             break;
 943           }
 944
 945         case Bsymbolp:
 946           TOP = SYMBOLP (TOP) ? Qt : Qnil;
 947           break;
 948
 949         case Bconsp:
 950           TOP = CONSP (TOP) ? Qt : Qnil;
 951           break;
 952
 953         case Bstringp:
 954           TOP = STRINGP (TOP) ? Qt : Qnil;
 955           break;
 956
 957         case Blistp:
 958           TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
 959           break;
 960
 961         case Bnot:
 962           TOP = NILP (TOP) ? Qt : Qnil;
 963           break;
 964
 965         case Bcons:
 966           {
 967             Lisp_Object v1;
 968             v1 = POP;
 969             TOP = Fcons (TOP, v1);
 970             break;
 971           }
 972
 973         case Blist1:
 974           TOP = Fcons (TOP, Qnil);
 975           break;
 976
 977         case Blist2:
 978           {
 979             Lisp_Object v1;
 980             v1 = POP;
 981             TOP = Fcons (TOP, Fcons (v1, Qnil));
 982             break;
 983           }
 984
 985         case Blist3:
 986           DISCARD (2);
 987           TOP = Flist (3, &TOP);
 988           break;
 989
 990         case Blist4:
 991           DISCARD (3);
 992           TOP = Flist (4, &TOP);
 993           break;
 994
 995         case BlistN:
 996           op = FETCH;
 997           DISCARD (op - 1);
 998           TOP = Flist (op, &TOP);
 999           break;
1000
1001         case Blength:
1002           BEFORE_POTENTIAL_GC ();
1003           TOP = Flength (TOP);
1004           AFTER_POTENTIAL_GC ();
1005           break;
1006
1007         case Baref:
1008           {
1009             Lisp_Object v1;
1010             BEFORE_POTENTIAL_GC ();
1011             v1 = POP;
1012             TOP = Faref (TOP, v1);
1013             AFTER_POTENTIAL_GC ();
1014             break;
1015           }
1016
1017         case Baset:
1018           {
1019             Lisp_Object v1, v2;
1020             BEFORE_POTENTIAL_GC ();
1021             v2 = POP; v1 = POP;
1022             TOP = Faset (TOP, v1, v2);
1023             AFTER_POTENTIAL_GC ();
1024             break;
1025           }
1026
1027         case Bsymbol_value:
1028           BEFORE_POTENTIAL_GC ();
1029           TOP = Fsymbol_value (TOP);
1030           AFTER_POTENTIAL_GC ();
1031           break;
1032
1033         case Bsymbol_function:
1034           BEFORE_POTENTIAL_GC ();
1035           TOP = Fsymbol_function (TOP);
1036           AFTER_POTENTIAL_GC ();
1037           break;
1038
1039         case Bset:
1040           {
1041             Lisp_Object v1;
1042             BEFORE_POTENTIAL_GC ();
1043             v1 = POP;
1044             TOP = Fset (TOP, v1);
1045             AFTER_POTENTIAL_GC ();
1046             break;
1047           }
1048
1049         case Bfset:
1050           {
1051             Lisp_Object v1;
1052             BEFORE_POTENTIAL_GC ();
1053             v1 = POP;
1054             TOP = Ffset (TOP, v1);
1055             AFTER_POTENTIAL_GC ();
1056             break;
1057           }
1058
1059         case Bget:
1060           {
1061             Lisp_Object v1;
1062             BEFORE_POTENTIAL_GC ();
1063             v1 = POP;
1064             TOP = Fget (TOP, v1);
1065             AFTER_POTENTIAL_GC ();
1066             break;
1067           }
1068
1069         case Bsubstring:
1070           {
1071             Lisp_Object v1, v2;
1072             BEFORE_POTENTIAL_GC ();
1073             v2 = POP; v1 = POP;
1074             TOP = Fsubstring (TOP, v1, v2);
1075             AFTER_POTENTIAL_GC ();
1076             break;
1077           }
1078
1079         case Bconcat2:
1080           BEFORE_POTENTIAL_GC ();
1081           DISCARD (1);
1082           TOP = Fconcat (2, &TOP);
1083           AFTER_POTENTIAL_GC ();
1084           break;
1085
1086         case Bconcat3:
1087           BEFORE_POTENTIAL_GC ();
1088           DISCARD (2);
1089           TOP = Fconcat (3, &TOP);
1090           AFTER_POTENTIAL_GC ();
1091           break;
1092
1093         case Bconcat4:
1094           BEFORE_POTENTIAL_GC ();
1095           DISCARD (3);
1096           TOP = Fconcat (4, &TOP);
1097           AFTER_POTENTIAL_GC ();
1098           break;
1099
1100         case BconcatN:
1101           op = FETCH;
1102           BEFORE_POTENTIAL_GC ();
1103           DISCARD (op - 1);
1104           TOP = Fconcat (op, &TOP);
1105           AFTER_POTENTIAL_GC ();
1106           break;
1107
1108         case Bsub1:
1109           {
1110             Lisp_Object v1;
1111             v1 = TOP;
1112             if (INTEGERP (v1))
1113               {
1114                 XSETINT (v1, XINT (v1) - 1);
1115                 TOP = v1;
1116               }
1117             else
1118               {
1119                 BEFORE_POTENTIAL_GC ();
1120                 TOP = Fsub1 (v1);
1121                 AFTER_POTENTIAL_GC ();
1122               }
1123             break;
1124           }
1125
1126         case Badd1:
1127           {
1128             Lisp_Object v1;
1129             v1 = TOP;
1130             if (INTEGERP (v1))
1131               {
1132                 XSETINT (v1, XINT (v1) + 1);
1133                 TOP = v1;
1134               }
1135             else
1136               {
1137                 BEFORE_POTENTIAL_GC ();
1138                 TOP = Fadd1 (v1);
1139                 AFTER_POTENTIAL_GC ();
1140               }
1141             break;
1142           }
1143
1144         case Beqlsign:
1145           {
1146             Lisp_Object v1, v2;
1147             BEFORE_POTENTIAL_GC ();
1148             v2 = POP; v1 = TOP;
1149             CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1);
1150             CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2);
1151             AFTER_POTENTIAL_GC ();
1152             if (FLOATP (v1) || FLOATP (v2))
1153               {
1154                 double f1, f2;
1155
1156                 f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1));
1157                 f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
1158                 TOP = (f1 == f2 ? Qt : Qnil);
1159               }
1160             else
1161               TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
1162             break;
1163           }
1164
1165         case Bgtr:
1166           {
1167             Lisp_Object v1;
1168             BEFORE_POTENTIAL_GC ();
1169             v1 = POP;
1170             TOP = Fgtr (TOP, v1);
1171             AFTER_POTENTIAL_GC ();
1172             break;
1173           }
1174
1175         case Blss:
1176           {
1177             Lisp_Object v1;
1178             BEFORE_POTENTIAL_GC ();
1179             v1 = POP;
1180             TOP = Flss (TOP, v1);
1181             AFTER_POTENTIAL_GC ();
1182             break;
1183           }
1184
1185         case Bleq:
1186           {
1187             Lisp_Object v1;
1188             BEFORE_POTENTIAL_GC ();
1189             v1 = POP;
1190             TOP = Fleq (TOP, v1);
1191             AFTER_POTENTIAL_GC ();
1192             break;
1193           }
1194
1195         case Bgeq:
1196           {
1197             Lisp_Object v1;
1198             BEFORE_POTENTIAL_GC ();
1199             v1 = POP;
1200             TOP = Fgeq (TOP, v1);
1201             AFTER_POTENTIAL_GC ();
1202             break;
1203           }
1204
1205         case Bdiff:
1206           BEFORE_POTENTIAL_GC ();
1207           DISCARD (1);
1208           TOP = Fminus (2, &TOP);
1209           AFTER_POTENTIAL_GC ();
1210           break;
1211
1212         case Bnegate:
1213           {
1214             Lisp_Object v1;
1215             v1 = TOP;
1216             if (INTEGERP (v1))
1217               {
1218                 XSETINT (v1, - XINT (v1));
1219                 TOP = v1;
1220               }
1221             else
1222               {
1223                 BEFORE_POTENTIAL_GC ();
1224                 TOP = Fminus (1, &TOP);
1225                 AFTER_POTENTIAL_GC ();
1226               }
1227             break;
1228           }
1229
1230         case Bplus:
1231           BEFORE_POTENTIAL_GC ();
1232           DISCARD (1);
1233           TOP = Fplus (2, &TOP);
1234           AFTER_POTENTIAL_GC ();
1235           break;
1236
1237         case Bmax:
1238           BEFORE_POTENTIAL_GC ();
1239           DISCARD (1);
1240           TOP = Fmax (2, &TOP);
1241           AFTER_POTENTIAL_GC ();
1242           break;
1243
1244         case Bmin:
1245           BEFORE_POTENTIAL_GC ();
1246           DISCARD (1);
1247           TOP = Fmin (2, &TOP);
1248           AFTER_POTENTIAL_GC ();
1249           break;
1250
1251         case Bmult:
1252           BEFORE_POTENTIAL_GC ();
1253           DISCARD (1);
1254           TOP = Ftimes (2, &TOP);
1255           AFTER_POTENTIAL_GC ();
1256           break;
1257
1258         case Bquo:
1259           BEFORE_POTENTIAL_GC ();
1260           DISCARD (1);
1261           TOP = Fquo (2, &TOP);
1262           AFTER_POTENTIAL_GC ();
1263           break;
1264
1265         case Brem:
1266           {
1267             Lisp_Object v1;
1268             BEFORE_POTENTIAL_GC ();
1269             v1 = POP;
1270             TOP = Frem (TOP, v1);
1271             AFTER_POTENTIAL_GC ();
1272             break;
1273           }
1274
1275         case Bpoint:
1276           {
1277             Lisp_Object v1;
1278             XSETFASTINT (v1, PT);
1279             PUSH (v1);
1280             break;
1281           }
1282
1283         case Bgoto_char:
1284           BEFORE_POTENTIAL_GC ();
1285           TOP = Fgoto_char (TOP);
1286           AFTER_POTENTIAL_GC ();
1287           break;
1288
1289         case Binsert:
1290           BEFORE_POTENTIAL_GC ();
1291           TOP = Finsert (1, &TOP);
1292           AFTER_POTENTIAL_GC ();
1293           break;
1294
1295         case BinsertN:
1296           op = FETCH;
1297           BEFORE_POTENTIAL_GC ();
1298           DISCARD (op - 1);
1299           TOP = Finsert (op, &TOP);
1300           AFTER_POTENTIAL_GC ();
1301           break;
1302
1303         case Bpoint_max:
1304           {
1305             Lisp_Object v1;
1306             XSETFASTINT (v1, ZV);
1307             PUSH (v1);
1308             break;
1309           }
1310
1311         case Bpoint_min:
1312           {
1313             Lisp_Object v1;
1314             XSETFASTINT (v1, BEGV);
1315             PUSH (v1);
1316             break;
1317           }
1318
1319         case Bchar_after:
1320           BEFORE_POTENTIAL_GC ();
1321           TOP = Fchar_after (TOP);
1322           AFTER_POTENTIAL_GC ();
1323           break;
1324
1325         case Bfollowing_char:
1326           {
1327             Lisp_Object v1;
1328             BEFORE_POTENTIAL_GC ();
1329             v1 = Ffollowing_char ();
1330             AFTER_POTENTIAL_GC ();
1331             PUSH (v1);
1332             break;
1333           }
1334
1335         case Bpreceding_char:
1336           {
1337             Lisp_Object v1;
1338             BEFORE_POTENTIAL_GC ();
1339             v1 = Fprevious_char ();
1340             AFTER_POTENTIAL_GC ();
1341             PUSH (v1);
1342             break;
1343           }
1344
1345         case Bcurrent_column:
1346           {
1347             Lisp_Object v1;
1348             BEFORE_POTENTIAL_GC ();
1349             XSETFASTINT (v1, current_column ());
1350             AFTER_POTENTIAL_GC ();
1351             PUSH (v1);
1352             break;
1353           }
1354
1355         case Bindent_to:
1356           BEFORE_POTENTIAL_GC ();
1357           TOP = Findent_to (TOP, Qnil);
1358           AFTER_POTENTIAL_GC ();
1359           break;
1360
1361         case Beolp:
1362           PUSH (Feolp ());
1363           break;
1364
1365         case Beobp:
1366           PUSH (Feobp ());
1367           break;
1368
1369         case Bbolp:
1370           PUSH (Fbolp ());
1371           break;
1372
1373         case Bbobp:
1374           PUSH (Fbobp ());
1375           break;
1376
1377         case Bcurrent_buffer:
1378           PUSH (Fcurrent_buffer ());
1379           break;
1380
1381         case Bset_buffer:
1382           BEFORE_POTENTIAL_GC ();
1383           TOP = Fset_buffer (TOP);
1384           AFTER_POTENTIAL_GC ();
1385           break;
1386
1387         case Binteractive_p:
1388           PUSH (Finteractive_p ());
1389           break;
1390
1391         case Bforward_char:
1392           BEFORE_POTENTIAL_GC ();
1393           TOP = Fforward_char (TOP);
1394           AFTER_POTENTIAL_GC ();
1395           break;
1396
1397         case Bforward_word:
1398           BEFORE_POTENTIAL_GC ();
1399           TOP = Fforward_word (TOP);
1400           AFTER_POTENTIAL_GC ();
1401           break;
1402
1403         case Bskip_chars_forward:
1404           {
1405             Lisp_Object v1;
1406             BEFORE_POTENTIAL_GC ();
1407             v1 = POP;
1408             TOP = Fskip_chars_forward (TOP, v1);
1409             AFTER_POTENTIAL_GC ();
1410             break;
1411           }
1412
1413         case Bskip_chars_backward:
1414           {
1415             Lisp_Object v1;
1416             BEFORE_POTENTIAL_GC ();
1417             v1 = POP;
1418             TOP = Fskip_chars_backward (TOP, v1);
1419             AFTER_POTENTIAL_GC ();
1420             break;
1421           }
1422
1423         case Bforward_line:
1424           BEFORE_POTENTIAL_GC ();
1425           TOP = Fforward_line (TOP);
1426           AFTER_POTENTIAL_GC ();
1427           break;
1428
1429         case Bchar_syntax:
1430           {
1431             int c;
1432
1433             BEFORE_POTENTIAL_GC ();
1434             CHECK_CHARACTER (TOP);
1435             AFTER_POTENTIAL_GC ();
1436             c = XFASTINT (TOP);
1437             if (NILP (BVAR (current_buffer, enable_multibyte_characters)))
1438               MAKE_CHAR_MULTIBYTE (c);
1439             XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (c)]);
1440           }
1441           break;
1442
1443         case Bbuffer_substring:
1444           {
1445             Lisp_Object v1;
1446             BEFORE_POTENTIAL_GC ();
1447             v1 = POP;
1448             TOP = Fbuffer_substring (TOP, v1);
1449             AFTER_POTENTIAL_GC ();
1450             break;
1451           }
1452
1453         case Bdelete_region:
1454           {
1455             Lisp_Object v1;
1456             BEFORE_POTENTIAL_GC ();
1457             v1 = POP;
1458             TOP = Fdelete_region (TOP, v1);
1459             AFTER_POTENTIAL_GC ();
1460             break;
1461           }
1462
1463         case Bnarrow_to_region:
1464           {
1465             Lisp_Object v1;
1466             BEFORE_POTENTIAL_GC ();
1467             v1 = POP;
1468             TOP = Fnarrow_to_region (TOP, v1);
1469             AFTER_POTENTIAL_GC ();
1470             break;
1471           }
1472
1473         case Bwiden:
1474           BEFORE_POTENTIAL_GC ();
1475           PUSH (Fwiden ());
1476           AFTER_POTENTIAL_GC ();
1477           break;
1478
1479         case Bend_of_line:
1480           BEFORE_POTENTIAL_GC ();
1481           TOP = Fend_of_line (TOP);
1482           AFTER_POTENTIAL_GC ();
1483           break;
1484
1485         case Bset_marker:
1486           {
1487             Lisp_Object v1, v2;
1488             BEFORE_POTENTIAL_GC ();
1489             v1 = POP;
1490             v2 = POP;
1491             TOP = Fset_marker (TOP, v2, v1);
1492             AFTER_POTENTIAL_GC ();
1493             break;
1494           }
1495
1496         case Bmatch_beginning:
1497           BEFORE_POTENTIAL_GC ();
1498           TOP = Fmatch_beginning (TOP);
1499           AFTER_POTENTIAL_GC ();
1500           break;
1501
1502         case Bmatch_end:
1503           BEFORE_POTENTIAL_GC ();
1504           TOP = Fmatch_end (TOP);
1505           AFTER_POTENTIAL_GC ();
1506           break;
1507
1508         case Bupcase:
1509           BEFORE_POTENTIAL_GC ();
1510           TOP = Fupcase (TOP);
1511           AFTER_POTENTIAL_GC ();
1512           break;
1513
1514         case Bdowncase:
1515           BEFORE_POTENTIAL_GC ();
1516           TOP = Fdowncase (TOP);
1517           AFTER_POTENTIAL_GC ();
1518         break;
1519
1520         case Bstringeqlsign:
1521           {
1522             Lisp_Object v1;
1523             BEFORE_POTENTIAL_GC ();
1524             v1 = POP;
1525             TOP = Fstring_equal (TOP, v1);
1526             AFTER_POTENTIAL_GC ();
1527             break;
1528           }
1529
1530         case Bstringlss:
1531           {
1532             Lisp_Object v1;
1533             BEFORE_POTENTIAL_GC ();
1534             v1 = POP;
1535             TOP = Fstring_lessp (TOP, v1);
1536             AFTER_POTENTIAL_GC ();
1537             break;
1538           }
1539
1540         case Bequal:
1541           {
1542             Lisp_Object v1;
1543             v1 = POP;
1544             TOP = Fequal (TOP, v1);
1545             break;
1546           }
1547
1548         case Bnthcdr:
1549           {
1550             Lisp_Object v1;
1551             BEFORE_POTENTIAL_GC ();
1552             v1 = POP;
1553             TOP = Fnthcdr (TOP, v1);
1554             AFTER_POTENTIAL_GC ();
1555             break;
1556           }
1557
1558         case Belt:
1559           {
1560             Lisp_Object v1, v2;
1561             if (CONSP (TOP))
1562               {
1563                 /* Exchange args and then do nth.  */
1564                 BEFORE_POTENTIAL_GC ();
1565                 v2 = POP;
1566                 v1 = TOP;
1567                 CHECK_NUMBER (v2);
1568                 AFTER_POTENTIAL_GC ();
1569                 op = XINT (v2);
1570                 immediate_quit = 1;
1571                 while (--op >= 0 && CONSP (v1))
1572                   v1 = XCDR (v1);
1573                 immediate_quit = 0;
1574                 TOP = CAR (v1);
1575               }
1576             else
1577               {
1578                 BEFORE_POTENTIAL_GC ();
1579                 v1 = POP;
1580                 TOP = Felt (TOP, v1);
1581                 AFTER_POTENTIAL_GC ();
1582               }
1583             break;
1584           }
1585
1586         case Bmember:
1587           {
1588             Lisp_Object v1;
1589             BEFORE_POTENTIAL_GC ();
1590             v1 = POP;
1591             TOP = Fmember (TOP, v1);
1592             AFTER_POTENTIAL_GC ();
1593             break;
1594           }
1595
1596         case Bassq:
1597           {
1598             Lisp_Object v1;
1599             BEFORE_POTENTIAL_GC ();
1600             v1 = POP;
1601             TOP = Fassq (TOP, v1);
1602             AFTER_POTENTIAL_GC ();
1603             break;
1604           }
1605
1606         case Bnreverse:
1607           BEFORE_POTENTIAL_GC ();
1608           TOP = Fnreverse (TOP);
1609           AFTER_POTENTIAL_GC ();
1610           break;
1611
1612         case Bsetcar:
1613           {
1614             Lisp_Object v1;
1615             BEFORE_POTENTIAL_GC ();
1616             v1 = POP;
1617             TOP = Fsetcar (TOP, v1);
1618             AFTER_POTENTIAL_GC ();
1619             break;
1620           }
1621
1622         case Bsetcdr:
1623           {
1624             Lisp_Object v1;
1625             BEFORE_POTENTIAL_GC ();
1626             v1 = POP;
1627             TOP = Fsetcdr (TOP, v1);
1628             AFTER_POTENTIAL_GC ();
1629             break;
1630           }
1631
1632         case Bcar_safe:
1633           {
1634             Lisp_Object v1;
1635             v1 = TOP;
1636             TOP = CAR_SAFE (v1);
1637             break;
1638           }
1639
1640         case Bcdr_safe:
1641           {
1642             Lisp_Object v1;
1643             v1 = TOP;
1644             TOP = CDR_SAFE (v1);
1645             break;
1646           }
1647
1648         case Bnconc:
1649           BEFORE_POTENTIAL_GC ();
1650           DISCARD (1);
1651           TOP = Fnconc (2, &TOP);
1652           AFTER_POTENTIAL_GC ();
1653           break;
1654
1655         case Bnumberp:
1656           TOP = (NUMBERP (TOP) ? Qt : Qnil);
1657           break;
1658
1659         case Bintegerp:
1660           TOP = INTEGERP (TOP) ? Qt : Qnil;
1661           break;
1662
1663 #ifdef BYTE_CODE_SAFE
1664         case Bset_mark:
1665           BEFORE_POTENTIAL_GC ();
1666           error ("set-mark is an obsolete bytecode");
1667           AFTER_POTENTIAL_GC ();
1668           break;
1669         case Bscan_buffer:
1670           BEFORE_POTENTIAL_GC ();
1671           error ("scan-buffer is an obsolete bytecode");
1672           AFTER_POTENTIAL_GC ();
1673           break;
1674 #endif
1675
1676         case 0:
1677           abort ();
1678
1679         case 255:
1680         default:
1681 #ifdef BYTE_CODE_SAFE
1682           if (op < Bconstant)
1683             {
1684               abort ();
1685             }
1686           if ((op -= Bconstant) >= const_length)
1687             {
1688               abort ();
1689             }
1690           PUSH (vectorp[op]);
1691 #else
1692           PUSH (vectorp[op - Bconstant]);
1693 #endif
1694         }
1695     }
1696
1697  exit:
1698
1699   byte_stack_list = byte_stack_list->next;
1700
1701   /* Binds and unbinds are supposed to be compiled balanced.  */
1702   if (SPECPDL_INDEX () != count)
1703 #ifdef BYTE_CODE_SAFE
1704     error ("binding stack not balanced (serious byte compiler bug)");
1705 #else
1706     abort ();
1707 #endif
1708
1709   return result;
1710 }
1711
1712 void
1713 syms_of_bytecode (void)
1714 {
1715   Qbytecode = intern_c_string ("byte-code");
1716   staticpro (&Qbytecode);
1717
1718   defsubr (&Sbyte_code);
1719
1720 #ifdef BYTE_CODE_METER
1721
1722   DEFVAR_LISP ("byte-code-meter", Vbyte_code_meter,
1723                doc: /* A vector of vectors which holds a histogram of byte-code usage.
1724 \(aref (aref byte-code-meter 0) CODE) indicates how many times the byte
1725 opcode CODE has been executed.
1726 \(aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,
1727 indicates how many times the byte opcodes CODE1 and CODE2 have been
1728 executed in succession.  */);
1729
1730   DEFVAR_BOOL ("byte-metering-on", byte_metering_on,
1731                doc: /* If non-nil, keep profiling information on byte code usage.
1732 The variable byte-code-meter indicates how often each byte opcode is used.
1733 If a symbol has a property named `byte-code-meter' whose value is an
1734 integer, it is incremented each time that symbol's function is called.  */);
1735
1736   byte_metering_on = 0;
1737   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
1738   Qbyte_code_meter = intern_c_string ("byte-code-meter");
1739   staticpro (&Qbyte_code_meter);
1740   {
1741     int i = 256;
1742     while (i--)
1743       XVECTOR (Vbyte_code_meter)->contents[i] =
1744         Fmake_vector (make_number (256), make_number (0));
1745   }
1746 #endif
1747 }