src/bytecode.c

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