src/bytecode.c

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