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