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