aboutsummaryrefslogtreecommitdiffstats
path: root/src/bytecode.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/bytecode.c')
-rw-r--r--src/bytecode.c817
1 files changed, 519 insertions, 298 deletions
diff --git a/src/bytecode.c b/src/bytecode.c
index fb94cf8e1d7..57639d97972 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -225,6 +225,7 @@ Lisp_Object Qbytecode;
225#define Bconstant 0300 225#define Bconstant 0300
226#define CONSTANTLIM 0100 226#define CONSTANTLIM 0100
227 227
228
228/* Structure describing a value stack used during byte-code execution 229/* Structure describing a value stack used during byte-code execution
229 in Fbyte_code. */ 230 in Fbyte_code. */
230 231
@@ -260,6 +261,7 @@ struct byte_stack
260 261
261struct byte_stack *byte_stack_list; 262struct byte_stack *byte_stack_list;
262 263
264
263/* Mark objects on byte_stack_list. Called during GC. */ 265/* Mark objects on byte_stack_list. Called during GC. */
264 266
265void 267void
@@ -299,22 +301,20 @@ relocate_byte_pcs ()
299 } 301 }
300} 302}
301 303
302
303 304
304/* Fetch the next byte from the bytecode stream */ 305/* Fetch the next byte from the bytecode stream */
305 306
306#define FETCH *stack.pc++ 307#define FETCH *stack.pc++
307 308
308/* Fetch two bytes from the bytecode stream 309/* Fetch two bytes from the bytecode stream and make a 16-bit number
309 and make a 16-bit number out of them */ 310 out of them */
310 311
311#define FETCH2 (op = FETCH, op + (FETCH << 8)) 312#define FETCH2 (op = FETCH, op + (FETCH << 8))
312 313
313/* Push x onto the execution stack. */ 314/* Push x onto the execution stack. This used to be #define PUSH(x)
314 315 (*++stackp = (x)) This oddity is necessary because Alliant can't be
315/* This used to be #define PUSH(x) (*++stackp = (x)) This oddity is 316 bothered to compile the preincrement operator properly, as of 4/91.
316 necessary because Alliant can't be bothered to compile the 317 -JimB */
317 preincrement operator properly, as of 4/91. -JimB */
318 318
319#define PUSH(x) (top++, *top = (x)) 319#define PUSH(x) (top++, *top = (x))
320 320
@@ -331,7 +331,7 @@ relocate_byte_pcs ()
331 331
332#define TOP (*top) 332#define TOP (*top)
333 333
334/* Actions that must performed before and after calling a function 334/* Actions that must be performed before and after calling a function
335 that might GC. */ 335 that might GC. */
336 336
337#define BEFORE_POTENTIAL_GC() stack.top = top 337#define BEFORE_POTENTIAL_GC() stack.top = top
@@ -353,14 +353,14 @@ relocate_byte_pcs ()
353 353
354#ifdef BYTE_CODE_SAFE 354#ifdef BYTE_CODE_SAFE
355 355
356#define CHECK_RANGE(ARG) \ 356#define CHECK_RANGE(ARG) \
357 if (ARG >= bytestr_length) abort () 357 if (ARG >= bytestr_length) abort ()
358 358
359#else 359#else /* not BYTE_CODE_SAFE */
360 360
361#define CHECK_RANGE(ARG) 361#define CHECK_RANGE(ARG)
362 362
363#endif 363#endif /* not BYTE_CODE_SAFE */
364 364
365 365
366DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, 366DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
@@ -378,8 +378,7 @@ If the third argument is incorrect, Emacs may crash.")
378 int prev_op; 378 int prev_op;
379#endif 379#endif
380 int op; 380 int op;
381 Lisp_Object v1, v2; 381 /* Lisp_Object v1, v2; */
382 Lisp_Object *stackp;
383 Lisp_Object *vectorp = XVECTOR (vector)->contents; 382 Lisp_Object *vectorp = XVECTOR (vector)->contents;
384#ifdef BYTE_CODE_SAFE 383#ifdef BYTE_CODE_SAFE
385 int const_length = XVECTOR (vector)->size; 384 int const_length = XVECTOR (vector)->size;
@@ -388,6 +387,7 @@ If the third argument is incorrect, Emacs may crash.")
388 int bytestr_length = STRING_BYTES (XSTRING (bytestr)); 387 int bytestr_length = STRING_BYTES (XSTRING (bytestr));
389 struct byte_stack stack; 388 struct byte_stack stack;
390 Lisp_Object *top; 389 Lisp_Object *top;
390 Lisp_Object result;
391 391
392 CHECK_STRING (bytestr, 0); 392 CHECK_STRING (bytestr, 0);
393 if (!VECTORP (vector)) 393 if (!VECTORP (vector))
@@ -423,38 +423,92 @@ If the third argument is incorrect, Emacs may crash.")
423 prev_op = this_op; 423 prev_op = this_op;
424 this_op = op = FETCH; 424 this_op = op = FETCH;
425 METER_CODE (prev_op, op); 425 METER_CODE (prev_op, op);
426 switch (op)
427#else 426#else
428 switch (op = FETCH) 427 op = FETCH;
429#endif 428#endif
430 {
431 case Bvarref+6:
432 op = FETCH;
433 goto varref;
434 429
435 case Bvarref+7: 430 switch (op)
431 {
432 case Bvarref + 7:
436 op = FETCH2; 433 op = FETCH2;
437 goto varref; 434 goto varref;
438 435
439 case Bvarref: case Bvarref+1: case Bvarref+2: case Bvarref+3: 436 case Bvarref:
440 case Bvarref+4: case Bvarref+5: 437 case Bvarref + 1:
438 case Bvarref + 2:
439 case Bvarref + 3:
440 case Bvarref + 4:
441 case Bvarref + 5:
441 op = op - Bvarref; 442 op = op - Bvarref;
443 goto varref;
444
445 /* This seems to be the most frequently executed byte-code
446 among the Bvarref's, so avoid a goto here. */
447 case Bvarref+6:
448 op = FETCH;
442 varref: 449 varref:
443 v1 = vectorp[op]; 450 {
444 if (!SYMBOLP (v1)) 451 Lisp_Object v1, v2;
445 v2 = Fsymbol_value (v1); 452
446 else 453 v1 = vectorp[op];
454 if (SYMBOLP (v1))
455 {
456 v2 = XSYMBOL (v1)->value;
457 if (MISCP (v2) || EQ (v2, Qunbound))
458 v2 = Fsymbol_value (v1);
459 }
460 else
461 v2 = Fsymbol_value (v1);
462 PUSH (v2);
463 break;
464 }
465
466 case Bgotoifnil:
467 MAYBE_GC ();
468 op = FETCH2;
469 if (NILP (POP))
447 { 470 {
448 v2 = XSYMBOL (v1)->value; 471 QUIT;
449 if (MISCP (v2) || EQ (v2, Qunbound)) 472 CHECK_RANGE (op);
450 v2 = Fsymbol_value (v1); 473 stack.pc = stack.byte_string_start + op;
451 } 474 }
452 PUSH (v2);
453 break; 475 break;
454 476
455 case Bvarset+6: 477 case Bcar:
456 op = FETCH; 478 {
457 goto varset; 479 Lisp_Object v1;
480 v1 = TOP;
481 if (CONSP (v1)) TOP = XCAR (v1);
482 else if (NILP (v1)) TOP = Qnil;
483 else Fcar (wrong_type_argument (Qlistp, v1));
484 break;
485 }
486
487 case Beq:
488 {
489 Lisp_Object v1;
490 v1 = POP;
491 TOP = EQ (v1, TOP) ? Qt : Qnil;
492 break;
493 }
494
495 case Bmemq:
496 {
497 Lisp_Object v1;
498 v1 = POP;
499 TOP = Fmemq (TOP, v1);
500 break;
501 }
502
503 case Bcdr:
504 {
505 Lisp_Object v1;
506 v1 = TOP;
507 if (CONSP (v1)) TOP = XCDR (v1);
508 else if (NILP (v1)) TOP = Qnil;
509 else Fcdr (wrong_type_argument (Qlistp, v1));
510 break;
511 }
458 512
459 case Bvarset+7: 513 case Bvarset+7:
460 op = FETCH2; 514 op = FETCH2;
@@ -463,10 +517,25 @@ If the third argument is incorrect, Emacs may crash.")
463 case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3: 517 case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3:
464 case Bvarset+4: case Bvarset+5: 518 case Bvarset+4: case Bvarset+5:
465 op -= Bvarset; 519 op -= Bvarset;
520 goto varset;
521
522 case Bvarset+6:
523 op = FETCH;
466 varset: 524 varset:
467 Fset (vectorp[op], POP); 525 set_internal (vectorp[op], POP, 0);
526 /* Fset (vectorp[op], POP); */
468 break; 527 break;
469 528
529 case Bdup:
530 {
531 Lisp_Object v1;
532 v1 = TOP;
533 PUSH (v1);
534 break;
535 }
536
537 /* ------------------ */
538
470 case Bvarbind+6: 539 case Bvarbind+6:
471 op = FETCH; 540 op = FETCH;
472 goto varbind; 541 goto varbind;
@@ -494,24 +563,28 @@ If the third argument is incorrect, Emacs may crash.")
494 case Bcall+4: case Bcall+5: 563 case Bcall+4: case Bcall+5:
495 op -= Bcall; 564 op -= Bcall;
496 docall: 565 docall:
497 DISCARD (op); 566 {
567 DISCARD (op);
498#ifdef BYTE_CODE_METER 568#ifdef BYTE_CODE_METER
499 if (byte_metering_on && SYMBOLP (TOP)) 569 if (byte_metering_on && SYMBOLP (TOP))
500 { 570 {
501 v1 = TOP; 571 Lisp_Object v1, v2;
502 v2 = Fget (v1, Qbyte_code_meter); 572
503 if (INTEGERP (v2) 573 v1 = TOP;
504 && XINT (v2) != ((1<<VALBITS)-1)) 574 v2 = Fget (v1, Qbyte_code_meter);
505 { 575 if (INTEGERP (v2)
506 XSETINT (v2, XINT (v2) + 1); 576 && XINT (v2) != ((1<<VALBITS)-1))
507 Fput (v1, Qbyte_code_meter, v2); 577 {
508 } 578 XSETINT (v2, XINT (v2) + 1);
509 } 579 Fput (v1, Qbyte_code_meter, v2);
580 }
581 }
510#endif 582#endif
511 BEFORE_POTENTIAL_GC (); 583 BEFORE_POTENTIAL_GC ();
512 TOP = Ffuncall (op + 1, &TOP); 584 TOP = Ffuncall (op + 1, &TOP);
513 AFTER_POTENTIAL_GC (); 585 AFTER_POTENTIAL_GC ();
514 break; 586 break;
587 }
515 588
516 case Bunbind+6: 589 case Bunbind+6:
517 op = FETCH; 590 op = FETCH;
@@ -546,17 +619,6 @@ If the third argument is incorrect, Emacs may crash.")
546 stack.pc = stack.byte_string_start + op; 619 stack.pc = stack.byte_string_start + op;
547 break; 620 break;
548 621
549 case Bgotoifnil:
550 MAYBE_GC ();
551 op = FETCH2;
552 if (NILP (POP))
553 {
554 QUIT;
555 CHECK_RANGE (op);
556 stack.pc = stack.byte_string_start + op;
557 }
558 break;
559
560 case Bgotoifnonnil: 622 case Bgotoifnonnil:
561 MAYBE_GC (); 623 MAYBE_GC ();
562 op = FETCH2; 624 op = FETCH2;
@@ -641,18 +703,13 @@ If the third argument is incorrect, Emacs may crash.")
641 break; 703 break;
642 704
643 case Breturn: 705 case Breturn:
644 v1 = POP; 706 result = POP;
645 goto exit; 707 goto exit;
646 708
647 case Bdiscard: 709 case Bdiscard:
648 DISCARD (1); 710 DISCARD (1);
649 break; 711 break;
650 712
651 case Bdup:
652 v1 = TOP;
653 PUSH (v1);
654 break;
655
656 case Bconstant2: 713 case Bconstant2:
657 PUSH (vectorp[FETCH2]); 714 PUSH (vectorp[FETCH2]);
658 break; 715 break;
@@ -667,7 +724,9 @@ If the third argument is incorrect, Emacs may crash.")
667 break; 724 break;
668 725
669 case Bsave_window_excursion: 726 case Bsave_window_excursion:
727 BEFORE_POTENTIAL_GC ();
670 TOP = Fsave_window_excursion (TOP); 728 TOP = Fsave_window_excursion (TOP);
729 AFTER_POTENTIAL_GC ();
671 break; 730 break;
672 731
673 case Bsave_restriction: 732 case Bsave_restriction:
@@ -675,11 +734,15 @@ If the third argument is incorrect, Emacs may crash.")
675 break; 734 break;
676 735
677 case Bcatch: 736 case Bcatch:
678 v1 = POP; 737 {
679 BEFORE_POTENTIAL_GC (); 738 Lisp_Object v1;
680 TOP = internal_catch (TOP, Feval, v1); 739
681 AFTER_POTENTIAL_GC (); 740 v1 = POP;
682 break; 741 BEFORE_POTENTIAL_GC ();
742 TOP = internal_catch (TOP, Feval, v1);
743 AFTER_POTENTIAL_GC ();
744 break;
745 }
683 746
684 case Bunwind_protect: 747 case Bunwind_protect:
685 record_unwind_protect (0, POP); 748 record_unwind_protect (0, POP);
@@ -687,49 +750,62 @@ If the third argument is incorrect, Emacs may crash.")
687 break; 750 break;
688 751
689 case Bcondition_case: 752 case Bcondition_case:
690 v1 = POP; 753 {
691 v1 = Fcons (POP, v1); 754 Lisp_Object v1;
692 BEFORE_POTENTIAL_GC (); 755 v1 = POP;
693 TOP = Fcondition_case (Fcons (TOP, v1)); 756 v1 = Fcons (POP, v1);
694 AFTER_POTENTIAL_GC (); 757 BEFORE_POTENTIAL_GC ();
695 break; 758 TOP = Fcondition_case (Fcons (TOP, v1));
759 AFTER_POTENTIAL_GC ();
760 break;
761 }
696 762
697 case Btemp_output_buffer_setup: 763 case Btemp_output_buffer_setup:
764 BEFORE_POTENTIAL_GC ();
698 temp_output_buffer_setup (XSTRING (TOP)->data); 765 temp_output_buffer_setup (XSTRING (TOP)->data);
766 AFTER_POTENTIAL_GC ();
699 TOP = Vstandard_output; 767 TOP = Vstandard_output;
700 break; 768 break;
701 769
702 case Btemp_output_buffer_show: 770 case Btemp_output_buffer_show:
703 v1 = POP; 771 {
704 temp_output_buffer_show (TOP); 772 Lisp_Object v1;
705 TOP = v1; 773 v1 = POP;
706 /* pop binding of standard-output */ 774 BEFORE_POTENTIAL_GC ();
707 BEFORE_POTENTIAL_GC (); 775 temp_output_buffer_show (TOP);
708 unbind_to (specpdl_ptr - specpdl - 1, Qnil); 776 TOP = v1;
709 AFTER_POTENTIAL_GC (); 777 /* pop binding of standard-output */
710 break; 778 unbind_to (specpdl_ptr - specpdl - 1, Qnil);
779 AFTER_POTENTIAL_GC ();
780 break;
781 }
711 782
712 case Bnth: 783 case Bnth:
713 v1 = POP; 784 {
714 v2 = TOP; 785 Lisp_Object v1, v2;
715 nth_entry: 786 v1 = POP;
716 CHECK_NUMBER (v2, 0); 787 v2 = TOP;
717 op = XINT (v2); 788 CHECK_NUMBER (v2, 0);
718 immediate_quit = 1; 789 op = XINT (v2);
719 while (--op >= 0) 790 immediate_quit = 1;
720 { 791 while (--op >= 0)
721 if (CONSP (v1)) 792 {
722 v1 = XCDR (v1); 793 if (CONSP (v1))
723 else if (!NILP (v1)) 794 v1 = XCDR (v1);
724 { 795 else if (!NILP (v1))
725 immediate_quit = 0; 796 {
726 v1 = wrong_type_argument (Qlistp, v1); 797 immediate_quit = 0;
727 immediate_quit = 1; 798 v1 = wrong_type_argument (Qlistp, v1);
728 op++; 799 immediate_quit = 1;
729 } 800 op++;
730 } 801 }
731 immediate_quit = 0; 802 }
732 goto docar; 803 immediate_quit = 0;
804 if (CONSP (v1)) TOP = XCAR (v1);
805 else if (NILP (v1)) TOP = Qnil;
806 else Fcar (wrong_type_argument (Qlistp, v1));
807 break;
808 }
733 809
734 case Bsymbolp: 810 case Bsymbolp:
735 TOP = SYMBOLP (TOP) ? Qt : Qnil; 811 TOP = SYMBOLP (TOP) ? Qt : Qnil;
@@ -747,48 +823,29 @@ If the third argument is incorrect, Emacs may crash.")
747 TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil; 823 TOP = CONSP (TOP) || NILP (TOP) ? Qt : Qnil;
748 break; 824 break;
749 825
750 case Beq:
751 v1 = POP;
752 TOP = EQ (v1, TOP) ? Qt : Qnil;
753 break;
754
755 case Bmemq:
756 v1 = POP;
757 TOP = Fmemq (TOP, v1);
758 break;
759
760 case Bnot: 826 case Bnot:
761 TOP = NILP (TOP) ? Qt : Qnil; 827 TOP = NILP (TOP) ? Qt : Qnil;
762 break; 828 break;
763 829
764 case Bcar:
765 v1 = TOP;
766 docar:
767 if (CONSP (v1)) TOP = XCAR (v1);
768 else if (NILP (v1)) TOP = Qnil;
769 else Fcar (wrong_type_argument (Qlistp, v1));
770 break;
771
772 case Bcdr:
773 v1 = TOP;
774 if (CONSP (v1)) TOP = XCDR (v1);
775 else if (NILP (v1)) TOP = Qnil;
776 else Fcdr (wrong_type_argument (Qlistp, v1));
777 break;
778
779 case Bcons: 830 case Bcons:
780 v1 = POP; 831 {
781 TOP = Fcons (TOP, v1); 832 Lisp_Object v1;
782 break; 833 v1 = POP;
834 TOP = Fcons (TOP, v1);
835 break;
836 }
783 837
784 case Blist1: 838 case Blist1:
785 TOP = Fcons (TOP, Qnil); 839 TOP = Fcons (TOP, Qnil);
786 break; 840 break;
787 841
788 case Blist2: 842 case Blist2:
789 v1 = POP; 843 {
790 TOP = Fcons (TOP, Fcons (v1, Qnil)); 844 Lisp_Object v1;
791 break; 845 v1 = POP;
846 TOP = Fcons (TOP, Fcons (v1, Qnil));
847 break;
848 }
792 849
793 case Blist3: 850 case Blist3:
794 DISCARD (2); 851 DISCARD (2);
@@ -811,14 +868,20 @@ If the third argument is incorrect, Emacs may crash.")
811 break; 868 break;
812 869
813 case Baref: 870 case Baref:
814 v1 = POP; 871 {
815 TOP = Faref (TOP, v1); 872 Lisp_Object v1;
816 break; 873 v1 = POP;
874 TOP = Faref (TOP, v1);
875 break;
876 }
817 877
818 case Baset: 878 case Baset:
819 v2 = POP; v1 = POP; 879 {
820 TOP = Faset (TOP, v1, v2); 880 Lisp_Object v1, v2;
821 break; 881 v2 = POP; v1 = POP;
882 TOP = Faset (TOP, v1, v2);
883 break;
884 }
822 885
823 case Bsymbol_value: 886 case Bsymbol_value:
824 TOP = Fsymbol_value (TOP); 887 TOP = Fsymbol_value (TOP);
@@ -829,24 +892,36 @@ If the third argument is incorrect, Emacs may crash.")
829 break; 892 break;
830 893
831 case Bset: 894 case Bset:
832 v1 = POP; 895 {
833 TOP = Fset (TOP, v1); 896 Lisp_Object v1;
834 break; 897 v1 = POP;
898 TOP = Fset (TOP, v1);
899 break;
900 }
835 901
836 case Bfset: 902 case Bfset:
837 v1 = POP; 903 {
838 TOP = Ffset (TOP, v1); 904 Lisp_Object v1;
839 break; 905 v1 = POP;
906 TOP = Ffset (TOP, v1);
907 break;
908 }
840 909
841 case Bget: 910 case Bget:
842 v1 = POP; 911 {
843 TOP = Fget (TOP, v1); 912 Lisp_Object v1;
844 break; 913 v1 = POP;
914 TOP = Fget (TOP, v1);
915 break;
916 }
845 917
846 case Bsubstring: 918 case Bsubstring:
847 v2 = POP; v1 = POP; 919 {
848 TOP = Fsubstring (TOP, v1, v2); 920 Lisp_Object v1, v2;
849 break; 921 v2 = POP; v1 = POP;
922 TOP = Fsubstring (TOP, v1, v2);
923 break;
924 }
850 925
851 case Bconcat2: 926 case Bconcat2:
852 DISCARD (1); 927 DISCARD (1);
@@ -870,64 +945,85 @@ If the third argument is incorrect, Emacs may crash.")
870 break; 945 break;
871 946
872 case Bsub1: 947 case Bsub1:
873 v1 = TOP; 948 {
874 if (INTEGERP (v1)) 949 Lisp_Object v1;
875 { 950 v1 = TOP;
876 XSETINT (v1, XINT (v1) - 1); 951 if (INTEGERP (v1))
877 TOP = v1; 952 {
878 } 953 XSETINT (v1, XINT (v1) - 1);
879 else 954 TOP = v1;
880 TOP = Fsub1 (v1); 955 }
881 break; 956 else
957 TOP = Fsub1 (v1);
958 break;
959 }
882 960
883 case Badd1: 961 case Badd1:
884 v1 = TOP; 962 {
885 if (INTEGERP (v1)) 963 Lisp_Object v1;
886 { 964 v1 = TOP;
887 XSETINT (v1, XINT (v1) + 1); 965 if (INTEGERP (v1))
888 TOP = v1; 966 {
889 } 967 XSETINT (v1, XINT (v1) + 1);
890 else 968 TOP = v1;
891 TOP = Fadd1 (v1); 969 }
892 break; 970 else
971 TOP = Fadd1 (v1);
972 break;
973 }
893 974
894 case Beqlsign: 975 case Beqlsign:
895 v2 = POP; v1 = TOP; 976 {
896 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0); 977 Lisp_Object v1, v2;
897 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0); 978 v2 = POP; v1 = TOP;
979 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v1, 0);
980 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (v2, 0);
898#ifdef LISP_FLOAT_TYPE 981#ifdef LISP_FLOAT_TYPE
899 if (FLOATP (v1) || FLOATP (v2)) 982 if (FLOATP (v1) || FLOATP (v2))
900 { 983 {
901 double f1, f2; 984 double f1, f2;
902 985
903 f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1)); 986 f1 = (FLOATP (v1) ? XFLOAT_DATA (v1) : XINT (v1));
904 f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2)); 987 f2 = (FLOATP (v2) ? XFLOAT_DATA (v2) : XINT (v2));
905 TOP = (f1 == f2 ? Qt : Qnil); 988 TOP = (f1 == f2 ? Qt : Qnil);
906 } 989 }
907 else 990 else
908#endif 991#endif
909 TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil); 992 TOP = (XINT (v1) == XINT (v2) ? Qt : Qnil);
910 break; 993 break;
994 }
911 995
912 case Bgtr: 996 case Bgtr:
913 v1 = POP; 997 {
914 TOP = Fgtr (TOP, v1); 998 Lisp_Object v1;
915 break; 999 v1 = POP;
1000 TOP = Fgtr (TOP, v1);
1001 break;
1002 }
916 1003
917 case Blss: 1004 case Blss:
918 v1 = POP; 1005 {
919 TOP = Flss (TOP, v1); 1006 Lisp_Object v1;
920 break; 1007 v1 = POP;
1008 TOP = Flss (TOP, v1);
1009 break;
1010 }
921 1011
922 case Bleq: 1012 case Bleq:
923 v1 = POP; 1013 {
924 TOP = Fleq (TOP, v1); 1014 Lisp_Object v1;
925 break; 1015 v1 = POP;
1016 TOP = Fleq (TOP, v1);
1017 break;
1018 }
926 1019
927 case Bgeq: 1020 case Bgeq:
928 v1 = POP; 1021 {
929 TOP = Fgeq (TOP, v1); 1022 Lisp_Object v1;
930 break; 1023 v1 = POP;
1024 TOP = Fgeq (TOP, v1);
1025 break;
1026 }
931 1027
932 case Bdiff: 1028 case Bdiff:
933 DISCARD (1); 1029 DISCARD (1);
@@ -935,15 +1031,18 @@ If the third argument is incorrect, Emacs may crash.")
935 break; 1031 break;
936 1032
937 case Bnegate: 1033 case Bnegate:
938 v1 = TOP; 1034 {
939 if (INTEGERP (v1)) 1035 Lisp_Object v1;
940 { 1036 v1 = TOP;
941 XSETINT (v1, - XINT (v1)); 1037 if (INTEGERP (v1))
942 TOP = v1; 1038 {
943 } 1039 XSETINT (v1, - XINT (v1));
944 else 1040 TOP = v1;
945 TOP = Fminus (1, &TOP); 1041 }
946 break; 1042 else
1043 TOP = Fminus (1, &TOP);
1044 break;
1045 }
947 1046
948 case Bplus: 1047 case Bplus:
949 DISCARD (1); 1048 DISCARD (1);
@@ -971,60 +1070,89 @@ If the third argument is incorrect, Emacs may crash.")
971 break; 1070 break;
972 1071
973 case Brem: 1072 case Brem:
974 v1 = POP; 1073 {
975 TOP = Frem (TOP, v1); 1074 Lisp_Object v1;
976 break; 1075 v1 = POP;
1076 TOP = Frem (TOP, v1);
1077 break;
1078 }
977 1079
978 case Bpoint: 1080 case Bpoint:
979 XSETFASTINT (v1, PT); 1081 {
980 PUSH (v1); 1082 Lisp_Object v1;
981 break; 1083 XSETFASTINT (v1, PT);
1084 PUSH (v1);
1085 break;
1086 }
982 1087
983 case Bgoto_char: 1088 case Bgoto_char:
1089 BEFORE_POTENTIAL_GC ();
984 TOP = Fgoto_char (TOP); 1090 TOP = Fgoto_char (TOP);
1091 AFTER_POTENTIAL_GC ();
985 break; 1092 break;
986 1093
987 case Binsert: 1094 case Binsert:
1095 BEFORE_POTENTIAL_GC ();
988 TOP = Finsert (1, &TOP); 1096 TOP = Finsert (1, &TOP);
1097 AFTER_POTENTIAL_GC ();
989 break; 1098 break;
990 1099
991 case BinsertN: 1100 case BinsertN:
992 op = FETCH; 1101 op = FETCH;
993 DISCARD (op - 1); 1102 DISCARD (op - 1);
1103 BEFORE_POTENTIAL_GC ();
994 TOP = Finsert (op, &TOP); 1104 TOP = Finsert (op, &TOP);
1105 AFTER_POTENTIAL_GC ();
995 break; 1106 break;
996 1107
997 case Bpoint_max: 1108 case Bpoint_max:
998 XSETFASTINT (v1, ZV); 1109 {
999 PUSH (v1); 1110 Lisp_Object v1;
1000 break; 1111 XSETFASTINT (v1, ZV);
1112 PUSH (v1);
1113 break;
1114 }
1001 1115
1002 case Bpoint_min: 1116 case Bpoint_min:
1003 XSETFASTINT (v1, BEGV); 1117 {
1004 PUSH (v1); 1118 Lisp_Object v1;
1005 break; 1119 XSETFASTINT (v1, BEGV);
1120 PUSH (v1);
1121 break;
1122 }
1006 1123
1007 case Bchar_after: 1124 case Bchar_after:
1008 TOP = Fchar_after (TOP); 1125 TOP = Fchar_after (TOP);
1009 break; 1126 break;
1010 1127
1011 case Bfollowing_char: 1128 case Bfollowing_char:
1012 v1 = Ffollowing_char (); 1129 {
1013 PUSH (v1); 1130 Lisp_Object v1;
1014 break; 1131 v1 = Ffollowing_char ();
1132 PUSH (v1);
1133 break;
1134 }
1015 1135
1016 case Bpreceding_char: 1136 case Bpreceding_char:
1017 v1 = Fprevious_char (); 1137 {
1018 PUSH (v1); 1138 Lisp_Object v1;
1019 break; 1139 v1 = Fprevious_char ();
1140 PUSH (v1);
1141 break;
1142 }
1020 1143
1021 case Bcurrent_column: 1144 case Bcurrent_column:
1022 XSETFASTINT (v1, current_column ()); 1145 {
1023 PUSH (v1); 1146 Lisp_Object v1;
1024 break; 1147 XSETFASTINT (v1, current_column ());
1148 PUSH (v1);
1149 break;
1150 }
1025 1151
1026 case Bindent_to: 1152 case Bindent_to:
1153 BEFORE_POTENTIAL_GC ();
1027 TOP = Findent_to (TOP, Qnil); 1154 TOP = Findent_to (TOP, Qnil);
1155 AFTER_POTENTIAL_GC ();
1028 break; 1156 break;
1029 1157
1030 case Beolp: 1158 case Beolp:
@@ -1048,7 +1176,9 @@ If the third argument is incorrect, Emacs may crash.")
1048 break; 1176 break;
1049 1177
1050 case Bset_buffer: 1178 case Bset_buffer:
1179 BEFORE_POTENTIAL_GC ();
1051 TOP = Fset_buffer (TOP); 1180 TOP = Fset_buffer (TOP);
1181 AFTER_POTENTIAL_GC ();
1052 break; 1182 break;
1053 1183
1054 case Binteractive_p: 1184 case Binteractive_p:
@@ -1056,61 +1186,98 @@ If the third argument is incorrect, Emacs may crash.")
1056 break; 1186 break;
1057 1187
1058 case Bforward_char: 1188 case Bforward_char:
1189 BEFORE_POTENTIAL_GC ();
1059 TOP = Fforward_char (TOP); 1190 TOP = Fforward_char (TOP);
1191 AFTER_POTENTIAL_GC ();
1060 break; 1192 break;
1061 1193
1062 case Bforward_word: 1194 case Bforward_word:
1195 BEFORE_POTENTIAL_GC ();
1063 TOP = Fforward_word (TOP); 1196 TOP = Fforward_word (TOP);
1197 AFTER_POTENTIAL_GC ();
1064 break; 1198 break;
1065 1199
1066 case Bskip_chars_forward: 1200 case Bskip_chars_forward:
1067 v1 = POP; 1201 {
1068 TOP = Fskip_chars_forward (TOP, v1); 1202 Lisp_Object v1;
1069 break; 1203 v1 = POP;
1204 BEFORE_POTENTIAL_GC ();
1205 TOP = Fskip_chars_forward (TOP, v1);
1206 AFTER_POTENTIAL_GC ();
1207 break;
1208 }
1070 1209
1071 case Bskip_chars_backward: 1210 case Bskip_chars_backward:
1072 v1 = POP; 1211 {
1073 TOP = Fskip_chars_backward (TOP, v1); 1212 Lisp_Object v1;
1074 break; 1213 v1 = POP;
1214 BEFORE_POTENTIAL_GC ();
1215 TOP = Fskip_chars_backward (TOP, v1);
1216 AFTER_POTENTIAL_GC ();
1217 break;
1218 }
1075 1219
1076 case Bforward_line: 1220 case Bforward_line:
1221 BEFORE_POTENTIAL_GC ();
1077 TOP = Fforward_line (TOP); 1222 TOP = Fforward_line (TOP);
1223 AFTER_POTENTIAL_GC ();
1078 break; 1224 break;
1079 1225
1080 case Bchar_syntax: 1226 case Bchar_syntax:
1081 CHECK_NUMBER (TOP, 0); 1227 CHECK_NUMBER (TOP, 0);
1082 XSETFASTINT (TOP, 1228 XSETFASTINT (TOP, syntax_code_spec[(int) SYNTAX (XINT (TOP))]);
1083 syntax_code_spec[(int) SYNTAX (XINT (TOP))]);
1084 break; 1229 break;
1085 1230
1086 case Bbuffer_substring: 1231 case Bbuffer_substring:
1087 v1 = POP; 1232 {
1088 TOP = Fbuffer_substring (TOP, v1); 1233 Lisp_Object v1;
1089 break; 1234 v1 = POP;
1235 BEFORE_POTENTIAL_GC ();
1236 TOP = Fbuffer_substring (TOP, v1);
1237 AFTER_POTENTIAL_GC ();
1238 break;
1239 }
1090 1240
1091 case Bdelete_region: 1241 case Bdelete_region:
1092 v1 = POP; 1242 {
1093 TOP = Fdelete_region (TOP, v1); 1243 Lisp_Object v1;
1094 break; 1244 v1 = POP;
1245 BEFORE_POTENTIAL_GC ();
1246 TOP = Fdelete_region (TOP, v1);
1247 AFTER_POTENTIAL_GC ();
1248 break;
1249 }
1095 1250
1096 case Bnarrow_to_region: 1251 case Bnarrow_to_region:
1097 v1 = POP; 1252 {
1098 TOP = Fnarrow_to_region (TOP, v1); 1253 Lisp_Object v1;
1099 break; 1254 v1 = POP;
1255 BEFORE_POTENTIAL_GC ();
1256 TOP = Fnarrow_to_region (TOP, v1);
1257 AFTER_POTENTIAL_GC ();
1258 break;
1259 }
1100 1260
1101 case Bwiden: 1261 case Bwiden:
1262 BEFORE_POTENTIAL_GC ();
1102 PUSH (Fwiden ()); 1263 PUSH (Fwiden ());
1264 AFTER_POTENTIAL_GC ();
1103 break; 1265 break;
1104 1266
1105 case Bend_of_line: 1267 case Bend_of_line:
1268 BEFORE_POTENTIAL_GC ();
1106 TOP = Fend_of_line (TOP); 1269 TOP = Fend_of_line (TOP);
1270 AFTER_POTENTIAL_GC ();
1107 break; 1271 break;
1108 1272
1109 case Bset_marker: 1273 case Bset_marker:
1110 v1 = POP; 1274 {
1111 v2 = POP; 1275 Lisp_Object v1, v2;
1112 TOP = Fset_marker (TOP, v2, v1); 1276 v1 = POP;
1113 break; 1277 v2 = POP;
1278 TOP = Fset_marker (TOP, v2, v1);
1279 break;
1280 }
1114 1281
1115 case Bmatch_beginning: 1282 case Bmatch_beginning:
1116 TOP = Fmatch_beginning (TOP); 1283 TOP = Fmatch_beginning (TOP);
@@ -1129,76 +1296,130 @@ If the third argument is incorrect, Emacs may crash.")
1129 break; 1296 break;
1130 1297
1131 case Bstringeqlsign: 1298 case Bstringeqlsign:
1132 v1 = POP; 1299 {
1133 TOP = Fstring_equal (TOP, v1); 1300 Lisp_Object v1;
1134 break; 1301 v1 = POP;
1302 TOP = Fstring_equal (TOP, v1);
1303 break;
1304 }
1135 1305
1136 case Bstringlss: 1306 case Bstringlss:
1137 v1 = POP; 1307 {
1138 TOP = Fstring_lessp (TOP, v1); 1308 Lisp_Object v1;
1139 break; 1309 v1 = POP;
1310 TOP = Fstring_lessp (TOP, v1);
1311 break;
1312 }
1140 1313
1141 case Bequal: 1314 case Bequal:
1142 v1 = POP; 1315 {
1143 TOP = Fequal (TOP, v1); 1316 Lisp_Object v1;
1144 break; 1317 v1 = POP;
1318 TOP = Fequal (TOP, v1);
1319 break;
1320 }
1145 1321
1146 case Bnthcdr: 1322 case Bnthcdr:
1147 v1 = POP; 1323 {
1148 TOP = Fnthcdr (TOP, v1); 1324 Lisp_Object v1;
1149 break; 1325 v1 = POP;
1326 TOP = Fnthcdr (TOP, v1);
1327 break;
1328 }
1150 1329
1151 case Belt: 1330 case Belt:
1152 if (CONSP (TOP)) 1331 {
1153 { 1332 Lisp_Object v1, v2;
1154 /* Exchange args and then do nth. */ 1333 if (CONSP (TOP))
1155 v2 = POP; 1334 {
1156 v1 = TOP; 1335 /* Exchange args and then do nth. */
1157 goto nth_entry; 1336 v2 = POP;
1158 } 1337 v1 = TOP;
1159 v1 = POP; 1338 CHECK_NUMBER (v2, 0);
1160 TOP = Felt (TOP, v1); 1339 op = XINT (v2);
1161 break; 1340 immediate_quit = 1;
1341 while (--op >= 0)
1342 {
1343 if (CONSP (v1))
1344 v1 = XCDR (v1);
1345 else if (!NILP (v1))
1346 {
1347 immediate_quit = 0;
1348 v1 = wrong_type_argument (Qlistp, v1);
1349 immediate_quit = 1;
1350 op++;
1351 }
1352 }
1353 immediate_quit = 0;
1354 if (CONSP (v1)) TOP = XCAR (v1);
1355 else if (NILP (v1)) TOP = Qnil;
1356 else Fcar (wrong_type_argument (Qlistp, v1));
1357 }
1358 else
1359 {
1360 v1 = POP;
1361 TOP = Felt (TOP, v1);
1362 }
1363 break;
1364 }
1162 1365
1163 case Bmember: 1366 case Bmember:
1164 v1 = POP; 1367 {
1165 TOP = Fmember (TOP, v1); 1368 Lisp_Object v1;
1166 break; 1369 v1 = POP;
1370 TOP = Fmember (TOP, v1);
1371 break;
1372 }
1167 1373
1168 case Bassq: 1374 case Bassq:
1169 v1 = POP; 1375 {
1170 TOP = Fassq (TOP, v1); 1376 Lisp_Object v1;
1171 break; 1377 v1 = POP;
1378 TOP = Fassq (TOP, v1);
1379 break;
1380 }
1172 1381
1173 case Bnreverse: 1382 case Bnreverse:
1174 TOP = Fnreverse (TOP); 1383 TOP = Fnreverse (TOP);
1175 break; 1384 break;
1176 1385
1177 case Bsetcar: 1386 case Bsetcar:
1178 v1 = POP; 1387 {
1179 TOP = Fsetcar (TOP, v1); 1388 Lisp_Object v1;
1180 break; 1389 v1 = POP;
1390 TOP = Fsetcar (TOP, v1);
1391 break;
1392 }
1181 1393
1182 case Bsetcdr: 1394 case Bsetcdr:
1183 v1 = POP; 1395 {
1184 TOP = Fsetcdr (TOP, v1); 1396 Lisp_Object v1;
1185 break; 1397 v1 = POP;
1398 TOP = Fsetcdr (TOP, v1);
1399 break;
1400 }
1186 1401
1187 case Bcar_safe: 1402 case Bcar_safe:
1188 v1 = TOP; 1403 {
1189 if (CONSP (v1)) 1404 Lisp_Object v1;
1190 TOP = XCAR (v1); 1405 v1 = TOP;
1191 else 1406 if (CONSP (v1))
1192 TOP = Qnil; 1407 TOP = XCAR (v1);
1193 break; 1408 else
1409 TOP = Qnil;
1410 break;
1411 }
1194 1412
1195 case Bcdr_safe: 1413 case Bcdr_safe:
1196 v1 = TOP; 1414 {
1197 if (CONSP (v1)) 1415 Lisp_Object v1;
1198 TOP = XCDR (v1); 1416 v1 = TOP;
1199 else 1417 if (CONSP (v1))
1200 TOP = Qnil; 1418 TOP = XCDR (v1);
1201 break; 1419 else
1420 TOP = Qnil;
1421 break;
1422 }
1202 1423
1203 case Bnconc: 1424 case Bnconc:
1204 DISCARD (1); 1425 DISCARD (1);
@@ -1247,7 +1468,7 @@ If the third argument is incorrect, Emacs may crash.")
1247 abort (); 1468 abort ();
1248#endif 1469#endif
1249 1470
1250 return v1; 1471 return result;
1251} 1472}
1252 1473
1253void 1474void