src/bytecode.c

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