src/bytecode.c

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