src/bytecode.c

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