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