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