Mercurial > hg > xemacs-beta

comparison src/bytecode.c @ 274:ca9a9ec9c1c1 r21-0b35

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b35
author cvs
date Mon, 13 Aug 2007 10:29:42 +0200
parents c5d627a313b1
children 7df0dd720c89
comparison
equal deleted inserted replaced
273:411aac7253ef 274:ca9a9ec9c1c1
244 244
245 #define FETCH2 (op = FETCH, op + (FETCH << 8)) 245 #define FETCH2 (op = FETCH, op + (FETCH << 8))
246 246
247 /* Push x onto the execution stack. */ 247 /* Push x onto the execution stack. */
248 248
249 /* This used to be #define PUSH(x) (*++stackp = (x)) 249 #define PUSH(x) (*++stackp = (x))
250 This oddity is necessary because Alliant can't be bothered to
251 compile the preincrement operator properly, as of 4/91. -JimB */
252 #define PUSH(x) (stackp++, *stackp = (x))
253 250
254 /* Pop a value off the execution stack. */ 251 /* Pop a value off the execution stack. */
255 252
256 #define POP (*stackp--) 253 #define POP (*stackp--)
257 254
595 592
596 case Bnth: 593 case Bnth:
597 v1 = POP; 594 v1 = POP;
598 v2 = TOP; 595 v2 = TOP;
599 /* nth_entry: */ 596 /* nth_entry: */
600 CHECK_INT (v2); 597 CHECK_NATNUM (v2);
601 op = XINT (v2); 598 for (op = XINT (v2); op; op--)
602 while (--op >= 0)
603 { 599 {
604 if (CONSP (v1)) 600 if (CONSP (v1))
605 v1 = XCDR (v1); 601 v1 = XCDR (v1);
606 else if (!NILP (v1)) 602 else if (NILP (v1))
603 {
604 TOP = Qnil;
605 goto Bnth_done;
606 }
607 else
607 { 608 {
608 v1 = wrong_type_argument (Qlistp, v1); 609 v1 = wrong_type_argument (Qlistp, v1);
609 op++; 610 op++;
610 } 611 }
611 QUIT;
612 } 612 }
613 goto docar; 613 goto docar;
614 Bnth_done:
615 break;
614 616
615 case Bsymbolp: 617 case Bsymbolp:
616 TOP = SYMBOLP (TOP) ? Qt : Qnil; 618 TOP = SYMBOLP (TOP) ? Qt : Qnil;
617 break; 619 break;
618 620
655 case Bcar: 657 case Bcar:
656 v1 = TOP; 658 v1 = TOP;
657 docar: 659 docar:
658 if (CONSP (v1)) TOP = XCAR (v1); 660 if (CONSP (v1)) TOP = XCAR (v1);
659 else if (NILP (v1)) TOP = Qnil; 661 else if (NILP (v1)) TOP = Qnil;
660 else Fcar (wrong_type_argument (Qlistp, v1)); 662 else
663 {
664 TOP = wrong_type_argument (Qlistp, v1);
665 goto docar;
666 }
661 break; 667 break;
662 668
663 case Bcdr: 669 case Bcdr:
664 v1 = TOP; 670 v1 = TOP;
671 docdr:
665 if (CONSP (v1)) TOP = XCDR (v1); 672 if (CONSP (v1)) TOP = XCDR (v1);
666 else if (NILP (v1)) TOP = Qnil; 673 else if (NILP (v1)) TOP = Qnil;
667 else Fcdr (wrong_type_argument (Qlistp, v1)); 674 else
675 {
676 TOP = wrong_type_argument (Qlistp, v1);
677 goto docdr;
678 }
668 break; 679 break;
669 680
670 case Bcons: 681 case Bcons:
671 v1 = POP; 682 v1 = POP;
672 TOP = Fcons (TOP, v1); 683 TOP = Fcons (TOP, v1);
1049 TOP = Fold_equal (TOP, v1); 1060 TOP = Fold_equal (TOP, v1);
1050 break; 1061 break;
1051 1062
1052 case Bnthcdr: 1063 case Bnthcdr:
1053 v1 = POP; 1064 v1 = POP;
1054 TOP = Fnthcdr (TOP, v1); 1065 v2 = TOP;
1066 CHECK_NATNUM (v2);
1067 for (op = XINT (v2); op; op--)
1068 {
1069 if (CONSP (v1))
1070 v1 = XCDR (v1);
1071 else if (NILP (v1))
1072 break;
1073 else
1074 {
1075 v1 = wrong_type_argument (Qlistp, v1);
1076 op++;
1077 }
1078 }
1079 TOP = v1;
1055 break; 1080 break;
1056 1081
1057 case Belt: 1082 case Belt:
1058 #if 0 1083 #if 0
1059 /* probably this code is OK, but nth_entry is commented 1084 /* probably this code is OK, but nth_entry is commented