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                   v2 = Fsymbol_value (v1);
 479               }
 480             else
 481               v2 = Fsymbol_value (v1);
 482             PUSH (v2);
 483             break;
 484           }
 485
 486         case Bgotoifnil:
 487           MAYBE_GC ();
 488           op = FETCH2;
 489           if (NILP (POP))
 490             {
 491               QUIT;
 492               CHECK_RANGE (op);
 493               stack.pc = stack.byte_string_start + op;
 494             }
 495           break;
 496
 497         case Bcar:
 498           {
 499             Lisp_Object v1;
 500             v1 = TOP;
 501             if (CONSP (v1))
 502               TOP = XCAR (v1);
 503             else if (NILP (v1))
 504               TOP = Qnil;
 505             else
 506               {
 507                 BEFORE_POTENTIAL_GC ();
 508                 Fcar (wrong_type_argument (Qlistp, v1));
 509                 AFTER_POTENTIAL_GC ();
 510               }
 511             break;
 512           }
 513
 514         case Beq:
 515           {
 516             Lisp_Object v1;
 517             v1 = POP;
 518             TOP = EQ (v1, TOP) ? Qt : Qnil;
 519             break;
 520           }
 521
 522         case Bmemq:
 523           {
 524             Lisp_Object v1;
 525             v1 = POP;
 526             TOP = Fmemq (TOP, v1);
 527             break;
 528           }
 529
 530         case Bcdr:
 531           {
 532             Lisp_Object v1;
 533             v1 = TOP;
 534             if (CONSP (v1))
 535               TOP = XCDR (v1);
 536             else if (NILP (v1))
 537               TOP = Qnil;
 538             else
 539               {
 540                 BEFORE_POTENTIAL_GC ();
 541                 Fcdr (wrong_type_argument (Qlistp, v1));
 542                 AFTER_POTENTIAL_GC ();
 543               }
 544             break;
 545           }
 546
 547         case Bvarset:
 548         case Bvarset+1:
 549         case Bvarset+2:
 550         case Bvarset+3:
 551         case Bvarset+4:
 552         case Bvarset+5:
 553           op -= Bvarset;
 554           goto varset;
 555
 556         case Bvarset+7:
 557           op = FETCH2;
 558           goto varset;
 559
 560         case Bvarset+6:
 561           op = FETCH;
 562         varset:
 563           {
 564             Lisp_Object sym, val;
 565
 566             sym = vectorp[op];
 567             val = POP;
 568
 569             /* Inline the most common case.  */
 570             if (SYMBOLP (sym)
 571                 && !EQ (val, Qunbound)
 572                 && !MISCP (XSYMBOL (sym)->value)
 573                 /* I think this should either be checked in the byte
 574                    compiler, or there should be a flag indicating that
 575                    a symbol might be constant in Lisp_Symbol, instead
 576                    of checking this here over and over again. --gerd.  */
 577                 && !EQ (sym, Qnil)
 578                 && !EQ (sym, Qt)
 579                 && !(XSYMBOL (sym)->name->data[0] == ':'
 580                      && EQ (XSYMBOL (sym)->obarray, initial_obarray)
 581                      && !EQ (val, sym)))
 582               XSYMBOL (sym)->value = val;
 583             else
 584               set_internal (sym, val, current_buffer, 0);
 585           }
 586           break;
 587
 588         case Bdup:
 589           {
 590             Lisp_Object v1;
 591             v1 = TOP;
 592             PUSH (v1);
 593             break;
 594           }
 595
 596         /* ------------------ */
 597
 598         case Bvarbind+6:
 599           op = FETCH;
 600           goto varbind;
 601
 602         case Bvarbind+7:
 603           op = FETCH2;
 604           goto varbind;
 605
 606         case Bvarbind:
 607         case Bvarbind+1:
 608         case Bvarbind+2:
 609         case Bvarbind+3:
 610         case Bvarbind+4:
 611         case Bvarbind+5:
 612           op -= Bvarbind;
 613         varbind:
 614           specbind (vectorp[op], POP);
 615           break;
 616
 617         case Bcall+6:
 618           op = FETCH;
 619           goto docall;
 620
 621         case Bcall+7:
 622           op = FETCH2;
 623           goto docall;
 624
 625         case Bcall:
 626         case Bcall+1:
 627         case Bcall+2:
 628         case Bcall+3:
 629         case Bcall+4:
 630         case Bcall+5:
 631           op -= Bcall;
 632         docall:
 633           {
 634             BEFORE_POTENTIAL_GC ();
 635             DISCARD (op);
 636 #ifdef BYTE_CODE_METER
 637             if (byte_metering_on && SYMBOLP (TOP))
 638               {
 639                 Lisp_Object v1, v2;
 640
 641                 v1 = TOP;
 642                 v2 = Fget (v1, Qbyte_code_meter);
 643                 if (INTEGERP (v2)
 644                     && XINT (v2) != ((1<<VALBITS)-1))
 645                   {
 646                     XSETINT (v2, XINT (v2) + 1);
 647                     Fput (v1, Qbyte_code_meter, v2);
 648                   }
 649               }
 650 #endif
 651             TOP = Ffuncall (op + 1, &TOP);
 652             AFTER_POTENTIAL_GC ();
 653             break;
 654           }
 655
 656         case Bunbind+6:
 657           op = FETCH;
 658           goto dounbind;
 659
 660         case Bunbind+7:
 661           op = FETCH2;
 662           goto dounbind;
 663
 664         case Bunbind:
 665         case Bunbind+1:
 666         case Bunbind+2:
 667         case Bunbind+3:
 668         case Bunbind+4:
 669         case Bunbind+5:
 670           op -= Bunbind;
 671         dounbind:
 672           BEFORE_POTENTIAL_GC ();
 673           unbind_to (specpdl_ptr - specpdl - op, Qnil);
 674           AFTER_POTENTIAL_GC ();
 675           break;
 676
 677         case Bunbind_all:
 678           /* To unbind back to the beginning of this frame.  Not used yet,
 679              but will be needed for tail-recursion elimination.  */
 680           BEFORE_POTENTIAL_GC ();
 681           unbind_to (count, Qnil);
 682           AFTER_POTENTIAL_GC ();
 683           break;
 684
 685         case Bgoto:
 686           MAYBE_GC ();
 687           QUIT;
 688           op = FETCH2;    /* pc = FETCH2 loses since FETCH2 contains pc++ */
 689           CHECK_RANGE (op);
 690           stack.pc = stack.byte_string_start + op;
 691           break;
 692
 693         case Bgotoifnonnil:
 694           MAYBE_GC ();
 695           op = FETCH2;
 696           if (!NILP (POP))
 697             {
 698               QUIT;
 699               CHECK_RANGE (op);
 700               stack.pc = stack.byte_string_start + op;
 701             }
 702           break;
 703
 704         case Bgotoifnilelsepop:
 705           MAYBE_GC ();
 706           op = FETCH2;
 707           if (NILP (TOP))
 708             {
 709               QUIT;
 710               CHECK_RANGE (op);
 711               stack.pc = stack.byte_string_start + op;
 712             }
 713           else DISCARD (1);
 714           break;
 715
 716         case Bgotoifnonnilelsepop:
 717           MAYBE_GC ();
 718           op = FETCH2;
 719           if (!NILP (TOP))
 720             {
 721               QUIT;
 722               CHECK_RANGE (op);
 723               stack.pc = stack.byte_string_start + op;
 724             }
 725           else DISCARD (1);
 726           break;
 727
 728         case BRgoto:
 729           MAYBE_GC ();
 730           QUIT;
 731           stack.pc += (int) *stack.pc - 127;
 732           break;
 733
 734         case BRgotoifnil:
 735           MAYBE_GC ();
 736           if (NILP (POP))
 737             {
 738               QUIT;
 739               stack.pc += (int) *stack.pc - 128;
 740             }
 741           stack.pc++;
 742           break;
 743
 744         case BRgotoifnonnil:
 745           MAYBE_GC ();
 746           if (!NILP (POP))
 747             {
 748               QUIT;
 749               stack.pc += (int) *stack.pc - 128;
 750             }
 751           stack.pc++;
 752           break;
 753
 754         case BRgotoifnilelsepop:
 755           MAYBE_GC ();
 756           op = *stack.pc++;
 757           if (NILP (TOP))
 758             {
 759               QUIT;
 760               stack.pc += op - 128;
 761             }
 762           else DISCARD (1);
 763           break;
 764
 765         case BRgotoifnonnilelsepop:
 766           MAYBE_GC ();
 767           op = *stack.pc++;
 768           if (!NILP (TOP))
 769             {
 770               QUIT;
 771               stack.pc += op - 128;
 772             }
 773           else DISCARD (1);
 774           break;
 775
 776         case Breturn:
 777           result = POP;
 778           goto exit;
 779
 780         case Bdiscard:
 781           DISCARD (1);
 782           break;
 783
 784         case Bconstant2:
 785           PUSH (vectorp[FETCH2]);
 786           break;
 787
 788         case Bsave_excursion:
 789           record_unwind_protect (save_excursion_restore,
 790                                  save_excursion_save ());
 791           break;
 792
 793         case Bsave_current_buffer:
 794         case Bsave_current_buffer_1:
 795           record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
 796           break;
 797
 798         case Bsave_window_excursion:
 799           BEFORE_POTENTIAL_GC ();
 800           TOP = Fsave_window_excursion (TOP);
 801           AFTER_POTENTIAL_GC ();
 802           break;
 803
 804         case Bsave_restriction:
 805           record_unwind_protect (save_restriction_restore,
 806                                  save_restriction_save ());
 807           break;
 808
 809         case Bcatch:
 810           {
 811             Lisp_Object v1;
 812             v1 = POP;
 813             BEFORE_POTENTIAL_GC ();
 814             TOP = internal_catch (TOP, Feval, v1);
 815             AFTER_POTENTIAL_GC ();
 816             break;
 817           }
 818
 819         case Bunwind_protect:
 820           record_unwind_protect (0, POP);
 821           (specpdl_ptr - 1)->symbol = Qnil;
 822           break;
 823
 824         case Bcondition_case:
 825           {
 826             Lisp_Object v1;
 827             v1 = POP;
 828             v1 = Fcons (POP, v1);
 829             BEFORE_POTENTIAL_GC ();
 830             TOP = Fcondition_case (Fcons (TOP, v1));
 831             AFTER_POTENTIAL_GC ();
 832             break;
 833           }
 834
 835         case Btemp_output_buffer_setup:
 836           BEFORE_POTENTIAL_GC ();
 837           temp_output_buffer_setup (XSTRING (TOP)->data);
 838           AFTER_POTENTIAL_GC ();
 839           TOP = Vstandard_output;
 840           break;
 841
 842         case Btemp_output_buffer_show:
 843           {
 844             Lisp_Object v1;
 845             v1 = POP;
 846             BEFORE_POTENTIAL_GC ();
 847             temp_output_buffer_show (TOP);
 848             TOP = v1;
 849             /* pop binding of standard-output */
 850             unbind_to (specpdl_ptr - specpdl - 1, Qnil);
 851             AFTER_POTENTIAL_GC ();
 852             break;
 853           }
 854
 855         case Bnth:
 856           {
 857             Lisp_Object v1, v2;
 858             v1 = POP;
 859             v2 = TOP;
 860             BEFORE_POTENTIAL_GC ();
 861             CHECK_NUMBER (v2, 0);
 862             AFTER_POTENTIAL_GC ();
 863             op = XINT (v2);
 864             immediate_quit = 1;
 865             while (--op >= 0)
 866               {
 867                 if (CONSP (v1))
 868                   v1 = XCDR (v1);
 869                 else if (!NILP (v1))
 870                   {
 871                     immediate_quit = 0;
 872                     BEFORE_POTENTIAL_GC ();
 873                     v1 = wrong_type_argument (Qlistp, v1);
 874                     AFTER_POTENTIAL_GC ();
 875                     immediate_quit = 1;
 876                     op++;
 877                   }
 878               }
 879             immediate_quit = 0;
 880             if (CONSP (v1))
 881               TOP = XCAR (v1);
 882             else if (NILP (v1))
 883               TOP = Qnil;
 884             else
 885               {
 886                 BEFORE_POTENTIAL_GC ();
 887                 Fcar (wrong_type_argument (Qlistp, v1));
 888                 AFTER_POTENTIAL_GC ();
 889               }
 890             break;
 891           }
 892
 893         case Bsymbolp:
 894           TOP = SYMBOLP (TOP) ? Qt : Qnil;
 895           break;
 896
 897         case Bconsp:
 898           TOP = CONSP (TOP) ? Qt : Qnil;
 899           break;
 900
 901         case Bstringp:
 902           TOP = STRINGP (TOP) ? Qt : Qnil;
 903           break;
 904
 905         case Blistp:
 906           TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
 907           break;
 908
 909         case Bnot:
 910           TOP = NILP (TOP) ? Qt : Qnil;
 911           break;
 912
 913         case Bcons:
 914           {
 915             Lisp_Object v1;
 916             v1 = POP;
 917             TOP = Fcons (TOP, v1);
 918             break;
 919           }
 920
 921         case Blist1:
 922           TOP = Fcons (TOP, Qnil);
 923           break;
 924
 925         case Blist2:
 926           {
 927             Lisp_Object v1;
 928             v1 = POP;
 929             TOP = Fcons (TOP, Fcons (v1, Qnil));
 930             break;
 931           }
 932
 933         case Blist3:
 934           DISCARD (2);
 935           TOP = Flist (3, &TOP);
 936           break;
 937
 938         case Blist4:
 939           DISCARD (3);
 940           TOP = Flist (4, &TOP);
 941           break;
 942
 943         case BlistN:
 944           op = FETCH;
 945           DISCARD (op - 1);
 946           TOP = Flist (op, &TOP);
 947           break;
 948
 949         case Blength:
 950           TOP = Flength (TOP);
 951           break;
 952
 953         case Baref:
 954           {
 955             Lisp_Object v1;
 956             v1 = POP;
 957             TOP = Faref (TOP, v1);
 958             break;
 959           }
 960
 961         case Baset:
 962           {
 963             Lisp_Object v1, v2;
 964             v2 = POP; v1 = POP;
 965             TOP = Faset (TOP, v1, v2);
 966             break;
 967           }
 968
 969         case Bsymbol_value:
 970           TOP = Fsymbol_value (TOP);
 971           break;
 972
 973         case Bsymbol_function:
 974           TOP = Fsymbol_function (TOP);
 975           break;
 976
 977         case Bset:
 978           {
 979             Lisp_Object v1;
 980             v1 = POP;
 981             TOP = Fset (TOP, v1);
 982             break;
 983           }
 984
 985         case Bfset:
 986           {
 987             Lisp_Object v1;
 988             v1 = POP;
 989             TOP = Ffset (TOP, v1);
 990             break;
 991           }
 992
 993         case Bget:
 994           {
 995             Lisp_Object v1;
 996             v1 = POP;
 997             TOP = Fget (TOP, v1);
 998             break;
 999           }
1000
1001         case Bsubstring:
1002           {
1003             Lisp_Object v1, v2;
1004             v2 = POP; v1 = POP;
1005             BEFORE_POTENTIAL_GC ();
1006             TOP = Fsubstring (TOP, v1, v2);
1007             AFTER_POTENTIAL_GC ();
1008             break;
1009           }
1010
1011         case Bconcat2:
1012           DISCARD (1);
1013           TOP = Fconcat (2, &TOP);
1014           break;
1015
1016         case Bconcat3:
1017           DISCARD (2);
1018           TOP = Fconcat (3, &TOP);
1019           break;
1020
1021         case Bconcat4:
1022           DISCARD (3);
1023           TOP = Fconcat (4, &TOP);
1024           break;
1025
1026         case BconcatN:
1027           op = FETCH;
1028           DISCARD (op - 1);
1029           TOP = Fconcat (op, &TOP);
1030           break;
1031
1032         case Bsub1:
1033           {
1034             Lisp_Object v1;
1035             v1 = TOP;
1036             if (INTEGERP (v1))
1037               {
1038                 XSETINT (v1, XINT (v1) - 1);
1039                 TOP = v1;
1040               }
1041             else
1042               TOP = Fsub1 (v1);
1043             break;
1044           }
1045
1046         case Badd1:
1047           {
1048             Lisp_Object v1;
1049             v1 = TOP;
1050             if (INTEGERP (v1))
1051               {
1052                 XSETINT (v1, XINT (v1) + 1);
1053                 TOP = v1;
1054               }
1055             else
1056               TOP = Fadd1 (v1);
1057             break;
1058           }
1059
1060         case Beqlsign:
1061           {
1062             Lisp_Object v1, v2;
1063             v2 = POP; v1 = TOP;
1064             BEFORE_POTENTIAL_GC ();
1065             CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0);
1066             CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0);
1067             AFTER_POTENTIAL_GC ();
1068             if (FLOATP (v1) || FLOATP (v2))
1069               {
1070                 double f1, f2;
1071
1072                 f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1));
1073                 f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
1074                 TOP = (f1 == f2 ? Qt : Qnil);
1075               }
1076             else
1077               TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
1078             break;
1079           }
1080
1081         case Bgtr:
1082           {
1083             Lisp_Object v1;
1084             v1 = POP;
1085             TOP = Fgtr (TOP, v1);
1086             break;
1087           }
1088
1089         case Blss:
1090           {
1091             Lisp_Object v1;
1092             v1 = POP;
1093             TOP = Flss (TOP, v1);
1094             break;
1095           }
1096
1097         case Bleq:
1098           {
1099             Lisp_Object v1;
1100             v1 = POP;
1101             TOP = Fleq (TOP, v1);
1102             break;
1103           }
1104
1105         case Bgeq:
1106           {
1107             Lisp_Object v1;
1108             v1 = POP;
1109             TOP = Fgeq (TOP, v1);
1110             break;
1111           }
1112
1113         case Bdiff:
1114           DISCARD (1);
1115           TOP = Fminus (2, &TOP);
1116           break;
1117
1118         case Bnegate:
1119           {
1120             Lisp_Object v1;
1121             v1 = TOP;
1122             if (INTEGERP (v1))
1123               {
1124                 XSETINT (v1, - XINT (v1));
1125                 TOP = v1;
1126               }
1127             else
1128               TOP = Fminus (1, &TOP);
1129             break;
1130           }
1131
1132         case Bplus:
1133           DISCARD (1);
1134           TOP = Fplus (2, &TOP);
1135           break;
1136
1137         case Bmax:
1138           DISCARD (1);
1139           TOP = Fmax (2, &TOP);
1140           break;
1141
1142         case Bmin:
1143           DISCARD (1);
1144           TOP = Fmin (2, &TOP);
1145           break;
1146
1147         case Bmult:
1148           DISCARD (1);
1149           TOP = Ftimes (2, &TOP);
1150           break;
1151
1152         case Bquo:
1153           DISCARD (1);
1154           TOP = Fquo (2, &TOP);
1155           break;
1156
1157         case Brem:
1158           {
1159             Lisp_Object v1;
1160             v1 = POP;
1161             TOP = Frem (TOP, v1);
1162             break;
1163           }
1164
1165         case Bpoint:
1166           {
1167             Lisp_Object v1;
1168             XSETFASTINT (v1, PT);
1169             PUSH (v1);
1170             break;
1171           }
1172
1173         case Bgoto_char:
1174           BEFORE_POTENTIAL_GC ();
1175           TOP = Fgoto_char (TOP);
1176           AFTER_POTENTIAL_GC ();
1177           break;
1178
1179         case Binsert:
1180           BEFORE_POTENTIAL_GC ();
1181           TOP = Finsert (1, &TOP);
1182           AFTER_POTENTIAL_GC ();
1183           break;
1184
1185         case BinsertN:
1186           op = FETCH;
1187           BEFORE_POTENTIAL_GC ();
1188           DISCARD (op - 1);
1189           TOP = Finsert (op, &TOP);
1190           AFTER_POTENTIAL_GC ();
1191           break;
1192
1193         case Bpoint_max:
1194           {
1195             Lisp_Object v1;
1196             XSETFASTINT (v1, ZV);
1197             PUSH (v1);
1198             break;
1199           }
1200
1201         case Bpoint_min:
1202           {
1203             Lisp_Object v1;
1204             XSETFASTINT (v1, BEGV);
1205             PUSH (v1);
1206             break;
1207           }
1208
1209         case Bchar_after:
1210           TOP = Fchar_after (TOP);
1211           break;
1212
1213         case Bfollowing_char:
1214           {
1215             Lisp_Object v1;
1216             v1 = Ffollowing_char ();
1217             PUSH (v1);
1218             break;
1219           }
1220
1221         case Bpreceding_char:
1222           {
1223             Lisp_Object v1;
1224             v1 = Fprevious_char ();
1225             PUSH (v1);
1226             break;
1227           }
1228
1229         case Bcurrent_column:
1230           {
1231             Lisp_Object v1;
1232             XSETFASTINT (v1, current_column ());
1233             PUSH (v1);
1234             break;
1235           }
1236
1237         case Bindent_to:
1238           BEFORE_POTENTIAL_GC ();
1239           TOP = Findent_to (TOP, Qnil);
1240           AFTER_POTENTIAL_GC ();
1241           break;
1242
1243         case Beolp:
1244           PUSH (Feolp ());
1245           break;
1246
1247         case Beobp:
1248           PUSH (Feobp ());
1249           break;
1250
1251         case Bbolp:
1252           PUSH (Fbolp ());
1253           break;
1254
1255         case Bbobp:
1256           PUSH (Fbobp ());
1257           break;
1258
1259         case Bcurrent_buffer:
1260           PUSH (Fcurrent_buffer ());
1261           break;
1262
1263         case Bset_buffer:
1264           BEFORE_POTENTIAL_GC ();
1265           TOP = Fset_buffer (TOP);
1266           AFTER_POTENTIAL_GC ();
1267           break;
1268
1269         case Binteractive_p:
1270           PUSH (Finteractive_p ());
1271           break;
1272
1273         case Bforward_char:
1274           BEFORE_POTENTIAL_GC ();
1275           TOP = Fforward_char (TOP);
1276           AFTER_POTENTIAL_GC ();
1277           break;
1278
1279         case Bforward_word:
1280           BEFORE_POTENTIAL_GC ();
1281           TOP = Fforward_word (TOP);
1282           AFTER_POTENTIAL_GC ();
1283           break;
1284
1285         case Bskip_chars_forward:
1286           {
1287             Lisp_Object v1;
1288             v1 = POP;
1289             BEFORE_POTENTIAL_GC ();
1290             TOP = Fskip_chars_forward (TOP, v1);
1291             AFTER_POTENTIAL_GC ();
1292             break;
1293           }
1294
1295         case Bskip_chars_backward:
1296           {
1297             Lisp_Object v1;
1298             v1 = POP;
1299             BEFORE_POTENTIAL_GC ();
1300             TOP = Fskip_chars_backward (TOP, v1);
1301             AFTER_POTENTIAL_GC ();
1302             break;
1303           }
1304
1305         case Bforward_line:
1306           BEFORE_POTENTIAL_GC ();
1307           TOP = Fforward_line (TOP);
1308           AFTER_POTENTIAL_GC ();
1309           break;
1310
1311         case Bchar_syntax:
1312           BEFORE_POTENTIAL_GC ();
1313           CHECK_NUMBER (TOP, 0);
1314           AFTER_POTENTIAL_GC ();
1315           XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (XINT (TOP))]);
1316           break;
1317
1318         case Bbuffer_substring:
1319           {
1320             Lisp_Object v1;
1321             v1 = POP;
1322             BEFORE_POTENTIAL_GC ();
1323             TOP = Fbuffer_substring (TOP, v1);
1324             AFTER_POTENTIAL_GC ();
1325             break;
1326           }
1327
1328         case Bdelete_region:
1329           {
1330             Lisp_Object v1;
1331             v1 = POP;
1332             BEFORE_POTENTIAL_GC ();
1333             TOP = Fdelete_region (TOP, v1);
1334             AFTER_POTENTIAL_GC ();
1335             break;
1336           }
1337
1338         case Bnarrow_to_region:
1339           {
1340             Lisp_Object v1;
1341             v1 = POP;
1342             BEFORE_POTENTIAL_GC ();
1343             TOP = Fnarrow_to_region (TOP, v1);
1344             AFTER_POTENTIAL_GC ();
1345             break;
1346           }
1347
1348         case Bwiden:
1349           BEFORE_POTENTIAL_GC ();
1350           PUSH (Fwiden ());
1351           AFTER_POTENTIAL_GC ();
1352           break;
1353
1354         case Bend_of_line:
1355           BEFORE_POTENTIAL_GC ();
1356           TOP = Fend_of_line (TOP);
1357           AFTER_POTENTIAL_GC ();
1358           break;
1359
1360         case Bset_marker:
1361           {
1362             Lisp_Object v1, v2;
1363             v1 = POP;
1364             v2 = POP;
1365             TOP = Fset_marker (TOP, v2, v1);
1366             break;
1367           }
1368
1369         case Bmatch_beginning:
1370           TOP = Fmatch_beginning (TOP);
1371           break;
1372
1373         case Bmatch_end:
1374           TOP = Fmatch_end (TOP);
1375           break;
1376
1377         case Bupcase:
1378           TOP = Fupcase (TOP);
1379           break;
1380
1381         case Bdowncase:
1382           TOP = Fdowncase (TOP);
1383         break;
1384
1385         case Bstringeqlsign:
1386           {
1387             Lisp_Object v1;
1388             v1 = POP;
1389             TOP = Fstring_equal (TOP, v1);
1390             break;
1391           }
1392
1393         case Bstringlss:
1394           {
1395             Lisp_Object v1;
1396             v1 = POP;
1397             TOP = Fstring_lessp (TOP, v1);
1398             break;
1399           }
1400
1401         case Bequal:
1402           {
1403             Lisp_Object v1;
1404             v1 = POP;
1405             TOP = Fequal (TOP, v1);
1406             break;
1407           }
1408
1409         case Bnthcdr:
1410           {
1411             Lisp_Object v1;
1412             v1 = POP;
1413             TOP = Fnthcdr (TOP, v1);
1414             break;
1415           }
1416
1417         case Belt:
1418           {
1419             Lisp_Object v1, v2;
1420             if (CONSP (TOP))
1421               {
1422                 /* Exchange args and then do nth.  */
1423                 v2 = POP;
1424                 v1 = TOP;
1425                 BEFORE_POTENTIAL_GC ();
1426                 CHECK_NUMBER (v2, 0);
1427                 AFTER_POTENTIAL_GC ();
1428                 op = XINT (v2);
1429                 immediate_quit = 1;
1430                 while (--op >= 0)
1431                   {
1432                     if (CONSP (v1))
1433                       v1 = XCDR (v1);
1434                     else if (!NILP (v1))
1435                       {
1436                         immediate_quit = 0;
1437                         BEFORE_POTENTIAL_GC ();
1438                         v1 = wrong_type_argument (Qlistp, v1);
1439                         AFTER_POTENTIAL_GC ();
1440                         immediate_quit = 1;
1441                         op++;
1442                       }
1443                   }
1444                 immediate_quit = 0;
1445                 if (CONSP (v1))
1446                   TOP = XCAR (v1);
1447                 else if (NILP (v1))
1448                   TOP = Qnil;
1449                 else
1450                   {
1451                     BEFORE_POTENTIAL_GC ();
1452                     Fcar (wrong_type_argument (Qlistp, v1));
1453                     AFTER_POTENTIAL_GC ();
1454                   }
1455               }
1456             else
1457               {
1458                 v1 = POP;
1459                 TOP = Felt (TOP, v1);
1460               }
1461             break;
1462           }
1463
1464         case Bmember:
1465           {
1466             Lisp_Object v1;
1467             v1 = POP;
1468             TOP = Fmember (TOP, v1);
1469             break;
1470           }
1471
1472         case Bassq:
1473           {
1474             Lisp_Object v1;
1475             v1 = POP;
1476             TOP = Fassq (TOP, v1);
1477             break;
1478           }
1479
1480         case Bnreverse:
1481           TOP = Fnreverse (TOP);
1482           break;
1483
1484         case Bsetcar:
1485           {
1486             Lisp_Object v1;
1487             v1 = POP;
1488             TOP = Fsetcar (TOP, v1);
1489             break;
1490           }
1491
1492         case Bsetcdr:
1493           {
1494             Lisp_Object v1;
1495             v1 = POP;
1496             TOP = Fsetcdr (TOP, v1);
1497             break;
1498           }
1499
1500         case Bcar_safe:
1501           {
1502             Lisp_Object v1;
1503             v1 = TOP;
1504             if (CONSP (v1))
1505               TOP = XCAR (v1);
1506             else
1507               TOP = Qnil;
1508             break;
1509           }
1510
1511         case Bcdr_safe:
1512           {
1513             Lisp_Object v1;
1514             v1 = TOP;
1515             if (CONSP (v1))
1516               TOP = XCDR (v1);
1517             else
1518               TOP = Qnil;
1519             break;
1520           }
1521
1522         case Bnconc:
1523           DISCARD (1);
1524           TOP = Fnconc (2, &TOP);
1525           break;
1526
1527         case Bnumberp:
1528           TOP = (NUMBERP (TOP) ? Qt : Qnil);
1529           break;
1530
1531         case Bintegerp:
1532           TOP = INTEGERP (TOP) ? Qt : Qnil;
1533           break;
1534
1535 #ifdef BYTE_CODE_SAFE
1536         case Bset_mark:
1537           BEFORE_POTENTIAL_GC ();
1538           error ("set-mark is an obsolete bytecode");
1539           AFTER_POTENTIAL_GC ();
1540           break;
1541         case Bscan_buffer:
1542           BEFORE_POTENTIAL_GC ();
1543           error ("scan-buffer is an obsolete bytecode");
1544           AFTER_POTENTIAL_GC ();
1545           break;
1546 #endif
1547
1548         case 0:
1549           abort ();
1550
1551         case 255:
1552         default:
1553 #ifdef BYTE_CODE_SAFE
1554           if (op < Bconstant)
1555             {
1556               abort ();
1557             }
1558           if ((op -= Bconstant) >= const_length)
1559             {
1560               abort ();
1561             }
1562           PUSH (vectorp[op]);
1563 #else
1564           PUSH (vectorp[op - Bconstant]);
1565 #endif
1566         }
1567     }
1568
1569  exit:
1570
1571   byte_stack_list = byte_stack_list->next;
1572
1573   /* Binds and unbinds are supposed to be compiled balanced.  */
1574   if (specpdl_ptr - specpdl != count)
1575 #ifdef BYTE_CODE_SAFE
1576     error ("binding stack not balanced (serious byte compiler bug)");
1577 #else
1578     abort ();
1579 #endif
1580
1581   return result;
1582 }
1583
1584 void
1585 syms_of_bytecode ()
1586 {
1587   Qbytecode = intern ("byte-code");
1588   staticpro (&Qbytecode);
1589
1590   defsubr (&Sbyte_code);
1591
1592 #ifdef BYTE_CODE_METER
1593
1594   DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
1595    "A vector of vectors which holds a histogram of byte-code usage.\n\
1596 (aref (aref byte-code-meter 0) CODE) indicates how many times the byte\n\
1597 opcode CODE has been executed.\n\
1598 (aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,\n\
1599 indicates how many times the byte opcodes CODE1 and CODE2 have been\n\
1600 executed in succession.");
1601   DEFVAR_BOOL ("byte-metering-on", &byte_metering_on,
1602    "If non-nil, keep profiling information on byte code usage.\n\
1603 The variable byte-code-meter indicates how often each byte opcode is used.\n\
1604 If a symbol has a property named `byte-code-meter' whose value is an\n\
1605 integer, it is incremented each time that symbol's function is called.");
1606
1607   byte_metering_on = 0;
1608   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
1609   Qbyte_code_meter = intern ("byte-code-meter");
1610   staticpro (&Qbyte_code_meter);
1611   {
1612     int i = 256;
1613     while (i--)
1614       XVECTOR (Vbyte_code_meter)->contents[i] =
1615         Fmake_vector (make_number (256), make_number (0));
1616   }
1617 #endif
1618 }