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 "syntax.h"
  40
  41 /*
  42  * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for
  43  * debugging the byte compiler...)
  44  *
  45  * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
  46  */
  47 /* #define BYTE_CODE_SAFE */
  48 /* #define BYTE_CODE_METER */
  49
  50 \f
  51 #ifdef BYTE_CODE_METER
  52
  53 Lisp_Object Vbyte_code_meter, Qbyte_code_meter;
  54 int byte_metering_on;
  55
  56 #define METER_2(code1, code2) \
  57   XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \
  58             ->contents[(code2)])
  59
  60 #define METER_1(code) METER_2 (0, (code))
  61
  62 #define METER_CODE(last_code, this_code)                        \
  63 {                                                               \
  64   if (byte_metering_on)                                         \
  65     {                                                           \
  66       if (METER_1 (this_code) != ((1<<VALBITS)-1))              \
  67         METER_1 (this_code)++;                                  \
  68       if (last_code                                             \
  69           && METER_2 (last_code, this_code) != ((1<<VALBITS)-1))\
  70         METER_2 (last_code, this_code)++;                       \
  71     }                                                           \
  72 }
  73
  74 #else /* no BYTE_CODE_METER */
  75
  76 #define METER_CODE(last_code, this_code)
  77
  78 #endif /* no BYTE_CODE_METER */
  79 \f
  80
  81 Lisp_Object Qbytecode;
  82
  83 /*  Byte codes: */
  84
  85 #define Bvarref 010
  86 #define Bvarset 020
  87 #define Bvarbind 030
  88 #define Bcall 040
  89 #define Bunbind 050
  90
  91 #define Bnth 070
  92 #define Bsymbolp 071
  93 #define Bconsp 072
  94 #define Bstringp 073
  95 #define Blistp 074
  96 #define Beq 075
  97 #define Bmemq 076
  98 #define Bnot 077
  99 #define Bcar 0100
 100 #define Bcdr 0101
 101 #define Bcons 0102
 102 #define Blist1 0103
 103 #define Blist2 0104
 104 #define Blist3 0105
 105 #define Blist4 0106
 106 #define Blength 0107
 107 #define Baref 0110
 108 #define Baset 0111
 109 #define Bsymbol_value 0112
 110 #define Bsymbol_function 0113
 111 #define Bset 0114
 112 #define Bfset 0115
 113 #define Bget 0116
 114 #define Bsubstring 0117
 115 #define Bconcat2 0120
 116 #define Bconcat3 0121
 117 #define Bconcat4 0122
 118 #define Bsub1 0123
 119 #define Badd1 0124
 120 #define Beqlsign 0125
 121 #define Bgtr 0126
 122 #define Blss 0127
 123 #define Bleq 0130
 124 #define Bgeq 0131
 125 #define Bdiff 0132
 126 #define Bnegate 0133
 127 #define Bplus 0134
 128 #define Bmax 0135
 129 #define Bmin 0136
 130 #define Bmult 0137
 131
 132 #define Bpoint 0140
 133 #define Bmark 0141 /* no longer generated as of v18 */
 134 #define Bgoto_char 0142
 135 #define Binsert 0143
 136 #define Bpoint_max 0144
 137 #define Bpoint_min 0145
 138 #define Bchar_after 0146
 139 #define Bfollowing_char 0147
 140 #define Bpreceding_char 0150
 141 #define Bcurrent_column 0151
 142 #define Bindent_to 0152
 143 #define Bscan_buffer 0153 /* No longer generated as of v18 */
 144 #define Beolp 0154
 145 #define Beobp 0155
 146 #define Bbolp 0156
 147 #define Bbobp 0157
 148 #define Bcurrent_buffer 0160
 149 #define Bset_buffer 0161
 150 #define Bread_char 0162 /* No longer generated as of v19 */
 151 #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
 152 #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
 153
 154 #define Bforward_char 0165
 155 #define Bforward_word 0166
 156 #define Bskip_chars_forward 0167
 157 #define Bskip_chars_backward 0170
 158 #define Bforward_line 0171
 159 #define Bchar_syntax 0172
 160 #define Bbuffer_substring 0173
 161 #define Bdelete_region 0174
 162 #define Bnarrow_to_region 0175
 163 #define Bwiden 0176
 164 #define Bend_of_line 0177
 165
 166 #define Bconstant2 0201
 167 #define Bgoto 0202
 168 #define Bgotoifnil 0203
 169 #define Bgotoifnonnil 0204
 170 #define Bgotoifnilelsepop 0205
 171 #define Bgotoifnonnilelsepop 0206
 172 #define Breturn 0207
 173 #define Bdiscard 0210
 174 #define Bdup 0211
 175
 176 #define Bsave_excursion 0212
 177 #define Bsave_window_excursion 0213
 178 #define Bsave_restriction 0214
 179 #define Bcatch 0215
 180
 181 #define Bunwind_protect 0216
 182 #define Bcondition_case 0217
 183 #define Btemp_output_buffer_setup 0220
 184 #define Btemp_output_buffer_show 0221
 185
 186 #define Bunbind_all 0222
 187
 188 #define Bset_marker 0223
 189 #define Bmatch_beginning 0224
 190 #define Bmatch_end 0225
 191 #define Bupcase 0226
 192 #define Bdowncase 0227
 193
 194 #define Bstringeqlsign 0230
 195 #define Bstringlss 0231
 196 #define Bequal 0232
 197 #define Bnthcdr 0233
 198 #define Belt 0234
 199 #define Bmember 0235
 200 #define Bassq 0236
 201 #define Bnreverse 0237
 202 #define Bsetcar 0240
 203 #define Bsetcdr 0241
 204 #define Bcar_safe 0242
 205 #define Bcdr_safe 0243
 206 #define Bnconc 0244
 207 #define Bquo 0245
 208 #define Brem 0246
 209 #define Bnumberp 0247
 210 #define Bintegerp 0250
 211
 212 #define BRgoto 0252
 213 #define BRgotoifnil 0253
 214 #define BRgotoifnonnil 0254
 215 #define BRgotoifnilelsepop 0255
 216 #define BRgotoifnonnilelsepop 0256
 217
 218 #define BlistN 0257
 219 #define BconcatN 0260
 220 #define BinsertN 0261
 221
 222 #define Bconstant 0300
 223 #define CONSTANTLIM 0100
 224 \f
 225 /* Fetch the next byte from the bytecode stream */
 226
 227 #define FETCH *pc++
 228
 229 /* Fetch two bytes from the bytecode stream
 230  and make a 16-bit number out of them */
 231
 232 #define FETCH2 (op = FETCH, op + (FETCH << 8))
 233
 234 /* Push x onto the execution stack. */
 235
 236 /* This used to be #define PUSH(x) (*++stackp = (x))
 237    This oddity is necessary because Alliant can't be bothered to
 238    compile the preincrement operator properly, as of 4/91.  -JimB  */
 239 #define PUSH(x) (stackp++, *stackp = (x))
 240
 241 /* Pop a value off the execution stack.  */
 242
 243 #define POP (*stackp--)
 244
 245 /* Discard n values from the execution stack.  */
 246
 247 #define DISCARD(n) (stackp -= (n))
 248
 249 /* Get the value which is at the top of the execution stack, but don't pop it. */
 250
 251 #define TOP (*stackp)
 252
 253 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
 254   "Function used internally in byte-compiled code.\n\
 255 The first argument, BYTESTR, is a string of byte code;\n\
 256 the second, VECTOR, a vector of constants;\n\
 257 the third, MAXDEPTH, the maximum stack depth used in this function.\n\
 258 If the third argument is incorrect, Emacs may crash.")
 259   (bytestr, vector, maxdepth)
 260      Lisp_Object bytestr, vector, maxdepth;
 261 {
 262   struct gcpro gcpro1, gcpro2, gcpro3;
 263   int count = specpdl_ptr - specpdl;
 264 #ifdef BYTE_CODE_METER
 265   int this_op = 0;
 266   int prev_op;
 267 #endif
 268   register int op;
 269   unsigned char *pc;
 270   Lisp_Object *stack;
 271   register Lisp_Object *stackp;
 272   Lisp_Object *stacke;
 273   register Lisp_Object v1, v2;
 274   register Lisp_Object *vectorp = XVECTOR (vector)->contents;
 275 #ifdef BYTE_CODE_SAFE
 276   register int const_length = XVECTOR (vector)->size;
 277 #endif
 278   /* Copy of BYTESTR, saved so we can tell if BYTESTR was relocated.  */
 279   Lisp_Object string_saved;
 280   /* Cached address of beginning of string,
 281      valid if BYTESTR equals STRING_SAVED.  */
 282   register unsigned char *strbeg;
 283
 284   CHECK_STRING (bytestr, 0);
 285   if (!VECTORP (vector))
 286     vector = wrong_type_argument (Qvectorp, vector);
 287   CHECK_NUMBER (maxdepth, 2);
 288
 289   stackp = (Lisp_Object *) alloca (XFASTINT (maxdepth) * sizeof (Lisp_Object));
 290   bzero (stackp, XFASTINT (maxdepth) * sizeof (Lisp_Object));
 291   GCPRO3 (bytestr, vector, *stackp);
 292   gcpro3.nvars = XFASTINT (maxdepth);
 293
 294   --stackp;
 295   stack = stackp;
 296   stacke = stackp + XFASTINT (maxdepth);
 297
 298   /* Initialize the saved pc-pointer for fetching from the string.  */
 299   string_saved = bytestr;
 300   pc = XSTRING (string_saved)->data;
 301
 302   while (1)
 303     {
 304 #ifdef BYTE_CODE_SAFE
 305       if (stackp > stacke)
 306         error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d",
 307                pc - XSTRING (string_saved)->data, stacke - stackp);
 308       if (stackp < stack)
 309         error ("Byte code stack underflow (byte compiler bug), pc %d",
 310                pc - XSTRING (string_saved)->data);
 311 #endif
 312
 313       if (! EQ (string_saved, bytestr))
 314         {
 315           pc = pc - XSTRING (string_saved)->data + XSTRING (bytestr)->data;
 316           string_saved = bytestr;
 317         }
 318
 319 #ifdef BYTE_CODE_METER
 320       prev_op = this_op;
 321       this_op = op = FETCH;
 322       METER_CODE (prev_op, op);
 323       switch (op)
 324 #else
 325       switch (op = FETCH)
 326 #endif
 327         {
 328         case Bvarref+6:
 329           op = FETCH;
 330           goto varref;
 331
 332         case Bvarref+7:
 333           op = FETCH2;
 334           goto varref;
 335
 336         case Bvarref: case Bvarref+1: case Bvarref+2: case Bvarref+3:
 337         case Bvarref+4: case Bvarref+5:
 338           op = op - Bvarref;
 339         varref:
 340           v1 = vectorp[op];
 341           if (!SYMBOLP (v1))
 342             v2 = Fsymbol_value (v1);
 343           else
 344             {
 345               v2 = XSYMBOL (v1)->value;
 346               if (MISCP (v2) || EQ (v2, Qunbound))
 347                 v2 = Fsymbol_value (v1);
 348             }
 349           PUSH (v2);
 350           break;
 351
 352         case Bvarset+6:
 353           op = FETCH;
 354           goto varset;
 355
 356         case Bvarset+7:
 357           op = FETCH2;
 358           goto varset;
 359
 360         case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3:
 361         case Bvarset+4: case Bvarset+5:
 362           op -= Bvarset;
 363         varset:
 364           Fset (vectorp[op], POP);
 365           break;
 366
 367         case Bvarbind+6:
 368           op = FETCH;
 369           goto varbind;
 370
 371         case Bvarbind+7:
 372           op = FETCH2;
 373           goto varbind;
 374
 375         case Bvarbind: case Bvarbind+1: case Bvarbind+2: case Bvarbind+3:
 376         case Bvarbind+4: case Bvarbind+5:
 377           op -= Bvarbind;
 378         varbind:
 379           specbind (vectorp[op], POP);
 380           break;
 381
 382         case Bcall+6:
 383           op = FETCH;
 384           goto docall;
 385
 386         case Bcall+7:
 387           op = FETCH2;
 388           goto docall;
 389
 390         case Bcall: case Bcall+1: case Bcall+2: case Bcall+3:
 391         case Bcall+4: case Bcall+5:
 392           op -= Bcall;
 393         docall:
 394           DISCARD (op);
 395 #ifdef BYTE_CODE_METER
 396           if (byte_metering_on && SYMBOLP (TOP))
 397             {
 398               v1 = TOP;
 399               v2 = Fget (v1, Qbyte_code_meter);
 400               if (INTEGERP (v2)
 401                   && XINT (v2) != ((1<<VALBITS)-1))
 402                 {
 403                   XSETINT (v2, XINT (v2) + 1);
 404                   Fput (v1, Qbyte_code_meter, v2);
 405                 }
 406             }
 407 #endif
 408           TOP = Ffuncall (op + 1, &TOP);
 409           break;
 410
 411         case Bunbind+6:
 412           op = FETCH;
 413           goto dounbind;
 414
 415         case Bunbind+7:
 416           op = FETCH2;
 417           goto dounbind;
 418
 419         case Bunbind: case Bunbind+1: case Bunbind+2: case Bunbind+3:
 420         case Bunbind+4: case Bunbind+5:
 421           op -= Bunbind;
 422         dounbind:
 423           unbind_to (specpdl_ptr - specpdl - op, Qnil);
 424           break;
 425
 426         case Bunbind_all:
 427           /* To unbind back to the beginning of this frame.  Not used yet,
 428              but will be needed for tail-recursion elimination.  */
 429           unbind_to (count, Qnil);
 430           break;
 431
 432         case Bgoto:
 433           QUIT;
 434           op = FETCH2;    /* pc = FETCH2 loses since FETCH2 contains pc++ */
 435           pc = XSTRING (string_saved)->data + op;
 436           break;
 437
 438         case Bgotoifnil:
 439           op = FETCH2;
 440           if (NILP (POP))
 441             {
 442               QUIT;
 443               pc = XSTRING (string_saved)->data + op;
 444             }
 445           break;
 446
 447         case Bgotoifnonnil:
 448           op = FETCH2;
 449           if (!NILP (POP))
 450             {
 451               QUIT;
 452               pc = XSTRING (string_saved)->data + op;
 453             }
 454           break;
 455
 456         case Bgotoifnilelsepop:
 457           op = FETCH2;
 458           if (NILP (TOP))
 459             {
 460               QUIT;
 461               pc = XSTRING (string_saved)->data + op;
 462             }
 463           else DISCARD (1);
 464           break;
 465
 466         case Bgotoifnonnilelsepop:
 467           op = FETCH2;
 468           if (!NILP (TOP))
 469             {
 470               QUIT;
 471               pc = XSTRING (string_saved)->data + op;
 472             }
 473           else DISCARD (1);
 474           break;
 475
 476         case BRgoto:
 477           QUIT;
 478           pc += (int) *pc - 127;
 479           break;
 480
 481         case BRgotoifnil:
 482           if (NILP (POP))
 483             {
 484               QUIT;
 485               pc += (int) *pc - 128;
 486             }
 487           pc++;
 488           break;
 489
 490         case BRgotoifnonnil:
 491           if (!NILP (POP))
 492             {
 493               QUIT;
 494               pc += (int) *pc - 128;
 495             }
 496           pc++;
 497           break;
 498
 499         case BRgotoifnilelsepop:
 500           op = *pc++;
 501           if (NILP (TOP))
 502             {
 503               QUIT;
 504               pc += op - 128;
 505             }
 506           else DISCARD (1);
 507           break;
 508
 509         case BRgotoifnonnilelsepop:
 510           op = *pc++;
 511           if (!NILP (TOP))
 512             {
 513               QUIT;
 514               pc += op - 128;
 515             }
 516           else DISCARD (1);
 517           break;
 518
 519         case Breturn:
 520           v1 = POP;
 521           goto exit;
 522
 523         case Bdiscard:
 524           DISCARD (1);
 525           break;
 526
 527         case Bdup:
 528           v1 = TOP;
 529           PUSH (v1);
 530           break;
 531
 532         case Bconstant2:
 533           PUSH (vectorp[FETCH2]);
 534           break;
 535
 536         case Bsave_excursion:
 537           record_unwind_protect (save_excursion_restore, save_excursion_save ());
 538           break;
 539
 540         case Bsave_window_excursion:
 541           TOP = Fsave_window_excursion (TOP);
 542           break;
 543
 544         case Bsave_restriction:
 545           record_unwind_protect (save_restriction_restore, save_restriction_save ());
 546           break;
 547
 548         case Bcatch:
 549           v1 = POP;
 550           TOP = internal_catch (TOP, Feval, v1);
 551           break;
 552
 553         case Bunwind_protect:
 554           record_unwind_protect (0, POP);
 555           (specpdl_ptr - 1)->symbol = Qnil;
 556           break;
 557
 558         case Bcondition_case:
 559           v1 = POP;
 560           v1 = Fcons (POP, v1);
 561           TOP = Fcondition_case (Fcons (TOP, v1));
 562           break;
 563
 564         case Btemp_output_buffer_setup:
 565           temp_output_buffer_setup (XSTRING (TOP)->data);
 566           TOP = Vstandard_output;
 567           break;
 568
 569         case Btemp_output_buffer_show:
 570           v1 = POP;
 571           temp_output_buffer_show (TOP);
 572           TOP = v1;
 573           /* pop binding of standard-output */
 574           unbind_to (specpdl_ptr - specpdl - 1, Qnil);
 575           break;
 576
 577         case Bnth:
 578           v1 = POP;
 579           v2 = TOP;
 580         nth_entry:
 581           CHECK_NUMBER (v2, 0);
 582           op = XINT (v2);
 583           immediate_quit = 1;
 584           while (--op >= 0)
 585             {
 586               if (CONSP (v1))
 587                 v1 = XCONS (v1)->cdr;
 588               else if (!NILP (v1))
 589                 {
 590                   immediate_quit = 0;
 591                   v1 = wrong_type_argument (Qlistp, v1);
 592                   immediate_quit = 1;
 593                   op++;
 594                 }
 595             }
 596           immediate_quit = 0;
 597           goto docar;
 598
 599         case Bsymbolp:
 600           TOP = SYMBOLP (TOP) ? Qt : Qnil;
 601           break;
 602
 603         case Bconsp:
 604           TOP = CONSP (TOP) ? Qt : Qnil;
 605           break;
 606
 607         case Bstringp:
 608           TOP = STRINGP (TOP) ? Qt : Qnil;
 609           break;
 610
 611         case Blistp:
 612           TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
 613           break;
 614
 615         case Beq:
 616           v1 = POP;
 617           TOP = EQ (v1, TOP) ? Qt : Qnil;
 618           break;
 619
 620         case Bmemq:
 621           v1 = POP;
 622           TOP = Fmemq (TOP, v1);
 623           break;
 624
 625         case Bnot:
 626           TOP = NILP (TOP) ? Qt : Qnil;
 627           break;
 628
 629         case Bcar:
 630           v1 = TOP;
 631         docar:
 632           if (CONSP (v1)) TOP = XCONS (v1)->car;
 633           else if (NILP (v1)) TOP = Qnil;
 634           else Fcar (wrong_type_argument (Qlistp, v1));
 635           break;
 636
 637         case Bcdr:
 638           v1 = TOP;
 639           if (CONSP (v1)) TOP = XCONS (v1)->cdr;
 640           else if (NILP (v1)) TOP = Qnil;
 641           else Fcdr (wrong_type_argument (Qlistp, v1));
 642           break;
 643
 644         case Bcons:
 645           v1 = POP;
 646           TOP = Fcons (TOP, v1);
 647           break;
 648
 649         case Blist1:
 650           TOP = Fcons (TOP, Qnil);
 651           break;
 652
 653         case Blist2:
 654           v1 = POP;
 655           TOP = Fcons (TOP, Fcons (v1, Qnil));
 656           break;
 657
 658         case Blist3:
 659           DISCARD (2);
 660           TOP = Flist (3, &TOP);
 661           break;
 662
 663         case Blist4:
 664           DISCARD (3);
 665           TOP = Flist (4, &TOP);
 666           break;
 667
 668         case BlistN:
 669           op = FETCH;
 670           DISCARD (op - 1);
 671           TOP = Flist (op, &TOP);
 672           break;
 673
 674         case Blength:
 675           TOP = Flength (TOP);
 676           break;
 677
 678         case Baref:
 679           v1 = POP;
 680           TOP = Faref (TOP, v1);
 681           break;
 682
 683         case Baset:
 684           v2 = POP; v1 = POP;
 685           TOP = Faset (TOP, v1, v2);
 686           break;
 687
 688         case Bsymbol_value:
 689           TOP = Fsymbol_value (TOP);
 690           break;
 691
 692         case Bsymbol_function:
 693           TOP = Fsymbol_function (TOP);
 694           break;
 695
 696         case Bset:
 697           v1 = POP;
 698           TOP = Fset (TOP, v1);
 699           break;
 700
 701         case Bfset:
 702           v1 = POP;
 703           TOP = Ffset (TOP, v1);
 704           break;
 705
 706         case Bget:
 707           v1 = POP;
 708           TOP = Fget (TOP, v1);
 709           break;
 710
 711         case Bsubstring:
 712           v2 = POP; v1 = POP;
 713           TOP = Fsubstring (TOP, v1, v2);
 714           break;
 715
 716         case Bconcat2:
 717           DISCARD (1);
 718           TOP = Fconcat (2, &TOP);
 719           break;
 720
 721         case Bconcat3:
 722           DISCARD (2);
 723           TOP = Fconcat (3, &TOP);
 724           break;
 725
 726         case Bconcat4:
 727           DISCARD (3);
 728           TOP = Fconcat (4, &TOP);
 729           break;
 730
 731         case BconcatN:
 732           op = FETCH;
 733           DISCARD (op - 1);
 734           TOP = Fconcat (op, &TOP);
 735           break;
 736
 737         case Bsub1:
 738           v1 = TOP;
 739           if (INTEGERP (v1))
 740             {
 741               XSETINT (v1, XINT (v1) - 1);
 742               TOP = v1;
 743             }
 744           else
 745             TOP = Fsub1 (v1);
 746           break;
 747
 748         case Badd1:
 749           v1 = TOP;
 750           if (INTEGERP (v1))
 751             {
 752               XSETINT (v1, XINT (v1) + 1);
 753               TOP = v1;
 754             }
 755           else
 756             TOP = Fadd1 (v1);
 757           break;
 758
 759         case Beqlsign:
 760           v2 = POP; v1 = TOP;
 761           CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0);
 762           CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0);
 763 #ifdef LISP_FLOAT_TYPE
 764           if (FLOATP (v1) || FLOATP (v2))
 765             {
 766               double f1, f2;
 767
 768               f1 = (FLOATP (v1) ? XFLOAT (v1)->data : XINT (v1));
 769               f2 = (FLOATP (v2) ? XFLOAT (v2)->data : XINT (v2));
 770               TOP = (f1 == f2 ? Qt : Qnil);
 771             }
 772           else
 773 #endif
 774             TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
 775           break;
 776
 777         case Bgtr:
 778           v1 = POP;
 779           TOP = Fgtr (TOP, v1);
 780           break;
 781
 782         case Blss:
 783           v1 = POP;
 784           TOP = Flss (TOP, v1);
 785           break;
 786
 787         case Bleq:
 788           v1 = POP;
 789           TOP = Fleq (TOP, v1);
 790           break;
 791
 792         case Bgeq:
 793           v1 = POP;
 794           TOP = Fgeq (TOP, v1);
 795           break;
 796
 797         case Bdiff:
 798           DISCARD (1);
 799           TOP = Fminus (2, &TOP);
 800           break;
 801
 802         case Bnegate:
 803           v1 = TOP;
 804           if (INTEGERP (v1))
 805             {
 806               XSETINT (v1, - XINT (v1));
 807               TOP = v1;
 808             }
 809           else
 810             TOP = Fminus (1, &TOP);
 811           break;
 812
 813         case Bplus:
 814           DISCARD (1);
 815           TOP = Fplus (2, &TOP);
 816           break;
 817
 818         case Bmax:
 819           DISCARD (1);
 820           TOP = Fmax (2, &TOP);
 821           break;
 822
 823         case Bmin:
 824           DISCARD (1);
 825           TOP = Fmin (2, &TOP);
 826           break;
 827
 828         case Bmult:
 829           DISCARD (1);
 830           TOP = Ftimes (2, &TOP);
 831           break;
 832
 833         case Bquo:
 834           DISCARD (1);
 835           TOP = Fquo (2, &TOP);
 836           break;
 837
 838         case Brem:
 839           v1 = POP;
 840           TOP = Frem (TOP, v1);
 841           break;
 842
 843         case Bpoint:
 844           XSETFASTINT (v1, point);
 845           PUSH (v1);
 846           break;
 847
 848         case Bgoto_char:
 849           TOP = Fgoto_char (TOP);
 850           break;
 851
 852         case Binsert:
 853           TOP = Finsert (1, &TOP);
 854           break;
 855
 856         case BinsertN:
 857           op = FETCH;
 858           DISCARD (op - 1);
 859           TOP = Finsert (op, &TOP);
 860           break;
 861
 862         case Bpoint_max:
 863           XSETFASTINT (v1, ZV);
 864           PUSH (v1);
 865           break;
 866
 867         case Bpoint_min:
 868           XSETFASTINT (v1, BEGV);
 869           PUSH (v1);
 870           break;
 871
 872         case Bchar_after:
 873           TOP = Fchar_after (TOP);
 874           break;
 875
 876         case Bfollowing_char:
 877           v1 = Ffollowing_char ();
 878           PUSH (v1);
 879           break;
 880
 881         case Bpreceding_char:
 882           v1 = Fprevious_char ();
 883           PUSH (v1);
 884           break;
 885
 886         case Bcurrent_column:
 887           XSETFASTINT (v1, current_column ());
 888           PUSH (v1);
 889           break;
 890
 891         case Bindent_to:
 892           TOP = Findent_to (TOP, Qnil);
 893           break;
 894
 895         case Beolp:
 896           PUSH (Feolp ());
 897           break;
 898
 899         case Beobp:
 900           PUSH (Feobp ());
 901           break;
 902
 903         case Bbolp:
 904           PUSH (Fbolp ());
 905           break;
 906
 907         case Bbobp:
 908           PUSH (Fbobp ());
 909           break;
 910
 911         case Bcurrent_buffer:
 912           PUSH (Fcurrent_buffer ());
 913           break;
 914
 915         case Bset_buffer:
 916           TOP = Fset_buffer (TOP);
 917           break;
 918
 919         case Bread_char:
 920           PUSH (Fread_char ());
 921           QUIT;
 922           break;
 923
 924         case Binteractive_p:
 925           PUSH (Finteractive_p ());
 926           break;
 927
 928         case Bforward_char:
 929           TOP = Fforward_char (TOP);
 930           break;
 931
 932         case Bforward_word:
 933           TOP = Fforward_word (TOP);
 934           break;
 935
 936         case Bskip_chars_forward:
 937           v1 = POP;
 938           TOP = Fskip_chars_forward (TOP, v1);
 939           break;
 940
 941         case Bskip_chars_backward:
 942           v1 = POP;
 943           TOP = Fskip_chars_backward (TOP, v1);
 944           break;
 945
 946         case Bforward_line:
 947           TOP = Fforward_line (TOP);
 948           break;
 949
 950         case Bchar_syntax:
 951           CHECK_NUMBER (TOP, 0);
 952           XSETFASTINT (TOP,
 953                        syntax_code_spec[(int) SYNTAX (XINT (TOP))]);
 954           break;
 955
 956         case Bbuffer_substring:
 957           v1 = POP;
 958           TOP = Fbuffer_substring (TOP, v1);
 959           break;
 960
 961         case Bdelete_region:
 962           v1 = POP;
 963           TOP = Fdelete_region (TOP, v1);
 964           break;
 965
 966         case Bnarrow_to_region:
 967           v1 = POP;
 968           TOP = Fnarrow_to_region (TOP, v1);
 969           break;
 970
 971         case Bwiden:
 972           PUSH (Fwiden ());
 973           break;
 974
 975         case Bend_of_line:
 976           TOP = Fend_of_line (TOP);
 977           break;
 978
 979         case Bset_marker:
 980           v1 = POP;
 981           v2 = POP;
 982           TOP = Fset_marker (TOP, v2, v1);
 983           break;
 984
 985         case Bmatch_beginning:
 986           TOP = Fmatch_beginning (TOP);
 987           break;
 988
 989         case Bmatch_end:
 990           TOP = Fmatch_end (TOP);
 991           break;
 992
 993         case Bupcase:
 994           TOP = Fupcase (TOP);
 995           break;
 996
 997         case Bdowncase:
 998           TOP = Fdowncase (TOP);
 999         break;
1000
1001         case Bstringeqlsign:
1002           v1 = POP;
1003           TOP = Fstring_equal (TOP, v1);
1004           break;
1005
1006         case Bstringlss:
1007           v1 = POP;
1008           TOP = Fstring_lessp (TOP, v1);
1009           break;
1010
1011         case Bequal:
1012           v1 = POP;
1013           TOP = Fequal (TOP, v1);
1014           break;
1015
1016         case Bnthcdr:
1017           v1 = POP;
1018           TOP = Fnthcdr (TOP, v1);
1019           break;
1020
1021         case Belt:
1022           if (CONSP (TOP))
1023             {
1024               /* Exchange args and then do nth.  */
1025               v2 = POP;
1026               v1 = TOP;
1027               goto nth_entry;
1028             }
1029           v1 = POP;
1030           TOP = Felt (TOP, v1);
1031           break;
1032
1033         case Bmember:
1034           v1 = POP;
1035           TOP = Fmember (TOP, v1);
1036           break;
1037
1038         case Bassq:
1039           v1 = POP;
1040           TOP = Fassq (TOP, v1);
1041           break;
1042
1043         case Bnreverse:
1044           TOP = Fnreverse (TOP);
1045           break;
1046
1047         case Bsetcar:
1048           v1 = POP;
1049           TOP = Fsetcar (TOP, v1);
1050           break;
1051
1052         case Bsetcdr:
1053           v1 = POP;
1054           TOP = Fsetcdr (TOP, v1);
1055           break;
1056
1057         case Bcar_safe:
1058           v1 = TOP;
1059           if (CONSP (v1))
1060             TOP = XCONS (v1)->car;
1061           else
1062             TOP = Qnil;
1063           break;
1064
1065         case Bcdr_safe:
1066           v1 = TOP;
1067           if (CONSP (v1))
1068             TOP = XCONS (v1)->cdr;
1069           else
1070             TOP = Qnil;
1071           break;
1072
1073         case Bnconc:
1074           DISCARD (1);
1075           TOP = Fnconc (2, &TOP);
1076           break;
1077
1078         case Bnumberp:
1079           TOP = (NUMBERP (TOP) ? Qt : Qnil);
1080           break;
1081
1082         case Bintegerp:
1083           TOP = INTEGERP (TOP) ? Qt : Qnil;
1084           break;
1085
1086 #ifdef BYTE_CODE_SAFE
1087         case Bset_mark:
1088           error ("set-mark is an obsolete bytecode");
1089           break;
1090         case Bscan_buffer:
1091           error ("scan-buffer is an obsolete bytecode");
1092           break;
1093         case Bmark:
1094           error ("mark is an obsolete bytecode");
1095           break;
1096 #endif
1097
1098         default:
1099 #ifdef BYTE_CODE_SAFE
1100           if (op < Bconstant)
1101             error ("unknown bytecode %d (byte compiler bug)", op);
1102           if ((op -= Bconstant) >= const_length)
1103             error ("no constant number %d (byte compiler bug)", op);
1104           PUSH (vectorp[op]);
1105 #else
1106           PUSH (vectorp[op - Bconstant]);
1107 #endif
1108         }
1109     }
1110
1111  exit:
1112   UNGCPRO;
1113   /* Binds and unbinds are supposed to be compiled balanced.  */
1114   if (specpdl_ptr - specpdl != count)
1115 #ifdef BYTE_CODE_SAFE
1116     error ("binding stack not balanced (serious byte compiler bug)");
1117 #else
1118     abort ();
1119 #endif
1120   return v1;
1121 }
1122
1123 syms_of_bytecode ()
1124 {
1125   Qbytecode = intern ("byte-code");
1126   staticpro (&Qbytecode);
1127
1128   defsubr (&Sbyte_code);
1129
1130 #ifdef BYTE_CODE_METER
1131
1132   DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
1133    "A vector of vectors which holds a histogram of byte-code usage.\n\
1134 (aref (aref byte-code-meter 0) CODE) indicates how many times the byte\n\
1135 opcode CODE has been executed.\n\
1136 (aref (aref byte-code-meter CODE1) CODE2), where CODE1 is not 0,\n\
1137 indicates how many times the byte opcodes CODE1 and CODE2 have been\n\
1138 executed in succession.");
1139   DEFVAR_BOOL ("byte-metering-on", &byte_metering_on,
1140    "If non-nil, keep profiling information on byte code usage.\n\
1141 The variable byte-code-meter indicates how often each byte opcode is used.\n\
1142 If a symbol has a property named `byte-code-meter' whose value is an\n\
1143 integer, it is incremented each time that symbol's function is called.");
1144
1145   byte_metering_on = 0;
1146   Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0));
1147   Qbyte_code_meter = intern ("byte-code-meter");
1148   staticpro (&Qbyte_code_meter);
1149   {
1150     int i = 256;
1151     while (i--)
1152       XVECTOR (Vbyte_code_meter)->contents[i] =
1153         Fmake_vector (make_number (256), make_number (0));
1154   }
1155 #endif
1156 }