Mercurial > emacs

comparison src/bytecode.c @ 934:1e2e41fd188b

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
entered into RCS
author Richard M. Stallman <rms@gnu.org>
date Tue, 04 Aug 1992 21:22:43 +0000
parents eca8812e61cd
children 6bebb86e63c2
comparison
equal deleted inserted replaced
933:bf0e6122c2a9 934:1e2e41fd188b
1 /* Execution of byte code produced by bytecomp.el. 1 /* Execution of byte code produced by bytecomp.el.
2 Copyright (C) 1985, 1986, 1987, 1988, 1992 Free Software Foundation, Inc. 2 Copyright (C) 1985, 1986, 1987, 1988 Free Software Foundation, Inc.
3 3
4 This file is part of GNU Emacs. 4 This file is part of GNU Emacs.
5 5
6 GNU Emacs is free software; you can redistribute it and/or modify 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 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) 8 the Free Software Foundation; either version 1, or (at your option)
9 any later version. 9 any later version.
10 10
11 GNU Emacs is distributed in the hope that it will be useful, 11 GNU Emacs is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of 12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 15
16 You should have received a copy of the GNU General Public License 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 17 along with GNU Emacs; see the file COPYING. If not, write to
18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 18 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19 19
20 hacked on by jwz@lucid.com 17-jun-91 20 hacked on by jwz 17-jun-91
21 o added a compile-time switch to turn on simple sanity checking; 21 o added a compile-time switch to turn on simple sanity checking;
22 o put back the obsolete byte-codes for error-detection; 22 o put back the obsolete byte-codes for error-detection;
23 o put back fset, symbol-function, and read-char because I don't
24 see any reason for them to have been removed;
23 o added a new instruction, unbind_all, which I will use for 25 o added a new instruction, unbind_all, which I will use for
24 tail-recursion elimination; 26 tail-recursion elimination;
25 o made temp_output_buffer_show be called with the right number 27 o made temp_output_buffer_show() be called with the right number
26 of args; 28 of args;
27 o made the new bytecodes be called with args in the right order; 29 o made the new bytecodes be called with args in the right order;
28 o added metering support. 30 o added metering support.
29 31
30 by Hallvard: 32 by Hallvard:
31 o added relative jump instructions; 33 o added relative jump instructions;
32 o all conditionals now only do QUIT if they jump. 34 o all conditionals now only do QUIT if they jump.
33 */ 35 */
34 36
37
35 #include "config.h" 38 #include "config.h"
36 #include "lisp.h" 39 #include "lisp.h"
37 #include "buffer.h" 40 #include "buffer.h"
38 #include "syntax.h" 41 #include "syntax.h"
39 42
40 /* 43 /* Define this to enable some minor sanity checking
41 * define BYTE_CODE_SAFE to enable some minor sanity checking (useful for 44 (useful for debugging the byte compiler...)
42 * debugging the byte compiler...)
43 *
44 * define BYTE_CODE_METER to enable generation of a byte-op usage histogram.
45 */ 45 */
46 /* #define BYTE_CODE_SAFE */ 46 #define BYTE_CODE_SAFE
47 /* #define BYTE_CODE_METER */ 47
48 /* Define this to enable generation of a histogram of byte-op usage.
49 */
50 #define BYTE_CODE_METER
48 51
49 52
50 #ifdef BYTE_CODE_METER 53 #ifdef BYTE_CODE_METER
51 54
52 Lisp_Object Vbyte_code_meter, Qbyte_code_meter; 55 Lisp_Object Vbyte_code_meter;
53 int byte_metering_on; 56 int byte_metering_on;
54 57
55 #define METER_2(code1, code2) \ 58 # define METER_2(code1,code2) \
56 XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \ 59 XFASTINT (XVECTOR (XVECTOR (Vbyte_code_meter)->contents[(code1)]) \
57 ->contents[(code2)]) 60 ->contents[(code2)])
58 61
59 #define METER_1(code) METER_2 (0, (code)) 62 # define METER_1(code) METER_2 (0,(code))
60 63
61 #define METER_CODE(last_code, this_code) \ 64 # define METER_CODE(last_code, this_code) { \
62 { \ 65 if (byte_metering_on) { \
63 if (byte_metering_on) \ 66 if (METER_1 (this_code) != ((1<<VALBITS)-1)) \
64 { \ 67 METER_1 (this_code) ++; \
65 if (METER_1 (this_code) != ((1<<VALBITS)-1)) \ 68 if (last_code && \
66 METER_1 (this_code)++; \ 69 METER_2 (last_code,this_code) != ((1<<VALBITS)-1)) \
67 if (last_code \ 70 METER_2 (last_code,this_code) ++; \
68 && METER_2 (last_code, this_code) != ((1<<VALBITS)-1)) \ 71 } \
69 METER_2 (last_code, this_code)++; \ 72 }
70 } \ 73
71 } 74 #else /* ! BYTE_CODE_METER */
72 75
73 #else /* no BYTE_CODE_METER */ 76 # define meter_code(last_code, this_code)
74 77
75 #define METER_CODE(last_code, this_code) 78 #endif
76
77 #endif /* no BYTE_CODE_METER */
78 79
79 80
80 Lisp_Object Qbytecode; 81 Lisp_Object Qbytecode;
81 82
82 /* Byte codes: */ 83 /* Byte codes: */
144 #define Beobp 0155 145 #define Beobp 0155
145 #define Bbolp 0156 146 #define Bbolp 0156
146 #define Bbobp 0157 147 #define Bbobp 0157
147 #define Bcurrent_buffer 0160 148 #define Bcurrent_buffer 0160
148 #define Bset_buffer 0161 149 #define Bset_buffer 0161
149 #define Bread_char 0162 /* No longer generated as of v19 */ 150 #define Bread_char 0162
150 #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ 151 #define Bset_mark 0163 /* this loser is no longer generated as of v18 */
151 #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */ 152 #define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */
152 153
153 #define Bforward_char 0165 154 #define Bforward_char 0165
154 #define Bforward_word 0166 155 #define Bforward_word 0166
158 #define Bchar_syntax 0172 159 #define Bchar_syntax 0172
159 #define Bbuffer_substring 0173 160 #define Bbuffer_substring 0173
160 #define Bdelete_region 0174 161 #define Bdelete_region 0174
161 #define Bnarrow_to_region 0175 162 #define Bnarrow_to_region 0175
162 #define Bwiden 0176 163 #define Bwiden 0176
163 #define Bend_of_line 0177
164 164
165 #define Bconstant2 0201 165 #define Bconstant2 0201
166 #define Bgoto 0202 166 #define Bgoto 0202
167 #define Bgotoifnil 0203 167 #define Bgotoifnil 0203
168 #define Bgotoifnonnil 0204 168 #define Bgotoifnonnil 0204
181 #define Bcondition_case 0217 181 #define Bcondition_case 0217
182 #define Btemp_output_buffer_setup 0220 182 #define Btemp_output_buffer_setup 0220
183 #define Btemp_output_buffer_show 0221 183 #define Btemp_output_buffer_show 0221
184 184
185 #define Bunbind_all 0222 185 #define Bunbind_all 0222
186
187 #define Bset_marker 0223
188 #define Bmatch_beginning 0224
189 #define Bmatch_end 0225
190 #define Bupcase 0226
191 #define Bdowncase 0227
192 186
193 #define Bstringeqlsign 0230 187 #define Bstringeqlsign 0230
194 #define Bstringlss 0231 188 #define Bstringlss 0231
195 #define Bequal 0232 189 #define Bequal 0232
196 #define Bnthcdr 0233 190 #define Bnthcdr 0233
205 #define Bnconc 0244 199 #define Bnconc 0244
206 #define Bquo 0245 200 #define Bquo 0245
207 #define Brem 0246 201 #define Brem 0246
208 #define Bnumberp 0247 202 #define Bnumberp 0247
209 #define Bintegerp 0250 203 #define Bintegerp 0250
210
211 #define BRgoto 0252
212 #define BRgotoifnil 0253
213 #define BRgotoifnonnil 0254
214 #define BRgotoifnilelsepop 0255
215 #define BRgotoifnonnilelsepop 0256
216
217 #define BlistN 0257
218 #define BconcatN 0260
219 #define BinsertN 0261
220 204
221 #define Bconstant 0300 205 #define Bconstant 0300
222 #define CONSTANTLIM 0100 206 #define CONSTANTLIM 0100
223 207
224 /* Fetch the next byte from the bytecode stream */ 208 /* Fetch the next byte from the bytecode stream */
299 283
300 while (1) 284 while (1)
301 { 285 {
302 #ifdef BYTE_CODE_SAFE 286 #ifdef BYTE_CODE_SAFE
303 if (stackp > stacke) 287 if (stackp > stacke)
304 error ("Byte code stack overflow (byte compiler bug), pc %d, depth %d", 288 error (
289 "Stack overflow in byte code (byte compiler bug), pc = %d, depth = %d",
305 pc - XSTRING (string_saved)->data, stacke - stackp); 290 pc - XSTRING (string_saved)->data, stacke - stackp);
306 if (stackp < stack) 291 if (stackp < stack)
307 error ("Byte code stack underflow (byte compiler bug), pc %d", 292 error ("Stack underflow in byte code (byte compiler bug), pc = %d",
308 pc - XSTRING (string_saved)->data); 293 pc - XSTRING (string_saved)->data);
309 #endif 294 #endif
310 295
311 if (string_saved != bytestr) 296 if (string_saved != bytestr)
312 { 297 {
403 388
404 case Bcall: case Bcall+1: case Bcall+2: case Bcall+3: 389 case Bcall: case Bcall+1: case Bcall+2: case Bcall+3:
405 case Bcall+4: case Bcall+5: 390 case Bcall+4: case Bcall+5:
406 op -= Bcall; 391 op -= Bcall;
407 docall: 392 docall:
408 DISCARD (op); 393 DISCARD(op);
409 #ifdef BYTE_CODE_METER
410 if (byte_metering_on && XTYPE (TOP) == Lisp_Symbol)
411 {
412 v1 = TOP;
413 v2 = Fget (v1, Qbyte_code_meter);
414 if (XTYPE (v2) == Lisp_Int)
415 {
416 XSETINT (v2, XINT (v2) + 1);
417 Fput (v1, Qbyte_code_meter, v2);
418 }
419 }
420 #endif
421 TOP = Ffuncall (op + 1, &TOP); 394 TOP = Ffuncall (op + 1, &TOP);
422 break; 395 break;
423 396
424 case Bunbind+6: 397 case Bunbind+6:
425 op = FETCH; 398 op = FETCH;
436 unbind_to (specpdl_ptr - specpdl - op, Qnil); 409 unbind_to (specpdl_ptr - specpdl - op, Qnil);
437 break; 410 break;
438 411
439 case Bunbind_all: 412 case Bunbind_all:
440 /* To unbind back to the beginning of this frame. Not used yet, 413 /* To unbind back to the beginning of this frame. Not used yet,
441 but will be needed for tail-recursion elimination. */ 414 but wil be needed for tail-recursion elimination.
415 */
442 unbind_to (count, Qnil); 416 unbind_to (count, Qnil);
443 break; 417 break;
444 418
445 case Bgoto: 419 case Bgoto:
446 QUIT; 420 QUIT;
448 pc = XSTRING (string_saved)->data + op; 422 pc = XSTRING (string_saved)->data + op;
449 break; 423 break;
450 424
451 case Bgotoifnil: 425 case Bgotoifnil:
452 op = FETCH2; 426 op = FETCH2;
453 if (NILP (POP)) 427 if (NULL (POP))
454 { 428 {
455 QUIT; 429 QUIT;
456 pc = XSTRING (string_saved)->data + op; 430 pc = XSTRING (string_saved)->data + op;
457 } 431 }
458 break; 432 break;
459 433
460 case Bgotoifnonnil: 434 case Bgotoifnonnil:
461 op = FETCH2; 435 op = FETCH2;
462 if (!NILP (POP)) 436 if (!NULL (POP))
463 { 437 {
464 QUIT; 438 QUIT;
465 pc = XSTRING (string_saved)->data + op; 439 pc = XSTRING (string_saved)->data + op;
466 } 440 }
467 break; 441 break;
468 442
469 case Bgotoifnilelsepop: 443 case Bgotoifnilelsepop:
470 op = FETCH2; 444 op = FETCH2;
471 if (NILP (TOP)) 445 if (NULL (TOP))
472 { 446 {
473 QUIT; 447 QUIT;
474 pc = XSTRING (string_saved)->data + op; 448 pc = XSTRING (string_saved)->data + op;
475 } 449 }
476 else DISCARD (1); 450 else DISCARD(1);
477 break; 451 break;
478 452
479 case Bgotoifnonnilelsepop: 453 case Bgotoifnonnilelsepop:
480 op = FETCH2; 454 op = FETCH2;
481 if (!NILP (TOP)) 455 if (!NULL (TOP))
482 { 456 {
483 QUIT; 457 QUIT;
484 pc = XSTRING (string_saved)->data + op; 458 pc = XSTRING (string_saved)->data + op;
485 } 459 }
486 else DISCARD (1); 460 else DISCARD(1);
487 break;
488
489 case BRgoto:
490 QUIT;
491 pc += *pc - 127;
492 break;
493
494 case BRgotoifnil:
495 if (NILP (POP))
496 {
497 QUIT;
498 pc += *pc - 128;
499 }
500 pc++;
501 break;
502
503 case BRgotoifnonnil:
504 if (!NILP (POP))
505 {
506 QUIT;
507 pc += *pc - 128;
508 }
509 pc++;
510 break;
511
512 case BRgotoifnilelsepop:
513 op = *pc++;
514 if (NILP (TOP))
515 {
516 QUIT;
517 pc += op - 128;
518 }
519 else DISCARD (1);
520 break;
521
522 case BRgotoifnonnilelsepop:
523 op = *pc++;
524 if (!NILP (TOP))
525 {
526 QUIT;
527 pc += op - 128;
528 }
529 else DISCARD (1);
530 break; 461 break;
531 462
532 case Breturn: 463 case Breturn:
533 v1 = POP; 464 v1 = POP;
534 goto exit; 465 goto exit;
535 466
536 case Bdiscard: 467 case Bdiscard:
537 DISCARD (1); 468 DISCARD(1);
538 break; 469 break;
539 470
540 case Bdup: 471 case Bdup:
541 v1 = TOP; 472 v1 = TOP;
542 PUSH (v1); 473 PUSH (v1);
596 immediate_quit = 1; 527 immediate_quit = 1;
597 while (--op >= 0) 528 while (--op >= 0)
598 { 529 {
599 if (CONSP (v1)) 530 if (CONSP (v1))
600 v1 = XCONS (v1)->cdr; 531 v1 = XCONS (v1)->cdr;
601 else if (!NILP (v1)) 532 else if (!NULL (v1))
602 { 533 {
603 immediate_quit = 0; 534 immediate_quit = 0;
604 v1 = wrong_type_argument (Qlistp, v1); 535 v1 = wrong_type_argument (Qlistp, v1);
605 immediate_quit = 1; 536 immediate_quit = 1;
606 op++; 537 op++;
620 case Bstringp: 551 case Bstringp:
621 TOP = XTYPE (TOP) == Lisp_String ? Qt : Qnil; 552 TOP = XTYPE (TOP) == Lisp_String ? Qt : Qnil;
622 break; 553 break;
623 554
624 case Blistp: 555 case Blistp:
625 TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil; 556 TOP = CONSP (TOP) || NULL (TOP) ? Qt : Qnil;
626 break; 557 break;
627 558
628 case Beq: 559 case Beq:
629 v1 = POP; 560 v1 = POP;
630 TOP = EQ (v1, TOP) ? Qt : Qnil; 561 TOP = EQ (v1, TOP) ? Qt : Qnil;
634 v1 = POP; 565 v1 = POP;
635 TOP = Fmemq (TOP, v1); 566 TOP = Fmemq (TOP, v1);
636 break; 567 break;
637 568
638 case Bnot: 569 case Bnot:
639 TOP = NILP (TOP) ? Qt : Qnil; 570 TOP = NULL (TOP) ? Qt : Qnil;
640 break; 571 break;
641 572
642 case Bcar: 573 case Bcar:
643 v1 = TOP; 574 v1 = TOP;
644 docar: 575 docar:
645 if (CONSP (v1)) TOP = XCONS (v1)->car; 576 if (CONSP (v1)) TOP = XCONS (v1)->car;
646 else if (NILP (v1)) TOP = Qnil; 577 else if (NULL (v1)) TOP = Qnil;
647 else Fcar (wrong_type_argument (Qlistp, v1)); 578 else Fcar (wrong_type_argument (Qlistp, v1));
648 break; 579 break;
649 580
650 case Bcdr: 581 case Bcdr:
651 v1 = TOP; 582 v1 = TOP;
652 if (CONSP (v1)) TOP = XCONS (v1)->cdr; 583 if (CONSP (v1)) TOP = XCONS (v1)->cdr;
653 else if (NILP (v1)) TOP = Qnil; 584 else if (NULL (v1)) TOP = Qnil;
654 else Fcdr (wrong_type_argument (Qlistp, v1)); 585 else Fcdr (wrong_type_argument (Qlistp, v1));
655 break; 586 break;
656 587
657 case Bcons: 588 case Bcons:
658 v1 = POP; 589 v1 = POP;
667 v1 = POP; 598 v1 = POP;
668 TOP = Fcons (TOP, Fcons (v1, Qnil)); 599 TOP = Fcons (TOP, Fcons (v1, Qnil));
669 break; 600 break;
670 601
671 case Blist3: 602 case Blist3:
672 DISCARD (2); 603 DISCARD(2);
673 TOP = Flist (3, &TOP); 604 TOP = Flist (3, &TOP);
674 break; 605 break;
675 606
676 case Blist4: 607 case Blist4:
677 DISCARD (3); 608 DISCARD(3);
678 TOP = Flist (4, &TOP); 609 TOP = Flist (4, &TOP);
679 break;
680
681 case BlistN:
682 op = FETCH;
683 DISCARD (op - 1);
684 TOP = Flist (op, &TOP);
685 break; 610 break;
686 611
687 case Blength: 612 case Blength:
688 TOP = Flength (TOP); 613 TOP = Flength (TOP);
689 break; 614 break;
725 v2 = POP; v1 = POP; 650 v2 = POP; v1 = POP;
726 TOP = Fsubstring (TOP, v1, v2); 651 TOP = Fsubstring (TOP, v1, v2);
727 break; 652 break;
728 653
729 case Bconcat2: 654 case Bconcat2:
730 DISCARD (1); 655 DISCARD(1);
731 TOP = Fconcat (2, &TOP); 656 TOP = Fconcat (2, &TOP);
732 break; 657 break;
733 658
734 case Bconcat3: 659 case Bconcat3:
735 DISCARD (2); 660 DISCARD(2);
736 TOP = Fconcat (3, &TOP); 661 TOP = Fconcat (3, &TOP);
737 break; 662 break;
738 663
739 case Bconcat4: 664 case Bconcat4:
740 DISCARD (3); 665 DISCARD(3);
741 TOP = Fconcat (4, &TOP); 666 TOP = Fconcat (4, &TOP);
742 break;
743
744 case BconcatN:
745 op = FETCH;
746 DISCARD (op - 1);
747 TOP = Fconcat (op, &TOP);
748 break; 667 break;
749 668
750 case Bsub1: 669 case Bsub1:
751 v1 = TOP; 670 v1 = TOP;
752 if (XTYPE (v1) == Lisp_Int) 671 if (XTYPE (v1) == Lisp_Int)
795 v1 = POP; 714 v1 = POP;
796 TOP = Fgeq (TOP, v1); 715 TOP = Fgeq (TOP, v1);
797 break; 716 break;
798 717
799 case Bdiff: 718 case Bdiff:
800 DISCARD (1); 719 DISCARD(1);
801 TOP = Fminus (2, &TOP); 720 TOP = Fminus (2, &TOP);
802 break; 721 break;
803 722
804 case Bnegate: 723 case Bnegate:
805 v1 = TOP; 724 v1 = TOP;
811 else 730 else
812 TOP = Fminus (1, &TOP); 731 TOP = Fminus (1, &TOP);
813 break; 732 break;
814 733
815 case Bplus: 734 case Bplus:
816 DISCARD (1); 735 DISCARD(1);
817 TOP = Fplus (2, &TOP); 736 TOP = Fplus (2, &TOP);
818 break; 737 break;
819 738
820 case Bmax: 739 case Bmax:
821 DISCARD (1); 740 DISCARD(1);
822 TOP = Fmax (2, &TOP); 741 TOP = Fmax (2, &TOP);
823 break; 742 break;
824 743
825 case Bmin: 744 case Bmin:
826 DISCARD (1); 745 DISCARD(1);
827 TOP = Fmin (2, &TOP); 746 TOP = Fmin (2, &TOP);
828 break; 747 break;
829 748
830 case Bmult: 749 case Bmult:
831 DISCARD (1); 750 DISCARD(1);
832 TOP = Ftimes (2, &TOP); 751 TOP = Ftimes (2, &TOP);
833 break; 752 break;
834 753
835 case Bquo: 754 case Bquo:
836 DISCARD (1); 755 DISCARD(1);
837 TOP = Fquo (2, &TOP); 756 TOP = Fquo (2, &TOP);
838 break; 757 break;
839 758
840 case Brem: 759 case Brem:
841 v1 = POP; 760 v1 = POP;
761 /* This had args in the wrong order. -- jwz */
842 TOP = Frem (TOP, v1); 762 TOP = Frem (TOP, v1);
843 break; 763 break;
844 764
845 case Bpoint: 765 case Bpoint:
846 XFASTINT (v1) = point; 766 XFASTINT (v1) = point;
853 773
854 case Binsert: 774 case Binsert:
855 TOP = Finsert (1, &TOP); 775 TOP = Finsert (1, &TOP);
856 break; 776 break;
857 777
858 case BinsertN:
859 op = FETCH;
860 DISCARD (op - 1);
861 TOP = Finsert (op, &TOP);
862 break;
863
864 case Bpoint_max: 778 case Bpoint_max:
865 XFASTINT (v1) = ZV; 779 XFASTINT (v1) = ZV;
866 PUSH (v1); 780 PUSH (v1);
867 break; 781 break;
868 782
926 case Binteractive_p: 840 case Binteractive_p:
927 PUSH (Finteractive_p ()); 841 PUSH (Finteractive_p ());
928 break; 842 break;
929 843
930 case Bforward_char: 844 case Bforward_char:
845 /* This was wrong! --jwz */
931 TOP = Fforward_char (TOP); 846 TOP = Fforward_char (TOP);
932 break; 847 break;
933 848
934 case Bforward_word: 849 case Bforward_word:
850 /* This was wrong! --jwz */
935 TOP = Fforward_word (TOP); 851 TOP = Fforward_word (TOP);
936 break; 852 break;
937 853
938 case Bskip_chars_forward: 854 case Bskip_chars_forward:
855 /* This was wrong! --jwz */
939 v1 = POP; 856 v1 = POP;
940 TOP = Fskip_chars_forward (TOP, v1); 857 TOP = Fskip_chars_forward (TOP, v1);
941 break; 858 break;
942 859
943 case Bskip_chars_backward: 860 case Bskip_chars_backward:
861 /* This was wrong! --jwz */
944 v1 = POP; 862 v1 = POP;
945 TOP = Fskip_chars_backward (TOP, v1); 863 TOP = Fskip_chars_backward (TOP, v1);
946 break; 864 break;
947 865
948 case Bforward_line: 866 case Bforward_line:
867 /* This was wrong! --jwz */
949 TOP = Fforward_line (TOP); 868 TOP = Fforward_line (TOP);
950 break; 869 break;
951 870
952 case Bchar_syntax: 871 case Bchar_syntax:
953 CHECK_NUMBER (TOP, 0); 872 CHECK_NUMBER (TOP, 0);
959 TOP = Fbuffer_substring (TOP, v1); 878 TOP = Fbuffer_substring (TOP, v1);
960 break; 879 break;
961 880
962 case Bdelete_region: 881 case Bdelete_region:
963 v1 = POP; 882 v1 = POP;
883 /* This had args in the wrong order. -- jwz */
964 TOP = Fdelete_region (TOP, v1); 884 TOP = Fdelete_region (TOP, v1);
965 break; 885 break;
966 886
967 case Bnarrow_to_region: 887 case Bnarrow_to_region:
968 v1 = POP; 888 v1 = POP;
889 /* This had args in the wrong order. -- jwz */
969 TOP = Fnarrow_to_region (TOP, v1); 890 TOP = Fnarrow_to_region (TOP, v1);
970 break; 891 break;
971 892
972 case Bwiden: 893 case Bwiden:
973 PUSH (Fwiden ()); 894 PUSH (Fwiden ());
974 break; 895 break;
975 896
976 case Bend_of_line:
977 TOP = Fend_of_line (TOP);
978 break;
979
980 case Bset_marker:
981 v1 = POP;
982 v2 = POP;
983 TOP = Fset_marker (TOP, v2, v1);
984 break;
985
986 case Bmatch_beginning:
987 TOP = Fmatch_beginning (TOP);
988 break;
989
990 case Bmatch_end:
991 TOP = Fmatch_end (TOP);
992 break;
993
994 case Bupcase:
995 TOP = Fupcase (TOP);
996 break;
997
998 case Bdowncase:
999 TOP = Fdowncase (TOP);
1000 break;
1001
1002 case Bstringeqlsign: 897 case Bstringeqlsign:
1003 v1 = POP; 898 v1 = POP;
899 /* This had args in the wrong order. -- jwz */
1004 TOP = Fstring_equal (TOP, v1); 900 TOP = Fstring_equal (TOP, v1);
1005 break; 901 break;
1006 902
1007 case Bstringlss: 903 case Bstringlss:
1008 v1 = POP; 904 v1 = POP;
905 /* This had args in the wrong order. -- jwz */
1009 TOP = Fstring_lessp (TOP, v1); 906 TOP = Fstring_lessp (TOP, v1);
1010 break; 907 break;
1011 908
1012 case Bequal: 909 case Bequal:
1013 v1 = POP; 910 v1 = POP;
911 /* This had args in the wrong order. -- jwz */
1014 TOP = Fequal (TOP, v1); 912 TOP = Fequal (TOP, v1);
1015 break; 913 break;
1016 914
1017 case Bnthcdr: 915 case Bnthcdr:
1018 v1 = POP; 916 v1 = POP;
917 /* This had args in the wrong order. -- jwz */
1019 TOP = Fnthcdr (TOP, v1); 918 TOP = Fnthcdr (TOP, v1);
1020 break; 919 break;
1021 920
1022 case Belt: 921 case Belt:
1023 if (XTYPE (TOP) == Lisp_Cons) 922 if (XTYPE (TOP) == Lisp_Cons)
1031 TOP = Felt (TOP, v1); 930 TOP = Felt (TOP, v1);
1032 break; 931 break;
1033 932
1034 case Bmember: 933 case Bmember:
1035 v1 = POP; 934 v1 = POP;
935 /* This had args in the wrong order. -- jwz */
1036 TOP = Fmember (TOP, v1); 936 TOP = Fmember (TOP, v1);
1037 break; 937 break;
1038 938
1039 case Bassq: 939 case Bassq:
1040 v1 = POP; 940 v1 = POP;
941 /* This had args in the wrong order. -- jwz */
1041 TOP = Fassq (TOP, v1); 942 TOP = Fassq (TOP, v1);
1042 break; 943 break;
1043 944
1044 case Bnreverse: 945 case Bnreverse:
1045 TOP = Fnreverse (TOP); 946 TOP = Fnreverse (TOP);
1046 break; 947 break;
1047 948
1048 case Bsetcar: 949 case Bsetcar:
1049 v1 = POP; 950 v1 = POP;
951 /* This had args in the wrong order. -- jwz */
1050 TOP = Fsetcar (TOP, v1); 952 TOP = Fsetcar (TOP, v1);
1051 break; 953 break;
1052 954
1053 case Bsetcdr: 955 case Bsetcdr:
1054 v1 = POP; 956 v1 = POP;
957 /* This had args in the wrong order. -- jwz */
1055 TOP = Fsetcdr (TOP, v1); 958 TOP = Fsetcdr (TOP, v1);
1056 break; 959 break;
1057 960
1058 case Bcar_safe: 961 case Bcar_safe:
1059 v1 = TOP; 962 v1 = TOP;
1070 else 973 else
1071 TOP = Qnil; 974 TOP = Qnil;
1072 break; 975 break;
1073 976
1074 case Bnconc: 977 case Bnconc:
1075 DISCARD (1); 978 DISCARD(1);
1076 TOP = Fnconc (2, &TOP); 979 TOP = Fnconc (2, &TOP);
1077 break; 980 break;
1078 981
1079 case Bnumberp: 982 case Bnumberp:
1080 TOP = (NUMBERP (TOP) ? Qt : Qnil); 983 TOP = (XTYPE (TOP) == Lisp_Int || XTYPE (TOP) == Lisp_Float
984 ? Qt : Qnil);
1081 break; 985 break;
1082 986
1083 case Bintegerp: 987 case Bintegerp:
1084 TOP = XTYPE (TOP) == Lisp_Int ? Qt : Qnil; 988 TOP = XTYPE (TOP) == Lisp_Int ? Qt : Qnil;
1085 break; 989 break;
1090 break; 994 break;
1091 case Bscan_buffer: 995 case Bscan_buffer:
1092 error ("scan-buffer is an obsolete bytecode"); 996 error ("scan-buffer is an obsolete bytecode");
1093 break; 997 break;
1094 case Bmark: 998 case Bmark:
1095 error ("mark is an obsolete bytecode"); 999 error("mark is an obsolete bytecode");
1096 break; 1000 break;
1097 #endif 1001 #endif
1098 1002
1099 default: 1003 default:
1100 #ifdef BYTE_CODE_SAFE 1004 #ifdef BYTE_CODE_SAFE
1129 defsubr (&Sbyte_code); 1033 defsubr (&Sbyte_code);
1130 1034
1131 #ifdef BYTE_CODE_METER 1035 #ifdef BYTE_CODE_METER
1132 1036
1133 DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter, 1037 DEFVAR_LISP ("byte-code-meter", &Vbyte_code_meter,
1134 "A vector of vectors which holds a histogram of byte-code usage."); 1038 "a vector of vectors which holds a histogram of byte-code usage.");
1135 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, ""); 1039 DEFVAR_BOOL ("byte-metering-on", &byte_metering_on, "");
1136 1040
1137 byte_metering_on = 0; 1041 byte_metering_on = 0;
1138 Vbyte_code_meter = Fmake_vector (make_number (256), make_number (0)); 1042 Vbyte_code_meter = Fmake_vector(make_number(256), make_number(0));
1139 Qbyte_code_meter = intern ("byte-code-meter"); 1043
1140 staticpro (&Qbyte_code_meter);
1141 { 1044 {
1142 int i = 256; 1045 int i = 256;
1143 while (i--) 1046 while (i--)
1144 XVECTOR (Vbyte_code_meter)->contents[i] = 1047 XVECTOR(Vbyte_code_meter)->contents[i] =
1145 Fmake_vector (make_number (256), make_number (0)); 1048 Fmake_vector(make_number(256), make_number(0));
1146 } 1049 }
1147 #endif 1050 #endif
1148 } 1051 }