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 \f
 228 /* Fetch the next byte from the bytecode stream */
 229
 230 #define FETCH *pc++
 231
 232 /* Fetch two bytes from the bytecode stream
 233  and make a 16-bit number out of them */
 234
 235 #define FETCH2 (op = FETCH, op + (FETCH << 8))
 236
 237 /* Push x onto the execution stack. */
 238
 239 /* This used to be #define PUSH(x) (*++stackp = (x))
 240    This oddity is necessary because Alliant can't be bothered to
 241    compile the preincrement operator properly, as of 4/91.  -JimB  */
 242 #define PUSH(x) (stackp++, *stackp = (x))
 243
 244 /* Pop a value off the execution stack.  */
 245
 246 #define POP (*stackp--)
 247
 248 /* Discard n values from the execution stack.  */
 249
 250 #define DISCARD(n) (stackp -= (n))
 251
 252 /* Get the value which is at the top of the execution stack, but don't pop it. */
 253
 254 #define TOP (*stackp)
 255
 256 /* Garbage collect if we have consed enough since the last time.
 257    We do this at every branch, to avoid loops that never GC.  */
 258
 259 #define MAYBE_GC()                              \
 260   if (consing_since_gc > gc_cons_threshold)     \
 261     {                                           \
 262       Fgarbage_collect ();                      \
 263       HANDLE_RELOCATION ();                     \
 264     }                                           \
 265   else
 266
 267 /* Relocate BYTESTR if there has been a GC recently.  */
 268 #define HANDLE_RELOCATION()                                             \
 269   if (! EQ (string_saved, bytestr))                                     \
 270     {                                                                   \
 271       pc = pc - XSTRING (string_saved)->data + XSTRING (bytestr)->data; \
 272       string_saved = bytestr;                                           \
 273     }                                                                   \
 274   else
 275
 276 /* Check for jumping out of range.  */
 277 #define CHECK_RANGE(ARG)                        \
 278   if (ARG >= bytestr_length) abort ()
 279
 280 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
 281   "Function used internally in byte-compiled code.\n\
 282 The first argument, BYTESTR, is a string of byte code;\n\
 283 the second, VECTOR, a vector of constants;\n\
 284 the third, MAXDEPTH, the maximum stack depth used in this function.\n\
 285 If the third argument is incorrect, Emacs may crash.")
 286   (bytestr, vector, maxdepth)
 287      Lisp_Object bytestr, vector, maxdepth;
 288 {
 289   struct gcpro gcpro1, gcpro2, gcpro3;
 290   int count = specpdl_ptr - specpdl;
 291 #ifdef BYTE_CODE_METER
 292   int this_op = 0;
 293   int prev_op;
 294 #endif
 295   register int op;
 296   unsigned char *pc;
 297   Lisp_Object *stack;
 298   register Lisp_Object *stackp;
 299   Lisp_Object *stacke;
 300   register Lisp_Object v1, v2;
 301   register Lisp_Object *vectorp = XVECTOR (vector)->contents;
 302 #ifdef BYTE_CODE_SAFE
 303   register int const_length = XVECTOR (vector)->size;
 304 #endif
 305   /* Copy of BYTESTR, saved so we can tell if BYTESTR was relocated.  */
 306   Lisp_Object string_saved;
 307   /* Cached address of beginning of string,
 308      valid if BYTESTR equals STRING_SAVED.  */
 309   register unsigned char *strbeg;
 310   int bytestr_length = STRING_BYTES (XSTRING (bytestr));
 311
 312   CHECK_STRING (bytestr, 0);
 313   if (!VECTORP (vector))
 314     vector = wrong_type_argument (Qvectorp, vector);
 315   CHECK_NUMBER (maxdepth, 2);
 316
 317   stackp = (Lisp_Object *) alloca (XFASTINT (maxdepth) * sizeof (Lisp_Object));
 318   bzero (stackp, XFASTINT (maxdepth) * sizeof (Lisp_Object));
 319   GCPRO3 (bytestr, vector, *stackp);
 320   gcpro3.nvars = XFASTINT (maxdepth);
 321
 322   --stackp;
 323   stack = stackp;
 324   stacke = stackp + XFASTINT (maxdepth);
 325
 326   /* Initialize the saved pc-pointer for fetching from the string.  */
 327   string_saved = bytestr;
 328   pc = XSTRING (string_saved)->data;
 329
 330   while (1)
 331     {
 332 #ifdef BYTE_CODE_SAFE
 333       if (stackp > stacke)
 334         error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d",
 335                pc - XSTRING (string_saved)->data, stacke - stackp);
 336       if (stackp < stack)
 337         error ("Byte code stack underflow (byte compiler bug), pc %d",
 338                pc - XSTRING (string_saved)->data);
 339 #endif
 340
 341       /* Update BYTESTR if we had a garbage collection.  */
 342       HANDLE_RELOCATION ();
 343
 344 #ifdef BYTE_CODE_METER
 345       prev_op = this_op;
 346       this_op = op = FETCH;
 347       METER_CODE (prev_op, op);
 348       switch (op)
 349 #else
 350       switch (op = FETCH)
 351 #endif
 352         {
 353         case Bvarref+6:
 354           op = FETCH;
 355           goto varref;
 356
 357         case Bvarref+7:
 358           op = FETCH2;
 359           goto varref;
 360
 361         case Bvarref: case Bvarref+1: case Bvarref+2: case Bvarref+3:
 362         case Bvarref+4: case Bvarref+5:
 363           op = op - Bvarref;
 364         varref:
 365           v1 = vectorp[op];
 366           if (!SYMBOLP (v1))
 367             v2 = Fsymbol_value (v1);
 368           else
 369             {
 370               v2 = XSYMBOL (v1)->value;
 371               if (MISCP (v2) || EQ (v2, Qunbound))
 372                 v2 = Fsymbol_value (v1);
 373             }
 374           PUSH (v2);
 375           break;
 376
 377         case Bvarset+6:
 378           op = FETCH;
 379           goto varset;
 380
 381         case Bvarset+7:
 382           op = FETCH2;
 383           goto varset;
 384
 385         case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3:
 386         case Bvarset+4: case Bvarset+5:
 387           op -= Bvarset;
 388         varset:
 389           Fset (vectorp[op], POP);
 390           break;
 391
 392         case Bvarbind+6:
 393           op = FETCH;
 394           goto varbind;
 395
 396         case Bvarbind+7:
 397           op = FETCH2;
 398           goto varbind;
 399
 400         case Bvarbind: case Bvarbind+1: case Bvarbind+2: case Bvarbind+3:
 401         case Bvarbind+4: case Bvarbind+5:
 402           op -= Bvarbind;
 403         varbind:
 404           specbind (vectorp[op], POP);
 405           break;
 406
 407         case Bcall+6:
 408           op = FETCH;
 409           goto docall;
 410
 411         case Bcall+7:
 412           op = FETCH2;
 413           goto docall;
 414
 415         case Bcall: case Bcall+1: case Bcall+2: case Bcall+3:
 416         case Bcall+4: case Bcall+5:
 417           op -= Bcall;
 418         docall:
 419           DISCARD (op);
 420 #ifdef BYTE_CODE_METER
 421           if (byte_metering_on && SYMBOLP (TOP))
 422             {
 423               v1 = TOP;
 424               v2 = Fget (v1, Qbyte_code_meter);
 425               if (INTEGERP (v2)
 426                   && XINT (v2) != ((1<<VALBITS)-1))
 427                 {
 428                   XSETINT (v2, XINT (v2) + 1);
 429                   Fput (v1, Qbyte_code_meter, v2);
 430                 }
 431             }
 432 #endif
 433           TOP = Ffuncall (op + 1, &TOP);
 434           break;
 435
 436         case Bunbind+6:
 437           op = FETCH;
 438           goto dounbind;
 439
 440         case Bunbind+7:
 441           op = FETCH2;
 442           goto dounbind;
 443
 444         case Bunbind: case Bunbind+1: case Bunbind+2: case Bunbind+3:
 445         case Bunbind+4: case Bunbind+5:
 446           op -= Bunbind;
 447         dounbind:
 448           unbind_to (specpdl_ptr - specpdl - op, Qnil);
 449           break;
 450
 451         case Bunbind_all:
 452           /* To unbind back to the beginning of this frame.  Not used yet,
 453              but will be needed for tail-recursion elimination.  */
 454           unbind_to (count, Qnil);
 455           break;
 456
 457         case Bgoto:
 458           MAYBE_GC ();
 459           QUIT;
 460           op = FETCH2;    /* pc = FETCH2 loses since FETCH2 contains pc++ */
 461           CHECK_RANGE (op);
 462           pc = XSTRING (string_saved)->data + op;
 463           break;
 464
 465         case Bgotoifnil:
 466           MAYBE_GC ();
 467           op = FETCH2;
 468           if (NILP (POP))
 469             {
 470               QUIT;
 471               CHECK_RANGE (op);
 472               pc = XSTRING (string_saved)->data + op;
 473             }
 474           break;
 475
 476         case Bgotoifnonnil:
 477           MAYBE_GC ();
 478           op = FETCH2;
 479           if (!NILP (POP))
 480             {
 481               QUIT;
 482               CHECK_RANGE (op);
 483               pc = XSTRING (string_saved)->data + op;
 484             }
 485           break;
 486
 487         case Bgotoifnilelsepop:
 488           MAYBE_GC ();
 489           op = FETCH2;
 490           if (NILP (TOP))
 491             {
 492               QUIT;
 493               CHECK_RANGE (op);
 494               pc = XSTRING (string_saved)->data + op;
 495             }
 496           else DISCARD (1);
 497           break;
 498
 499         case Bgotoifnonnilelsepop:
 500           MAYBE_GC ();
 501           op = FETCH2;
 502           if (!NILP (TOP))
 503             {
 504               QUIT;
 505               CHECK_RANGE (op);
 506               pc = XSTRING (string_saved)->data + op;
 507             }
 508           else DISCARD (1);
 509           break;
 510
 511         case BRgoto:
 512           MAYBE_GC ();
 513           QUIT;
 514           pc += (int) *pc - 127;
 515           break;
 516
 517         case BRgotoifnil:
 518           MAYBE_GC ();
 519           if (NILP (POP))
 520             {
 521               QUIT;
 522               pc += (int) *pc - 128;
 523             }
 524           pc++;
 525           break;
 526
 527         case BRgotoifnonnil:
 528           MAYBE_GC ();
 529           if (!NILP (POP))
 530             {
 531               QUIT;
 532               pc += (int) *pc - 128;
 533             }
 534           pc++;
 535           break;
 536
 537         case BRgotoifnilelsepop:
 538           MAYBE_GC ();
 539           op = *pc++;
 540           if (NILP (TOP))
 541             {
 542               QUIT;
 543               pc += op - 128;
 544             }
 545           else DISCARD (1);
 546           break;
 547
 548         case BRgotoifnonnilelsepop:
 549           MAYBE_GC ();
 550           op = *pc++;
 551           if (!NILP (TOP))
 552             {
 553               QUIT;
 554               pc += op - 128;
 555             }
 556           else DISCARD (1);
 557           break;
 558
 559         case Breturn:
 560           v1 = POP;
 561           goto exit;
 562
 563         case Bdiscard:
 564           DISCARD (1);
 565           break;
 566
 567         case Bdup:
 568           v1 = TOP;
 569           PUSH (v1);
 570           break;
 571
 572         case Bconstant2:
 573           PUSH (vectorp[FETCH2]);
 574           break;
 575
 576         case Bsave_excursion:
 577           record_unwind_protect (save_excursion_restore, save_excursion_save ());
 578           break;
 579
 580         case Bsave_current_buffer:
 581         case Bsave_current_buffer_1:
 582           record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
 583           break;
 584
 585         case Bsave_window_excursion:
 586           TOP = Fsave_window_excursion (TOP);
 587           break;
 588
 589         case Bsave_restriction:
 590           record_unwind_protect (save_restriction_restore, save_restriction_save ());
 591           break;
 592
 593         case Bcatch:
 594           v1 = POP;
 595           TOP = internal_catch (TOP, Feval, v1);
 596           break;
 597
 598         case Bunwind_protect:
 599           record_unwind_protect (0, POP);
 600           (specpdl_ptr - 1)->symbol = Qnil;
 601           break;
 602
 603         case Bcondition_case:
 604           v1 = POP;
 605           v1 = Fcons (POP, v1);
 606           TOP = Fcondition_case (Fcons (TOP, v1));
 607           break;
 608
 609         case Btemp_output_buffer_setup:
 610           temp_output_buffer_setup (XSTRING (TOP)->data);
 611           TOP = Vstandard_output;
 612           break;
 613
 614         case Btemp_output_buffer_show:
 615           v1 = POP;
 616           temp_output_buffer_show (TOP);
 617           TOP = v1;
 618           /* pop binding of standard-output */
 619           unbind_to (specpdl_ptr - specpdl - 1, Qnil);
 620           break;
 621
 622         case Bnth:
 623           v1 = POP;
 624           v2 = TOP;
 625         nth_entry:
 626           CHECK_NUMBER (v2, 0);
 627           op = XINT (v2);
 628           immediate_quit = 1;
 629           while (--op >= 0)
 630             {
 631               if (CONSP (v1))
 632                 v1 = XCDR (v1);
 633               else if (!NILP (v1))
 634                 {
 635                   immediate_quit = 0;
 636                   v1 = wrong_type_argument (Qlistp, v1);
 637                   immediate_quit = 1;
 638                   op++;
 639                 }
 640             }
 641           immediate_quit = 0;
 642           goto docar;
 643
 644         case Bsymbolp:
 645           TOP = SYMBOLP (TOP) ? Qt : Qnil;
 646           break;
 647
 648         case Bconsp:
 649           TOP = CONSP (TOP) ? Qt : Qnil;
 650           break;
 651
 652         case Bstringp:
 653           TOP = STRINGP (TOP) ? Qt : Qnil;
 654           break;
 655
 656         case Blistp:
 657           TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
 658           break;
 659
 660         case Beq:
 661           v1 = POP;
 662           TOP = EQ (v1, TOP) ? Qt : Qnil;
 663           break;
 664
 665         case Bmemq:
 666           v1 = POP;
 667           TOP = Fmemq (TOP, v1);
 668           break;
 669
 670         case Bnot:
 671           TOP = NILP (TOP) ? Qt : Qnil;
 672           break;
 673
 674         case Bcar:
 675           v1 = TOP;
 676         docar:
 677           if (CONSP (v1)) TOP = XCAR (v1);
 678           else if (NILP (v1)) TOP = Qnil;
 679           else Fcar (wrong_type_argument (Qlistp, v1));
 680           break;
 681
 682         case Bcdr:
 683           v1 = TOP;
 684           if (CONSP (v1)) TOP = XCDR (v1);
 685           else if (NILP (v1)) TOP = Qnil;
 686           else Fcdr (wrong_type_argument (Qlistp, v1));
 687           break;
 688
 689         case Bcons:
 690           v1 = POP;
 691           TOP = Fcons (TOP, v1);
 692           break;
 693
 694         case Blist1:
 695           TOP = Fcons (TOP, Qnil);
 696           break;
 697
 698         case Blist2:
 699           v1 = POP;
 700           TOP = Fcons (TOP, Fcons (v1, Qnil));
 701           break;
 702
 703         case Blist3:
 704           DISCARD (2);
 705           TOP = Flist (3, &TOP);
 706           break;
 707
 708         case Blist4:
 709           DISCARD (3);
 710           TOP = Flist (4, &TOP);
 711           break;
 712
 713         case BlistN:
 714           op = FETCH;
 715           DISCARD (op - 1);
 716           TOP = Flist (op, &TOP);
 717           break;
 718
 719         case Blength:
 720           TOP = Flength (TOP);
 721           break;
 722
 723         case Baref:
 724           v1 = POP;
 725           TOP = Faref (TOP, v1);
 726           break;
 727
 728         case Baset:
 729           v2 = POP; v1 = POP;
 730           TOP = Faset (TOP, v1, v2);
 731           break;
 732
 733         case Bsymbol_value:
 734           TOP = Fsymbol_value (TOP);
 735           break;
 736
 737         case Bsymbol_function:
 738           TOP = Fsymbol_function (TOP);
 739           break;
 740
 741         case Bset:
 742           v1 = POP;
 743           TOP = Fset (TOP, v1);
 744           break;
 745
 746         case Bfset:
 747           v1 = POP;
 748           TOP = Ffset (TOP, v1);
 749           break;
 750
 751         case Bget:
 752           v1 = POP;
 753           TOP = Fget (TOP, v1);
 754           break;
 755
 756         case Bsubstring:
 757           v2 = POP; v1 = POP;
 758           TOP = Fsubstring (TOP, v1, v2);
 759           break;
 760
 761         case Bconcat2:
 762           DISCARD (1);
 763           TOP = Fconcat (2, &TOP);
 764           break;
 765
 766         case Bconcat3:
 767           DISCARD (2);
 768           TOP = Fconcat (3, &TOP);
 769           break;
 770
 771         case Bconcat4:
 772           DISCARD (3);
 773           TOP = Fconcat (4, &TOP);
 774           break;
 775
 776         case BconcatN:
 777           op = FETCH;
 778           DISCARD (op - 1);
 779           TOP = Fconcat (op, &TOP);
 780           break;
 781
 782         case Bsub1:
 783           v1 = TOP;
 784           if (INTEGERP (v1))
 785             {
 786               XSETINT (v1, XINT (v1) - 1);
 787               TOP = v1;
 788             }
 789           else
 790             TOP = Fsub1 (v1);
 791           break;
 792
 793         case Badd1:
 794           v1 = TOP;
 795           if (INTEGERP (v1))
 796             {
 797               XSETINT (v1, XINT (v1) + 1);
 798               TOP = v1;
 799             }
 800           else
 801             TOP = Fadd1 (v1);
 802           break;
 803
 804         case Beqlsign:
 805           v2 = POP; v1 = TOP;
 806           CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0);
 807           CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0);
 808 #ifdef LISP_FLOAT_TYPE
 809           if (FLOATP (v1) || FLOATP (v2))
 810             {
 811               double f1, f2;
 812
 813               f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1));
 814               f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
 815               TOP = (f1 == f2 ? Qt : Qnil);
 816             }
 817           else
 818 #endif
 819             TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
 820           break;
 821
 822         case Bgtr:
 823           v1 = POP;
 824           TOP = Fgtr (TOP, v1);
 825           break;
 826
 827         case Blss:
 828           v1 = POP;
 829           TOP = Flss (TOP, v1);
 830           break;
 831
 832         case Bleq:
 833           v1 = POP;
 834           TOP = Fleq (TOP, v1);
 835           break;
 836
 837         case Bgeq:
 838           v1 = POP;
 839           TOP = Fgeq (TOP, v1);
 840           break;
 841
 842         case Bdiff:
 843           DISCARD (1);
 844           TOP = Fminus (2, &TOP);
 845           break;
 846
 847         case Bnegate:
 848           v1 = TOP;
 849           if (INTEGERP (v1))
 850             {
 851               XSETINT (v1, - XINT (v1));
 852               TOP = v1;
 853             }
 854           else
 855             TOP = Fminus (1, &TOP);
 856           break;
 857
 858         case Bplus:
 859           DISCARD (1);
 860           TOP = Fplus (2, &TOP);
 861           break;
 862
 863         case Bmax:
 864           DISCARD (1);
 865           TOP = Fmax (2, &TOP);
 866           break;
 867
 868         case Bmin:
 869           DISCARD (1);
 870           TOP = Fmin (2, &TOP);
 871           break;
 872
 873         case Bmult:
 874           DISCARD (1);
 875           TOP = Ftimes (2, &TOP);
 876           break;
 877
 878         case Bquo:
 879           DISCARD (1);
 880           TOP = Fquo (2, &TOP);
 881           break;
 882
 883         case Brem:
 884           v1 = POP;
 885           TOP = Frem (TOP, v1);
 886           break;
 887
 888         case Bpoint:
 889           XSETFASTINT (v1, PT);
 890           PUSH (v1);
 891           break;
 892
 893         case Bgoto_char:
 894           TOP = Fgoto_char (TOP);
 895           break;
 896
 897         case Binsert:
 898           TOP = Finsert (1, &TOP);
 899           break;
 900
 901         case BinsertN:
 902           op = FETCH;
 903           DISCARD (op - 1);
 904           TOP = Finsert (op, &TOP);
 905           break;
 906
 907         case Bpoint_max:
 908           XSETFASTINT (v1, ZV);
 909           PUSH (v1);
 910           break;
 911
 912         case Bpoint_min:
 913           XSETFASTINT (v1, BEGV);
 914           PUSH (v1);
 915           break;
 916
 917         case Bchar_after:
 918           TOP = Fchar_after (TOP);
 919           break;
 920
 921         case Bfollowing_char:
 922           v1 = Ffollowing_char ();
 923           PUSH (v1);
 924           break;
 925
 926         case Bpreceding_char:
 927           v1 = Fprevious_char ();
 928           PUSH (v1);
 929           break;
 930
 931         case Bcurrent_column:
 932           XSETFASTINT (v1, current_column ());
 933           PUSH (v1);
 934           break;
 935
 936         case Bindent_to:
 937           TOP = Findent_to (TOP, Qnil);
 938           break;
 939
 940         case Beolp:
 941           PUSH (Feolp ());
 942           break;
 943
 944         case Beobp:
 945           PUSH (Feobp ());
 946           break;
 947
 948         case Bbolp:
 949           PUSH (Fbolp ());
 950           break;
 951
 952         case Bbobp:
 953           PUSH (Fbobp ());
 954           break;
 955
 956         case Bcurrent_buffer:
 957           PUSH (Fcurrent_buffer ());
 958           break;
 959
 960         case Bset_buffer:
 961           TOP = Fset_buffer (TOP);
 962           break;
 963
 964         case Binteractive_p:
 965           PUSH (Finteractive_p ());
 966           break;
 967
 968         case Bforward_char:
 969           TOP = Fforward_char (TOP);
 970           break;
 971
 972         case Bforward_word:
 973           TOP = Fforward_word (TOP);
 974           break;
 975
 976         case Bskip_chars_forward:
 977           v1 = POP;
 978           TOP = Fskip_chars_forward (TOP, v1);
 979           break;
 980
 981         case Bskip_chars_backward:
 982           v1 = POP;
 983           TOP = Fskip_chars_backward (TOP, v1);
 984           break;
 985
 986         case Bforward_line:
 987           TOP = Fforward_line (TOP);
 988           break;
 989
 990         case Bchar_syntax:
 991           CHECK_NUMBER (TOP, 0);
 992           XSETFASTINT (TOP,
 993                        syntax_code_spec[(int) SYNTAX (XINT (TOP))]);
 994           break;
 995
 996         case Bbuffer_substring:
 997           v1 = POP;
 998           TOP = Fbuffer_substring (TOP, v1);
 999           break;
1000
1001         case Bdelete_region:
1002           v1 = POP;
1003           TOP = Fdelete_region (TOP, v1);
1004           break;
1005
1006         case Bnarrow_to_region:
1007           v1 = POP;
1008           TOP = Fnarrow_to_region (TOP, v1);
1009           break;
1010
1011         case Bwiden:
1012           PUSH (Fwiden ());
1013           break;
1014
1015         case Bend_of_line:
1016           TOP = Fend_of_line (TOP);
1017           break;
1018
1019         case Bset_marker:
1020           v1 = POP;
1021           v2 = POP;
1022           TOP = Fset_marker (TOP, v2, v1);
1023           break;
1024
1025         case Bmatch_beginning:
1026           TOP = Fmatch_beginning (TOP);
1027           break;
1028
1029         case Bmatch_end:
1030           TOP = Fmatch_end (TOP);
1031           break;
1032
1033         case Bupcase:
1034           TOP = Fupcase (TOP);
1035           break;
1036
1037         case Bdowncase:
1038           TOP = Fdowncase (TOP);
1039         break;
1040
1041         case Bstringeqlsign:
1042           v1 = POP;
1043           TOP = Fstring_equal (TOP, v1);
1044           break;
1045
1046         case Bstringlss:
1047           v1 = POP;
1048           TOP = Fstring_lessp (TOP, v1);
1049           break;
1050
1051         case Bequal:
1052           v1 = POP;
1053           TOP = Fequal (TOP, v1);
1054           break;
1055
1056         case Bnthcdr:
1057           v1 = POP;
1058           TOP = Fnthcdr (TOP, v1);
1059           break;
1060
1061         case Belt:
1062           if (CONSP (TOP))
1063             {
1064               /* Exchange args and then do nth.  */
1065               v2 = POP;
1066               v1 = TOP;
1067               goto nth_entry;
1068             }
1069           v1 = POP;
1070           TOP = Felt (TOP, v1);
1071           break;
1072
1073         case Bmember:
1074           v1 = POP;
1075           TOP = Fmember (TOP, v1);
1076           break;
1077
1078         case Bassq:
1079           v1 = POP;
1080           TOP = Fassq (TOP, v1);
1081           break;
1082
1083         case Bnreverse:
1084           TOP = Fnreverse (TOP);
1085           break;
1086
1087         case Bsetcar:
1088           v1 = POP;
1089           TOP = Fsetcar (TOP, v1);
1090           break;
1091
1092         case Bsetcdr:
1093           v1 = POP;
1094           TOP = Fsetcdr (TOP, v1);
1095           break;
1096
1097         case Bcar_safe:
1098           v1 = TOP;
1099           if (CONSP (v1))
1100             TOP = XCAR (v1);
1101           else
1102             TOP = Qnil;
1103           break;
1104
1105         case Bcdr_safe:
1106           v1 = TOP;
1107           if (CONSP (v1))
1108             TOP = XCDR (v1);
1109           else
1110             TOP = Qnil;
1111           break;
1112
1113         case Bnconc:
1114           DISCARD (1);
1115           TOP = Fnconc (2, &TOP);
1116           break;
1117
1118         case Bnumberp:
1119           TOP = (NUMBERP (TOP) ? Qt : Qnil);
1120           break;
1121
1122         case Bintegerp:
1123           TOP = INTEGERP (TOP) ? Qt : Qnil;
1124           break;
1125
1126 #ifdef BYTE_CODE_SAFE
1127         case Bset_mark:
1128           error ("set-mark is an obsolete bytecode");
1129           break;
1130         case Bscan_buffer:
1131           error ("scan-buffer is an obsolete bytecode");
1132           break;
1133 #endif
1134
1135         default:
1136 #ifdef BYTE_CODE_SAFE
1137           if (op < Bconstant)
1138             error ("unknown bytecode %d (byte compiler bug)", op);
1139           if ((op -= Bconstant) >= const_length)
1140             error ("no constant number %d (byte compiler bug)", op);
1141           PUSH (vectorp[op]);
1142 #else
1143           PUSH (vectorp[op - Bconstant]);
1144 #endif
1145         }
1146     }
1147
1148  exit:
1149   UNGCPRO;
1150   /* Binds and unbinds are supposed to be compiled balanced.  */
1151   if (specpdl_ptr - specpdl != count)
1152 #ifdef BYTE_CODE_SAFE
1153     error ("binding stack not balanced (serious byte compiler bug)");
1154 #else
1155     abort ();
1156 #endif
1157   return v1;
1158 }
1159
1160 void
1161 syms_of_bytecode ()
1162 {
1163   Qbytecode = intern ("byte-code");
1164   staticpro (&Qbytecode);
1165
1166   defsubr (&Sbyte_code);
1167
1168 #ifdef BYTE_CODE_METER
1169
1170   DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
1171    "A vector of vectors which holds a histogram of byte-code usage.\n\
1172 (aref (aref byte-code-meter 0) CODE) indicates how many times the byte\n\
1173 opcode CODE has been executed.\n\
1174 (aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,\n\
1175 indicates how many times the byte opcodes CODE1 and CODE2 have been\n\
1176 executed in succession.");
1177   DEFVAR_BOOL ("byte-metering-on", &byte_metering_on,
1178    "If non-nil, keep profiling information on byte code usage.\n\
1179 The variable byte-code-meter indicates how often each byte opcode is used.\n\
1180 If a symbol has a property named `byte-code-meter' whose value is an\n\
1181 integer, it is incremented each time that symbol's function is called.");
1182
1183   byte_metering_on = 0;
1184   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
1185   Qbyte_code_meter = intern ("byte-code-meter");
1186   staticpro (&Qbyte_code_meter);
1187   {
1188     int i = 256;
1189     while (i--)
1190       XVECTOR (Vbyte_code_meter)->contents[i] =
1191         Fmake_vector (make_number (256), make_number (0));
1192   }
1193 #endif
1194 }