src/bytecode.c

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