src/bytecode.c

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