src/bytecode.c

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