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