Mercurial > emacs

comparison src/bytecode.c @ 26370:5f52cc1417ab

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Use block statements in cases and declare v1 and v2 locally there. Rearrange case statements so that thos most frequently executed come first. Avoid goto's in frequently executed cases.
author Gerd Moellmann <gerd@gnu.org>
date Sun, 07 Nov 1999 13:06:59 +0000
parents b3378aff433e
children 6706cd0ece4d
comparison
equal deleted inserted replaced
26369:897de8069452 26370:5f52cc1417ab
223 #define BinsertN 0261 223 #define BinsertN 0261
224 224
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
231 struct byte_stack 232 struct byte_stack
232 { 233 {
258 done. Signalling an error truncates the list analoguous to 259 done. Signalling an error truncates the list analoguous to
259 gcprolist. */ 260 gcprolist. */
260 261
261 struct byte_stack *byte_stack_list; 262 struct 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
265 void 267 void
266 mark_byte_stack () 268 mark_byte_stack ()
267 { 269 {
297 stack->byte_string_start = XSTRING (stack->byte_string)->data; 299 stack->byte_string_start = XSTRING (stack->byte_string)->data;
298 stack->pc = stack->byte_string_start + offset; 300 stack->pc = stack->byte_string_start + offset;
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
321 /* Pop a value off the execution stack. */ 321 /* Pop a value off the execution stack. */
322 322
329 /* Get the value which is at the top of the execution stack, but don't 329 /* Get the value which is at the top of the execution stack, but don't
330 pop it. */ 330 pop it. */
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
338 #define AFTER_POTENTIAL_GC() stack.top = NULL 338 #define AFTER_POTENTIAL_GC() stack.top = NULL
339 339
351 351
352 /* Check for jumping out of range. */ 352 /* Check for jumping out of range. */
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
366 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0, 366 DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
367 "Function used internally in byte-compiled code.\n\ 367 "Function used internally in byte-compiled code.\n\
368 The first argument, BYTESTR, is a string of byte code;\n\ 368 The first argument, BYTESTR, is a string of byte code;\n\
376 #ifdef BYTE_CODE_METER 376 #ifdef BYTE_CODE_METER
377 int this_op = 0; 377 int this_op = 0;
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;
386 Lisp_Object *stacke; 385 Lisp_Object *stacke;
387 #endif 386 #endif
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))
394 vector = wrong_type_argument (Qvectorp, vector); 394 vector = wrong_type_argument (Qvectorp, vector);
395 CHECK_NUMBER (maxdepth, 2); 395 CHECK_NUMBER (maxdepth, 2);
421 421
422 #ifdef BYTE_CODE_METER 422 #ifdef BYTE_CODE_METER
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 #else
427 op = FETCH;
428 #endif
429
426 switch (op) 430 switch (op)
427 #else
428 switch (op = FETCH)
429 #endif
430 { 431 {
432 case Bvarref + 7:
433 op = FETCH2;
434 goto varref;
435
436 case Bvarref:
437 case Bvarref + 1:
438 case Bvarref + 2:
439 case Bvarref + 3:
440 case Bvarref + 4:
441 case Bvarref + 5:
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. */
431 case Bvarref+6: 447 case Bvarref+6:
432 op = FETCH; 448 op = FETCH;
433 goto varref;
434
435 case Bvarref+7:
436 op = FETCH2;
437 goto varref;
438
439 case Bvarref: case Bvarref+1: case Bvarref+2: case Bvarref+3:
440 case Bvarref+4: case Bvarref+5:
441 op = op - Bvarref;
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];
447 { 454 if (SYMBOLP (v1))
448 v2 = XSYMBOL (v1)->value; 455 {
449 if (MISCP (v2) || EQ (v2, Qunbound)) 456 v2 = XSYMBOL (v1)->value;
450 v2 = Fsymbol_value (v1); 457 if (MISCP (v2) || EQ (v2, Qunbound))
451 } 458 v2 = Fsymbol_value (v1);
452 PUSH (v2); 459 }
453 break; 460 else
454 461 v2 = Fsymbol_value (v1);
455 case Bvarset+6: 462 PUSH (v2);
456 op = FETCH; 463 break;
457 goto varset; 464 }
458
459 case Bvarset+7:
460 op = FETCH2;
461 goto varset;
462
463 case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3:
464 case Bvarset+4: case Bvarset+5:
465 op -= Bvarset;
466 varset:
467 Fset (vectorp[op], POP);
468 break;
469
470 case Bvarbind+6:
471 op = FETCH;
472 goto varbind;
473
474 case Bvarbind+7:
475 op = FETCH2;
476 goto varbind;
477
478 case Bvarbind: case Bvarbind+1: case Bvarbind+2: case Bvarbind+3:
479 case Bvarbind+4: case Bvarbind+5:
480 op -= Bvarbind;
481 varbind:
482 specbind (vectorp[op], POP);
483 break;
484
485 case Bcall+6:
486 op = FETCH;
487 goto docall;
488
489 case Bcall+7:
490 op = FETCH2;
491 goto docall;
492
493 case Bcall: case Bcall+1: case Bcall+2: case Bcall+3:
494 case Bcall+4: case Bcall+5:
495 op -= Bcall;
496 docall:
497 DISCARD (op);
498 #ifdef BYTE_CODE_METER
499 if (byte_metering_on && SYMBOLP (TOP))
500 {
501 v1 = TOP;
502 v2 = Fget (v1, Qbyte_code_meter);
503 if (INTEGERP (v2)
504 && XINT (v2) != ((1<<VALBITS)-1))
505 {
506 XSETINT (v2, XINT (v2) + 1);
507 Fput (v1, Qbyte_code_meter, v2);
508 }
509 }
510 #endif
511 BEFORE_POTENTIAL_GC ();
512 TOP = Ffuncall (op + 1, &TOP);
513 AFTER_POTENTIAL_GC ();
514 break;
515
516 case Bunbind+6:
517 op = FETCH;
518 goto dounbind;
519
520 case Bunbind+7:
521 op = FETCH2;
522 goto dounbind;
523
524 case Bunbind: case Bunbind+1: case Bunbind+2: case Bunbind+3:
525 case Bunbind+4: case Bunbind+5:
526 op -= Bunbind;
527 dounbind:
528 BEFORE_POTENTIAL_GC ();
529 unbind_to (specpdl_ptr - specpdl - op, Qnil);
530 AFTER_POTENTIAL_GC ();
531 break;
532
533 case Bunbind_all:
534 /* To unbind back to the beginning of this frame. Not used yet,
535 but will be needed for tail-recursion elimination. */
536 BEFORE_POTENTIAL_GC ();
537 unbind_to (count, Qnil);
538 AFTER_POTENTIAL_GC ();
539 break;
540
541 case Bgoto:
542 MAYBE_GC ();
543 QUIT;
544 op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */
545 CHECK_RANGE (op);
546 stack.pc = stack.byte_string_start + op;
547 break;
548 465
549 case Bgotoifnil: 466 case Bgotoifnil:
550 MAYBE_GC (); 467 MAYBE_GC ();
551 op = FETCH2; 468 op = FETCH2;
552 if (NILP (POP)) 469 if (NILP (POP))
553 { 470 {
554 QUIT; 471 QUIT;
555 CHECK_RANGE (op); 472 CHECK_RANGE (op);
556 stack.pc = stack.byte_string_start + op; 473 stack.pc = stack.byte_string_start + op;
557 } 474 }
475 break;
476
477 case Bcar:
478 {
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 }
512
513 case Bvarset+7:
514 op = FETCH2;
515 goto varset;
516
517 case Bvarset: case Bvarset+1: case Bvarset+2: case Bvarset+3:
518 case Bvarset+4: case Bvarset+5:
519 op -= Bvarset;
520 goto varset;
521
522 case Bvarset+6:
523 op = FETCH;
524 varset:
525 set_internal (vectorp[op], POP, 0);
526 /* Fset (vectorp[op], POP); */
527 break;
528
529 case Bdup:
530 {
531 Lisp_Object v1;
532 v1 = TOP;
533 PUSH (v1);
534 break;
535 }
536
537 /* ------------------ */
538
539 case Bvarbind+6:
540 op = FETCH;
541 goto varbind;
542
543 case Bvarbind+7:
544 op = FETCH2;
545 goto varbind;
546
547 case Bvarbind: case Bvarbind+1: case Bvarbind+2: case Bvarbind+3:
548 case Bvarbind+4: case Bvarbind+5:
549 op -= Bvarbind;
550 varbind:
551 specbind (vectorp[op], POP);
552 break;
553
554 case Bcall+6:
555 op = FETCH;
556 goto docall;
557
558 case Bcall+7:
559 op = FETCH2;
560 goto docall;
561
562 case Bcall: case Bcall+1: case Bcall+2: case Bcall+3:
563 case Bcall+4: case Bcall+5:
564 op -= Bcall;
565 docall:
566 {
567 DISCARD (op);
568 #ifdef BYTE_CODE_METER
569 if (byte_metering_on && SYMBOLP (TOP))
570 {
571 Lisp_Object v1, v2;
572
573 v1 = TOP;
574 v2 = Fget (v1, Qbyte_code_meter);
575 if (INTEGERP (v2)
576 && XINT (v2) != ((1<<VALBITS)-1))
577 {
578 XSETINT (v2, XINT (v2) + 1);
579 Fput (v1, Qbyte_code_meter, v2);
580 }
581 }
582 #endif
583 BEFORE_POTENTIAL_GC ();
584 TOP = Ffuncall (op + 1, &TOP);
585 AFTER_POTENTIAL_GC ();
586 break;
587 }
588
589 case Bunbind+6:
590 op = FETCH;
591 goto dounbind;
592
593 case Bunbind+7:
594 op = FETCH2;
595 goto dounbind;
596
597 case Bunbind: case Bunbind+1: case Bunbind+2: case Bunbind+3:
598 case Bunbind+4: case Bunbind+5:
599 op -= Bunbind;
600 dounbind:
601 BEFORE_POTENTIAL_GC ();
602 unbind_to (specpdl_ptr - specpdl - op, Qnil);
603 AFTER_POTENTIAL_GC ();
604 break;
605
606 case Bunbind_all:
607 /* To unbind back to the beginning of this frame. Not used yet,
608 but will be needed for tail-recursion elimination. */
609 BEFORE_POTENTIAL_GC ();
610 unbind_to (count, Qnil);
611 AFTER_POTENTIAL_GC ();
612 break;
613
614 case Bgoto:
615 MAYBE_GC ();
616 QUIT;
617 op = FETCH2; /* pc = FETCH2 loses since FETCH2 contains pc++ */
618 CHECK_RANGE (op);
619 stack.pc = stack.byte_string_start + op;
558 break; 620 break;
559 621
560 case Bgotoifnonnil: 622 case Bgotoifnonnil:
561 MAYBE_GC (); 623 MAYBE_GC ();
562 op = FETCH2; 624 op = FETCH2;
639 } 701 }
640 else DISCARD (1); 702 else DISCARD (1);
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;
650
651 case Bdup:
652 v1 = TOP;
653 PUSH (v1);
654 break; 711 break;
655 712
656 case Bconstant2: 713 case Bconstant2:
657 PUSH (vectorp[FETCH2]); 714 PUSH (vectorp[FETCH2]);
658 break; 715 break;
665 case Bsave_current_buffer_1: 722 case Bsave_current_buffer_1:
666 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); 723 record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ());
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:
674 record_unwind_protect (save_restriction_restore, save_restriction_save ()); 733 record_unwind_protect (save_restriction_restore, save_restriction_save ());
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);
686 (specpdl_ptr - 1)->symbol = Qnil; 749 (specpdl_ptr - 1)->symbol = Qnil;
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;
755 v1 = POP;
756 v1 = Fcons (POP, v1);
757 BEFORE_POTENTIAL_GC ();
758 TOP = Fcondition_case (Fcons (TOP, v1));
759 AFTER_POTENTIAL_GC ();
760 break;
761 }
762
763 case Btemp_output_buffer_setup:
692 BEFORE_POTENTIAL_GC (); 764 BEFORE_POTENTIAL_GC ();
693 TOP = Fcondition_case (Fcons (TOP, v1)); 765 temp_output_buffer_setup (XSTRING (TOP)->data);
694 AFTER_POTENTIAL_GC (); 766 AFTER_POTENTIAL_GC ();
695 break;
696
697 case Btemp_output_buffer_setup:
698 temp_output_buffer_setup (XSTRING (TOP)->data);
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;
736 break; 812 break;
737 813
745 821
746 case Blistp: 822 case Blistp:
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);
795 TOP = Flist (3, &TOP); 852 TOP = Flist (3, &TOP);
796 break; 853 break;
809 case Blength: 866 case Blength:
810 TOP = Flength (TOP); 867 TOP = Flength (TOP);
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);
825 break; 888 break;
826 889
827 case Bsymbol_function: 890 case Bsymbol_function:
828 TOP = Fsymbol_function (TOP); 891 TOP = Fsymbol_function (TOP);
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);
853 TOP = Fconcat (2, &TOP); 928 TOP = Fconcat (2, &TOP);
854 break; 929 break;
868 DISCARD (op - 1); 943 DISCARD (op - 1);
869 TOP = Fconcat (op, &TOP); 944 TOP = Fconcat (op, &TOP);
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);
934 TOP = Fminus (2, &TOP); 1030 TOP = Fminus (2, &TOP);
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);
950 TOP = Fplus (2, &TOP); 1049 TOP = Fplus (2, &TOP);
951 break; 1050 break;
969 DISCARD (1); 1068 DISCARD (1);
970 TOP = Fquo (2, &TOP); 1069 TOP = Fquo (2, &TOP);
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:
1031 PUSH (Feolp ()); 1159 PUSH (Feolp ());
1032 break; 1160 break;
1046 case Bcurrent_buffer: 1174 case Bcurrent_buffer:
1047 PUSH (Fcurrent_buffer ()); 1175 PUSH (Fcurrent_buffer ());
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:
1055 PUSH (Finteractive_p ()); 1185 PUSH (Finteractive_p ());
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);
1117 break; 1284 break;
1118 1285
1127 case Bdowncase: 1294 case Bdowncase:
1128 TOP = Fdowncase (TOP); 1295 TOP = Fdowncase (TOP);
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);
1205 TOP = Fnconc (2, &TOP); 1426 TOP = Fnconc (2, &TOP);
1206 break; 1427 break;
1245 error ("binding stack not balanced (serious byte compiler bug)"); 1466 error ("binding stack not balanced (serious byte compiler bug)");
1246 #else 1467 #else
1247 abort (); 1468 abort ();
1248 #endif 1469 #endif
1249 1470
1250 return v1; 1471 return result;
1251 } 1472 }
1252 1473
1253 void 1474 void
1254 syms_of_bytecode () 1475 syms_of_bytecode ()
1255 { 1476 {