Mercurial > hg > xemacs-beta

comparison src/bytecode.c @ 5118:e0db3c197671 ben-lisp-object

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge up to latest default branch, doesn't compile yet
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 21:18:49 -0600
parents 3742ea8250b5 1d61580e0cf7
children 623d57b7fbe8
comparison
equal deleted inserted replaced
5117:3742ea8250b5 5118:e0db3c197671
55 #include "buffer.h" 55 #include "buffer.h"
56 #include "bytecode.h" 56 #include "bytecode.h"
57 #include "opaque.h" 57 #include "opaque.h"
58 #include "syntax.h" 58 #include "syntax.h"
59 #include "window.h" 59 #include "window.h"
60
61 #ifdef NEW_GC
62 static Lisp_Object
63 make_compiled_function_args (int totalargs)
64 {
65 Lisp_Compiled_Function_Args *args;
66 args = XCOMPILED_FUNCTION_ARGS
67 (alloc_sized_lrecord
68 (FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args,
69 Lisp_Object, args, totalargs),
70 &lrecord_compiled_function_args));
71 args->size = totalargs;
72 return wrap_compiled_function_args (args);
73 }
74
75 static Bytecount
76 size_compiled_function_args (const void *lheader)
77 {
78 return FLEXIBLE_ARRAY_STRUCT_SIZEOF (Lisp_Compiled_Function_Args,
79 Lisp_Object, args,
80 ((Lisp_Compiled_Function_Args *)
81 lheader)->size);
82 }
83
84 static const struct memory_description compiled_function_args_description[] = {
85 { XD_LONG, offsetof (Lisp_Compiled_Function_Args, size) },
86 { XD_LISP_OBJECT_ARRAY, offsetof (Lisp_Compiled_Function_Args, args),
87 XD_INDIRECT(0, 0) },
88 { XD_END }
89 };
90
91 DEFINE_DUMPABLE_SIZABLE_INTERNAL_LISP_OBJECT ("compiled-function-args",
92 compiled_function_args,
93 0,
94 compiled_function_args_description,
95 size_compiled_function_args,
96 Lisp_Compiled_Function_Args);
97 #endif /* NEW_GC */
60 98
61 EXFUN (Ffetch_bytecode, 1); 99 EXFUN (Ffetch_bytecode, 1);
62 100
63 Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code; 101 Lisp_Object Qbyte_code, Qcompiled_functionp, Qinvalid_byte_code;
64 102
202 BRgotoifnonnilelsepop = 0256, 240 BRgotoifnonnilelsepop = 0256,
203 241
204 BlistN = 0257, 242 BlistN = 0257,
205 BconcatN = 0260, 243 BconcatN = 0260,
206 BinsertN = 0261, 244 BinsertN = 0261,
245
246 Bbind_multiple_value_limits = 0262, /* New in 21.5. */
247 Bmultiple_value_list_internal = 0263, /* New in 21.5. */
248 Bmultiple_value_call = 0264, /* New in 21.5. */
249 Bthrow = 0265, /* New in 21.5. */
250
207 Bmember = 0266, /* new in v20 */ 251 Bmember = 0266, /* new in v20 */
208 Bassq = 0267, /* new in v20 */ 252 Bassq = 0267, /* new in v20 */
209 253
210 Bconstant = 0300 254 Bconstant = 0300
211 }; 255 };
254 if (BIGNUMP (obj)) BIGNUM_ARITH_RETURN (obj, neg); 298 if (BIGNUMP (obj)) BIGNUM_ARITH_RETURN (obj, neg);
255 #endif 299 #endif
256 #ifdef HAVE_RATIO 300 #ifdef HAVE_RATIO
257 if (RATIOP (obj)) RATIO_ARITH_RETURN (obj, neg); 301 if (RATIOP (obj)) RATIO_ARITH_RETURN (obj, neg);
258 #endif 302 #endif
259 #ifdef HAVE_BIG_FLOAT 303 #ifdef HAVE_BIGFLOAT
260 if (BIGFLOAT_P (obj)) BIGFLOAT_ARITH_RETURN (obj, neg); 304 if (BIGFLOATP (obj)) BIGFLOAT_ARITH_RETURN (obj, neg);
261 #endif 305 #endif
262 306
263 obj = wrong_type_argument (Qnumber_char_or_marker_p, obj); 307 obj = wrong_type_argument (Qnumber_char_or_marker_p, obj);
264 goto retry; 308 goto retry;
265 } 309 }
385 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); 429 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
386 #else 430 #else
387 ival1 *= ival2; break; 431 ival1 *= ival2; break;
388 #endif 432 #endif
389 case Bquo: 433 case Bquo:
390 if (ival2 == 0) Fsignal (Qarith_error, Qnil); 434 if (ival2 == 0)
435 signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
391 ival1 /= ival2; 436 ival1 /= ival2;
392 break; 437 break;
393 case Bmax: if (ival1 < ival2) ival1 = ival2; break; 438 case Bmax: if (ival1 < ival2) ival1 = ival2; break;
394 case Bmin: if (ival1 > ival2) ival1 = ival2; break; 439 case Bmin: if (ival1 > ival2) ival1 = ival2; break;
395 } 440 }
411 bignum_mul (scratch_bignum, XBIGNUM_DATA (obj1), 456 bignum_mul (scratch_bignum, XBIGNUM_DATA (obj1),
412 XBIGNUM_DATA (obj2)); 457 XBIGNUM_DATA (obj2));
413 break; 458 break;
414 case Bquo: 459 case Bquo:
415 if (bignum_sign (XBIGNUM_DATA (obj2)) == 0) 460 if (bignum_sign (XBIGNUM_DATA (obj2)) == 0)
416 Fsignal (Qarith_error, Qnil); 461 signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
417 bignum_div (scratch_bignum, XBIGNUM_DATA (obj1), 462 bignum_div (scratch_bignum, XBIGNUM_DATA (obj1),
418 XBIGNUM_DATA (obj2)); 463 XBIGNUM_DATA (obj2));
419 break; 464 break;
420 case Bmax: 465 case Bmax:
421 return bignum_gt (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2)) 466 return bignum_gt (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2))
439 case Bmult: 484 case Bmult:
440 ratio_mul (scratch_ratio, XRATIO_DATA (obj1), XRATIO_DATA (obj2)); 485 ratio_mul (scratch_ratio, XRATIO_DATA (obj1), XRATIO_DATA (obj2));
441 break; 486 break;
442 case Bquo: 487 case Bquo:
443 if (ratio_sign (XRATIO_DATA (obj2)) == 0) 488 if (ratio_sign (XRATIO_DATA (obj2)) == 0)
444 Fsignal (Qarith_error, Qnil); 489 signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
445 ratio_div (scratch_ratio, XRATIO_DATA (obj1), XRATIO_DATA (obj2)); 490 ratio_div (scratch_ratio, XRATIO_DATA (obj1), XRATIO_DATA (obj2));
446 break; 491 break;
447 case Bmax: 492 case Bmax:
448 return ratio_gt (XRATIO_DATA (obj1), XRATIO_DATA (obj2)) 493 return ratio_gt (XRATIO_DATA (obj1), XRATIO_DATA (obj2))
449 ? obj1 : obj2; 494 ? obj1 : obj2;
471 bigfloat_mul (scratch_bigfloat, XBIGFLOAT_DATA (obj1), 516 bigfloat_mul (scratch_bigfloat, XBIGFLOAT_DATA (obj1),
472 XBIGFLOAT_DATA (obj2)); 517 XBIGFLOAT_DATA (obj2));
473 break; 518 break;
474 case Bquo: 519 case Bquo:
475 if (bigfloat_sign (XBIGFLOAT_DATA (obj2)) == 0) 520 if (bigfloat_sign (XBIGFLOAT_DATA (obj2)) == 0)
476 Fsignal (Qarith_error, Qnil); 521 signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
477 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (obj1), 522 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (obj1),
478 XBIGFLOAT_DATA (obj2)); 523 XBIGFLOAT_DATA (obj2));
479 break; 524 break;
480 case Bmax: 525 case Bmax:
481 return bigfloat_gt (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2)) 526 return bigfloat_gt (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2))
493 { 538 {
494 case Bplus: dval1 += dval2; break; 539 case Bplus: dval1 += dval2; break;
495 case Bdiff: dval1 -= dval2; break; 540 case Bdiff: dval1 -= dval2; break;
496 case Bmult: dval1 *= dval2; break; 541 case Bmult: dval1 *= dval2; break;
497 case Bquo: 542 case Bquo:
498 if (dval2 == 0.0) Fsignal (Qarith_error, Qnil); 543 if (dval2 == 0.0)
544 signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
499 dval1 /= dval2; 545 dval1 /= dval2;
500 break; 546 break;
501 case Bmax: if (dval1 < dval2) dval1 = dval2; break; 547 case Bmax: if (dval1 < dval2) dval1 = dval2; break;
502 case Bmin: if (dval1 > dval2) dval1 = dval2; break; 548 case Bmin: if (dval1 > dval2) dval1 = dval2; break;
503 } 549 }
538 { 584 {
539 case Bplus: ival1 += ival2; break; 585 case Bplus: ival1 += ival2; break;
540 case Bdiff: ival1 -= ival2; break; 586 case Bdiff: ival1 -= ival2; break;
541 case Bmult: ival1 *= ival2; break; 587 case Bmult: ival1 *= ival2; break;
542 case Bquo: 588 case Bquo:
543 if (ival2 == 0) Fsignal (Qarith_error, Qnil); 589 if (ival2 == 0)
590 signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
544 ival1 /= ival2; 591 ival1 /= ival2;
545 break; 592 break;
546 case Bmax: if (ival1 < ival2) ival1 = ival2; break; 593 case Bmax: if (ival1 < ival2) ival1 = ival2; break;
547 case Bmin: if (ival1 > ival2) ival1 = ival2; break; 594 case Bmin: if (ival1 > ival2) ival1 = ival2; break;
548 } 595 }
556 { 603 {
557 case Bplus: dval1 += dval2; break; 604 case Bplus: dval1 += dval2; break;
558 case Bdiff: dval1 -= dval2; break; 605 case Bdiff: dval1 -= dval2; break;
559 case Bmult: dval1 *= dval2; break; 606 case Bmult: dval1 *= dval2; break;
560 case Bquo: 607 case Bquo:
561 if (dval2 == 0) Fsignal (Qarith_error, Qnil); 608 if (dval2 == 0)
609 signal_error_2 (Qarith_error, "division by zero", obj1, obj2);
562 dval1 /= dval2; 610 dval1 /= dval2;
563 break; 611 break;
564 case Bmax: if (dval1 < dval2) dval1 = dval2; break; 612 case Bmax: if (dval1 < dval2) dval1 = dval2; break;
565 case Bmin: if (dval1 > dval2) dval1 = dval2; break; 613 case Bmin: if (dval1 > dval2) dval1 = dval2; break;
566 } 614 }
612 #define JUMPR_NEXT ((void) (program_ptr += 1)) 660 #define JUMPR_NEXT ((void) (program_ptr += 1))
613 661
614 /* Push x onto the execution stack. */ 662 /* Push x onto the execution stack. */
615 #define PUSH(x) (*++stack_ptr = (x)) 663 #define PUSH(x) (*++stack_ptr = (x))
616 664
617 /* Pop a value off the execution stack. */ 665 /* Pop a value, which may be multiple, off the execution stack. */
618 #define POP (*stack_ptr--) 666 #define POP_WITH_MULTIPLE_VALUES (*stack_ptr--)
667
668 /* Pop a value off the execution stack, treating multiple values as single. */
669 #define POP (IGNORE_MULTIPLE_VALUES (POP_WITH_MULTIPLE_VALUES))
670
671 #define DISCARD_PRESERVING_MULTIPLE_VALUES(n) (stack_ptr -= (n))
619 672
620 /* Discard n values from the execution stack. */ 673 /* Discard n values from the execution stack. */
621 #define DISCARD(n) (stack_ptr -= (n)) 674 #define DISCARD(n) do { \
675 if (1 != multiple_value_current_limit) \
676 { \
677 int i, en = n; \
678 for (i = 0; i < en; i++) \
679 { \
680 *stack_ptr = ignore_multiple_values (*stack_ptr); \
681 stack_ptr--; \
682 } \
683 } \
684 else \
685 { \
686 stack_ptr -= (n); \
687 } \
688 } while (0)
689
690 /* Get the value, which may be multiple, at the top of the execution stack;
691 and leave it there. */
692 #define TOP_WITH_MULTIPLE_VALUES (*stack_ptr)
693
694 #define TOP_ADDRESS (stack_ptr)
622 695
623 /* Get the value which is at the top of the execution stack, 696 /* Get the value which is at the top of the execution stack,
624 but don't pop it. */ 697 but don't pop it. */
625 #define TOP (*stack_ptr) 698 #define TOP (IGNORE_MULTIPLE_VALUES (TOP_WITH_MULTIPLE_VALUES))
699
700 #define TOP_LVALUE (*stack_ptr)
701
702
626 703
627 /* See comment before the big switch in execute_optimized_program(). */ 704 /* See comment before the big switch in execute_optimized_program(). */
628 #define GCPRO_STACK (gcpro1.nvars = stack_ptr - stack_beg) 705 #define GCPRO_STACK (gcpro1.nvars = stack_ptr - stack_beg)
629 706
630 /* The actual interpreter for byte code. 707 /* The actual interpreter for byte code.
818 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil); 895 Lisp_Object val = Fget (TOP, Qbyte_code_meter, Qnil);
819 if (INTP (val)) 896 if (INTP (val))
820 Fput (TOP, Qbyte_code_meter, make_int (XINT (val) + 1)); 897 Fput (TOP, Qbyte_code_meter, make_int (XINT (val) + 1));
821 } 898 }
822 #endif 899 #endif
823 TOP = Ffuncall (n + 1, &TOP); 900 TOP_LVALUE = TOP; /* Ignore multiple values. */
901 TOP_LVALUE = Ffuncall (n + 1, TOP_ADDRESS);
824 break; 902 break;
825 903
826 case Bunbind: 904 case Bunbind:
827 case Bunbind+1: 905 case Bunbind+1:
828 case Bunbind+2: 906 case Bunbind+2:
854 else 932 else
855 JUMP_NEXT; 933 JUMP_NEXT;
856 break; 934 break;
857 935
858 case Bgotoifnilelsepop: 936 case Bgotoifnilelsepop:
859 if (NILP (TOP)) 937 /* Discard any multiple value: */
938 if (NILP (TOP_LVALUE = TOP))
860 JUMP; 939 JUMP;
861 else 940 else
862 { 941 {
863 DISCARD (1); 942 DISCARD (1);
864 JUMP_NEXT; 943 JUMP_NEXT;
865 } 944 }
866 break; 945 break;
867 946
868 case Bgotoifnonnilelsepop: 947 case Bgotoifnonnilelsepop:
869 if (!NILP (TOP)) 948 /* Discard any multiple value: */
949 if (!NILP (TOP_LVALUE = TOP))
870 JUMP; 950 JUMP;
871 else 951 else
872 { 952 {
873 DISCARD (1); 953 DISCARD (1);
874 JUMP_NEXT; 954 JUMP_NEXT;
893 else 973 else
894 JUMPR_NEXT; 974 JUMPR_NEXT;
895 break; 975 break;
896 976
897 case BRgotoifnilelsepop: 977 case BRgotoifnilelsepop:
898 if (NILP (TOP)) 978 if (NILP (TOP_LVALUE = TOP))
899 JUMPR; 979 JUMPR;
900 else 980 else
901 { 981 {
902 DISCARD (1); 982 DISCARD (1);
903 JUMPR_NEXT; 983 JUMPR_NEXT;
904 } 984 }
905 break; 985 break;
906 986
907 case BRgotoifnonnilelsepop: 987 case BRgotoifnonnilelsepop:
908 if (!NILP (TOP)) 988 if (!NILP (TOP_LVALUE = TOP))
909 JUMPR; 989 JUMPR;
910 else 990 else
911 { 991 {
912 DISCARD (1); 992 DISCARD (1);
913 JUMPR_NEXT; 993 JUMPR_NEXT;
919 #ifdef ERROR_CHECK_BYTE_CODE 999 #ifdef ERROR_CHECK_BYTE_CODE
920 /* Binds and unbinds are supposed to be compiled balanced. */ 1000 /* Binds and unbinds are supposed to be compiled balanced. */
921 if (specpdl_depth() != speccount) 1001 if (specpdl_depth() != speccount)
922 invalid_byte_code ("unbalanced specbinding stack", Qunbound); 1002 invalid_byte_code ("unbalanced specbinding stack", Qunbound);
923 #endif 1003 #endif
924 return TOP; 1004 return TOP_WITH_MULTIPLE_VALUES;
925 1005
926 case Bdiscard: 1006 case Bdiscard:
927 DISCARD (1); 1007 DISCARD (1);
928 break; 1008 break;
929 1009
930 case Bdup: 1010 case Bdup:
931 { 1011 {
932 Lisp_Object arg = TOP; 1012 Lisp_Object arg = TOP_WITH_MULTIPLE_VALUES;
933 PUSH (arg); 1013 PUSH (arg);
934 break; 1014 break;
935 } 1015 }
936 1016
937 case Bconstant2: 1017 case Bconstant2:
938 PUSH (constants_data[READ_UINT_2]); 1018 PUSH (constants_data[READ_UINT_2]);
939 break; 1019 break;
940 1020
941 case Bcar: 1021 case Bcar:
942 /* Fcar can GC via wrong_type_argument. */ 1022 {
943 /* GCPRO_STACK; */ 1023 /* Fcar can GC via wrong_type_argument. */
944 TOP = CONSP (TOP) ? XCAR (TOP) : Fcar (TOP); 1024 /* GCPRO_STACK; */
945 break; 1025 Lisp_Object arg = TOP;
1026 TOP_LVALUE = CONSP (arg) ? XCAR (arg) : Fcar (arg);
1027 break;
1028 }
946 1029
947 case Bcdr: 1030 case Bcdr:
948 /* Fcdr can GC via wrong_type_argument. */ 1031 {
949 /* GCPRO_STACK; */ 1032 /* Fcdr can GC via wrong_type_argument. */
950 TOP = CONSP (TOP) ? XCDR (TOP) : Fcdr (TOP); 1033 /* GCPRO_STACK; */
951 break; 1034 Lisp_Object arg = TOP;
952 1035 TOP_LVALUE = CONSP (arg) ? XCDR (arg) : Fcdr (arg);
1036 break;
1037 }
953 1038
954 case Bunbind_all: 1039 case Bunbind_all:
955 /* To unbind back to the beginning of this frame. Not used yet, 1040 /* To unbind back to the beginning of this frame. Not used yet,
956 but will be needed for tail-recursion elimination. */ 1041 but will be needed for tail-recursion elimination. */
957 unbind_to (speccount); 1042 unbind_to (speccount);
960 case Bnth: 1045 case Bnth:
961 { 1046 {
962 Lisp_Object arg = POP; 1047 Lisp_Object arg = POP;
963 /* Fcar and Fnthcdr can GC via wrong_type_argument. */ 1048 /* Fcar and Fnthcdr can GC via wrong_type_argument. */
964 /* GCPRO_STACK; */ 1049 /* GCPRO_STACK; */
965 TOP = Fcar (Fnthcdr (TOP, arg)); 1050 TOP_LVALUE = Fcar (Fnthcdr (TOP, arg));
966 break; 1051 break;
967 } 1052 }
968 1053
969 case Bsymbolp: 1054 case Bsymbolp:
970 TOP = SYMBOLP (TOP) ? Qt : Qnil; 1055 TOP_LVALUE = SYMBOLP (TOP) ? Qt : Qnil;
971 break; 1056 break;
972 1057
973 case Bconsp: 1058 case Bconsp:
974 TOP = CONSP (TOP) ? Qt : Qnil; 1059 TOP_LVALUE = CONSP (TOP) ? Qt : Qnil;
975 break; 1060 break;
976 1061
977 case Bstringp: 1062 case Bstringp:
978 TOP = STRINGP (TOP) ? Qt : Qnil; 1063 TOP_LVALUE = STRINGP (TOP) ? Qt : Qnil;
979 break; 1064 break;
980 1065
981 case Blistp: 1066 case Blistp:
982 TOP = LISTP (TOP) ? Qt : Qnil; 1067 TOP_LVALUE = LISTP (TOP) ? Qt : Qnil;
983 break; 1068 break;
984 1069
985 case Bnumberp: 1070 case Bnumberp:
986 #ifdef WITH_NUMBER_TYPES 1071 #ifdef WITH_NUMBER_TYPES
987 TOP = NUMBERP (TOP) ? Qt : Qnil; 1072 TOP_LVALUE = NUMBERP (TOP) ? Qt : Qnil;
988 #else 1073 #else
989 TOP = INT_OR_FLOATP (TOP) ? Qt : Qnil; 1074 TOP_LVALUE = INT_OR_FLOATP (TOP) ? Qt : Qnil;
990 #endif 1075 #endif
991 break; 1076 break;
992 1077
993 case Bintegerp: 1078 case Bintegerp:
994 #ifdef HAVE_BIGNUM 1079 #ifdef HAVE_BIGNUM
995 TOP = INTEGERP (TOP) ? Qt : Qnil; 1080 TOP_LVALUE = INTEGERP (TOP) ? Qt : Qnil;
996 #else 1081 #else
997 TOP = INTP (TOP) ? Qt : Qnil; 1082 TOP_LVALUE = INTP (TOP) ? Qt : Qnil;
998 #endif 1083 #endif
999 break; 1084 break;
1000 1085
1001 case Beq: 1086 case Beq:
1002 { 1087 {
1003 Lisp_Object arg = POP; 1088 Lisp_Object arg = POP;
1004 TOP = EQ_WITH_EBOLA_NOTICE (TOP, arg) ? Qt : Qnil; 1089 TOP_LVALUE = EQ_WITH_EBOLA_NOTICE (TOP, arg) ? Qt : Qnil;
1005 break; 1090 break;
1006 } 1091 }
1007 1092
1008 case Bnot: 1093 case Bnot:
1009 TOP = NILP (TOP) ? Qt : Qnil; 1094 TOP_LVALUE = NILP (TOP) ? Qt : Qnil;
1010 break; 1095 break;
1011 1096
1012 case Bcons: 1097 case Bcons:
1013 { 1098 {
1014 Lisp_Object arg = POP; 1099 Lisp_Object arg = POP;
1015 TOP = Fcons (TOP, arg); 1100 TOP_LVALUE = Fcons (TOP, arg);
1016 break; 1101 break;
1017 } 1102 }
1018 1103
1019 case Blist1: 1104 case Blist1:
1020 TOP = Fcons (TOP, Qnil); 1105 TOP_LVALUE = Fcons (TOP, Qnil);
1021 break; 1106 break;
1022 1107
1023 1108
1024 case BlistN: 1109 case BlistN:
1025 n = READ_UINT_1; 1110 n = READ_UINT_1;
1038 if (--n) 1123 if (--n)
1039 { 1124 {
1040 DISCARD (1); 1125 DISCARD (1);
1041 goto list_loop; 1126 goto list_loop;
1042 } 1127 }
1043 TOP = list; 1128 TOP_LVALUE = list;
1044 break; 1129 break;
1045 } 1130 }
1046 1131
1047 1132
1048 case Bconcat2: 1133 case Bconcat2:
1056 n = READ_UINT_1; 1141 n = READ_UINT_1;
1057 do_concat: 1142 do_concat:
1058 DISCARD (n - 1); 1143 DISCARD (n - 1);
1059 /* Apparently `concat' can GC; Fconcat GCPROs its arguments. */ 1144 /* Apparently `concat' can GC; Fconcat GCPROs its arguments. */
1060 /* GCPRO_STACK; */ 1145 /* GCPRO_STACK; */
1061 TOP = Fconcat (n, &TOP); 1146 TOP_LVALUE = TOP; /* Ignore multiple values. */
1147 TOP_LVALUE = Fconcat (n, TOP_ADDRESS);
1062 break; 1148 break;
1063 1149
1064 1150
1065 case Blength: 1151 case Blength:
1066 TOP = Flength (TOP); 1152 TOP_LVALUE = Flength (TOP);
1067 break; 1153 break;
1068 1154
1069 case Baset: 1155 case Baset:
1070 { 1156 {
1071 Lisp_Object arg2 = POP; 1157 Lisp_Object arg2 = POP;
1072 Lisp_Object arg1 = POP; 1158 Lisp_Object arg1 = POP;
1073 TOP = Faset (TOP, arg1, arg2); 1159 TOP_LVALUE = Faset (TOP, arg1, arg2);
1074 break; 1160 break;
1075 } 1161 }
1076 1162
1077 case Bsymbol_value: 1163 case Bsymbol_value:
1078 /* Why does this need GCPRO_STACK? If not, remove others, too. */ 1164 /* Why does this need GCPRO_STACK? If not, remove others, too. */
1079 /* GCPRO_STACK; */ 1165 /* GCPRO_STACK; */
1080 TOP = Fsymbol_value (TOP); 1166 TOP_LVALUE = Fsymbol_value (TOP);
1081 break; 1167 break;
1082 1168
1083 case Bsymbol_function: 1169 case Bsymbol_function:
1084 TOP = Fsymbol_function (TOP); 1170 TOP_LVALUE = Fsymbol_function (TOP);
1085 break; 1171 break;
1086 1172
1087 case Bget: 1173 case Bget:
1088 { 1174 {
1089 Lisp_Object arg = POP; 1175 Lisp_Object arg = POP;
1090 TOP = Fget (TOP, arg, Qnil); 1176 TOP_LVALUE = Fget (TOP, arg, Qnil);
1091 break; 1177 break;
1092 } 1178 }
1093 1179
1094 case Bsub1: 1180 case Bsub1:
1181 {
1095 #ifdef HAVE_BIGNUM 1182 #ifdef HAVE_BIGNUM
1096 TOP = Fsub1 (TOP); 1183 TOP_LVALUE = Fsub1 (TOP);
1097 #else 1184 #else
1098 TOP = INTP (TOP) ? INT_MINUS1 (TOP) : Fsub1 (TOP); 1185 Lisp_Object arg = TOP;
1099 #endif 1186 TOP_LVALUE = INTP (arg) ? INT_MINUS1 (arg) : Fsub1 (arg);
1100 break; 1187 #endif
1101 1188 break;
1189 }
1102 case Badd1: 1190 case Badd1:
1191 {
1103 #ifdef HAVE_BIGNUM 1192 #ifdef HAVE_BIGNUM
1104 TOP = Fadd1 (TOP); 1193 TOP_LVALUE = Fadd1 (TOP);
1105 #else 1194 #else
1106 TOP = INTP (TOP) ? INT_PLUS1 (TOP) : Fadd1 (TOP); 1195 Lisp_Object arg = TOP;
1107 #endif 1196 TOP_LVALUE = INTP (arg) ? INT_PLUS1 (arg) : Fadd1 (arg);
1108 break; 1197 #endif
1109 1198 break;
1199 }
1110 1200
1111 case Beqlsign: 1201 case Beqlsign:
1112 { 1202 {
1113 Lisp_Object arg = POP; 1203 Lisp_Object arg = POP;
1114 TOP = bytecode_arithcompare (TOP, arg) == 0 ? Qt : Qnil; 1204 TOP_LVALUE = bytecode_arithcompare (TOP, arg) == 0 ? Qt : Qnil;
1115 break; 1205 break;
1116 } 1206 }
1117 1207
1118 case Bgtr: 1208 case Bgtr:
1119 { 1209 {
1120 Lisp_Object arg = POP; 1210 Lisp_Object arg = POP;
1121 TOP = bytecode_arithcompare (TOP, arg) > 0 ? Qt : Qnil; 1211 TOP_LVALUE = bytecode_arithcompare (TOP, arg) > 0 ? Qt : Qnil;
1122 break; 1212 break;
1123 } 1213 }
1124 1214
1125 case Blss: 1215 case Blss:
1126 { 1216 {
1127 Lisp_Object arg = POP; 1217 Lisp_Object arg = POP;
1128 TOP = bytecode_arithcompare (TOP, arg) < 0 ? Qt : Qnil; 1218 TOP_LVALUE = bytecode_arithcompare (TOP, arg) < 0 ? Qt : Qnil;
1129 break; 1219 break;
1130 } 1220 }
1131 1221
1132 case Bleq: 1222 case Bleq:
1133 { 1223 {
1134 Lisp_Object arg = POP; 1224 Lisp_Object arg = POP;
1135 TOP = bytecode_arithcompare (TOP, arg) <= 0 ? Qt : Qnil; 1225 TOP_LVALUE = bytecode_arithcompare (TOP, arg) <= 0 ? Qt : Qnil;
1136 break; 1226 break;
1137 } 1227 }
1138 1228
1139 case Bgeq: 1229 case Bgeq:
1140 { 1230 {
1141 Lisp_Object arg = POP; 1231 Lisp_Object arg = POP;
1142 TOP = bytecode_arithcompare (TOP, arg) >= 0 ? Qt : Qnil; 1232 TOP_LVALUE = bytecode_arithcompare (TOP, arg) >= 0 ? Qt : Qnil;
1143 break; 1233 break;
1144 } 1234 }
1145 1235
1146 1236
1147 case Bnegate: 1237 case Bnegate:
1148 TOP = bytecode_negate (TOP); 1238 TOP_LVALUE = bytecode_negate (TOP);
1149 break; 1239 break;
1150 1240
1151 case Bnconc: 1241 case Bnconc:
1152 DISCARD (1); 1242 DISCARD (1);
1153 /* nconc2 GCPROs before calling this. */ 1243 /* nconc2 GCPROs before calling this. */
1154 /* GCPRO_STACK; */ 1244 /* GCPRO_STACK; */
1155 TOP = bytecode_nconc2 (&TOP); 1245 TOP_LVALUE = TOP; /* Ignore multiple values. */
1246 TOP_LVALUE = bytecode_nconc2 (TOP_ADDRESS);
1156 break; 1247 break;
1157 1248
1158 case Bplus: 1249 case Bplus:
1159 { 1250 {
1160 Lisp_Object arg2 = POP; 1251 Lisp_Object arg2 = POP;
1161 Lisp_Object arg1 = TOP; 1252 Lisp_Object arg1 = TOP;
1162 #ifdef HAVE_BIGNUM 1253 #ifdef HAVE_BIGNUM
1163 TOP = bytecode_arithop (arg1, arg2, opcode); 1254 TOP_LVALUE = bytecode_arithop (arg1, arg2, opcode);
1164 #else 1255 #else
1165 TOP = INTP (arg1) && INTP (arg2) ? 1256 TOP_LVALUE = INTP (arg1) && INTP (arg2) ?
1166 INT_PLUS (arg1, arg2) : 1257 INT_PLUS (arg1, arg2) :
1167 bytecode_arithop (arg1, arg2, opcode); 1258 bytecode_arithop (arg1, arg2, opcode);
1168 #endif 1259 #endif
1169 break; 1260 break;
1170 } 1261 }
1172 case Bdiff: 1263 case Bdiff:
1173 { 1264 {
1174 Lisp_Object arg2 = POP; 1265 Lisp_Object arg2 = POP;
1175 Lisp_Object arg1 = TOP; 1266 Lisp_Object arg1 = TOP;
1176 #ifdef HAVE_BIGNUM 1267 #ifdef HAVE_BIGNUM
1177 TOP = bytecode_arithop (arg1, arg2, opcode); 1268 TOP_LVALUE = bytecode_arithop (arg1, arg2, opcode);
1178 #else 1269 #else
1179 TOP = INTP (arg1) && INTP (arg2) ? 1270 TOP_LVALUE = INTP (arg1) && INTP (arg2) ?
1180 INT_MINUS (arg1, arg2) : 1271 INT_MINUS (arg1, arg2) :
1181 bytecode_arithop (arg1, arg2, opcode); 1272 bytecode_arithop (arg1, arg2, opcode);
1182 #endif 1273 #endif
1183 break; 1274 break;
1184 } 1275 }
1187 case Bquo: 1278 case Bquo:
1188 case Bmax: 1279 case Bmax:
1189 case Bmin: 1280 case Bmin:
1190 { 1281 {
1191 Lisp_Object arg = POP; 1282 Lisp_Object arg = POP;
1192 TOP = bytecode_arithop (TOP, arg, opcode); 1283 TOP_LVALUE = bytecode_arithop (TOP, arg, opcode);
1193 break; 1284 break;
1194 } 1285 }
1195 1286
1196 case Bpoint: 1287 case Bpoint:
1197 PUSH (make_int (BUF_PT (current_buffer))); 1288 PUSH (make_int (BUF_PT (current_buffer)));
1198 break; 1289 break;
1199 1290
1200 case Binsert: 1291 case Binsert:
1201 /* Says it can GC. */ 1292 /* Says it can GC. */
1202 /* GCPRO_STACK; */ 1293 /* GCPRO_STACK; */
1203 TOP = Finsert (1, &TOP); 1294 TOP_LVALUE = TOP; /* Ignore multiple values. */
1295 TOP_LVALUE = Finsert (1, TOP_ADDRESS);
1204 break; 1296 break;
1205 1297
1206 case BinsertN: 1298 case BinsertN:
1207 n = READ_UINT_1; 1299 n = READ_UINT_1;
1208 DISCARD (n - 1); 1300 DISCARD (n - 1);
1209 /* See Binsert. */ 1301 /* See Binsert. */
1210 /* GCPRO_STACK; */ 1302 /* GCPRO_STACK; */
1211 TOP = Finsert (n, &TOP); 1303 TOP_LVALUE = TOP; /* Ignore multiple values. */
1304 TOP_LVALUE = Finsert (n, TOP_ADDRESS);
1212 break; 1305 break;
1213 1306
1214 case Baref: 1307 case Baref:
1215 { 1308 {
1216 Lisp_Object arg = POP; 1309 Lisp_Object arg = POP;
1217 TOP = Faref (TOP, arg); 1310 TOP_LVALUE = Faref (TOP, arg);
1218 break; 1311 break;
1219 } 1312 }
1220 1313
1221 case Bmemq: 1314 case Bmemq:
1222 { 1315 {
1223 Lisp_Object arg = POP; 1316 Lisp_Object arg = POP;
1224 TOP = Fmemq (TOP, arg); 1317 TOP_LVALUE = Fmemq (TOP, arg);
1225 break; 1318 break;
1226 } 1319 }
1227 1320
1228 case Bset: 1321 case Bset:
1229 { 1322 {
1230 Lisp_Object arg = POP; 1323 Lisp_Object arg = POP;
1231 /* Fset may call magic handlers */ 1324 /* Fset may call magic handlers */
1232 /* GCPRO_STACK; */ 1325 /* GCPRO_STACK; */
1233 TOP = Fset (TOP, arg); 1326 TOP_LVALUE = Fset (TOP, arg);
1234 break; 1327 break;
1235 } 1328 }
1236 1329
1237 case Bequal: 1330 case Bequal:
1238 { 1331 {
1239 Lisp_Object arg = POP; 1332 Lisp_Object arg = POP;
1240 /* Can QUIT, so can GC, right? */ 1333 /* Can QUIT, so can GC, right? */
1241 /* GCPRO_STACK; */ 1334 /* GCPRO_STACK; */
1242 TOP = Fequal (TOP, arg); 1335 TOP_LVALUE = Fequal (TOP, arg);
1243 break; 1336 break;
1244 } 1337 }
1245 1338
1246 case Bnthcdr: 1339 case Bnthcdr:
1247 { 1340 {
1248 Lisp_Object arg = POP; 1341 Lisp_Object arg = POP;
1249 TOP = Fnthcdr (TOP, arg); 1342 TOP_LVALUE = Fnthcdr (TOP, arg);
1250 break; 1343 break;
1251 } 1344 }
1252 1345
1253 case Belt: 1346 case Belt:
1254 { 1347 {
1255 Lisp_Object arg = POP; 1348 Lisp_Object arg = POP;
1256 TOP = Felt (TOP, arg); 1349 TOP_LVALUE = Felt (TOP, arg);
1257 break; 1350 break;
1258 } 1351 }
1259 1352
1260 case Bmember: 1353 case Bmember:
1261 { 1354 {
1262 Lisp_Object arg = POP; 1355 Lisp_Object arg = POP;
1263 /* Can QUIT, so can GC, right? */ 1356 /* Can QUIT, so can GC, right? */
1264 /* GCPRO_STACK; */ 1357 /* GCPRO_STACK; */
1265 TOP = Fmember (TOP, arg); 1358 TOP_LVALUE = Fmember (TOP, arg);
1266 break; 1359 break;
1267 } 1360 }
1268 1361
1269 case Bgoto_char: 1362 case Bgoto_char:
1270 TOP = Fgoto_char (TOP, Qnil); 1363 TOP_LVALUE = Fgoto_char (TOP, Qnil);
1271 break; 1364 break;
1272 1365
1273 case Bcurrent_buffer: 1366 case Bcurrent_buffer:
1274 { 1367 {
1275 Lisp_Object buffer = wrap_buffer (current_buffer); 1368 Lisp_Object buffer = wrap_buffer (current_buffer);
1280 1373
1281 case Bset_buffer: 1374 case Bset_buffer:
1282 /* #### WAG: set-buffer may cause Fset's of buffer locals 1375 /* #### WAG: set-buffer may cause Fset's of buffer locals
1283 Didn't prevent crash. :-( */ 1376 Didn't prevent crash. :-( */
1284 /* GCPRO_STACK; */ 1377 /* GCPRO_STACK; */
1285 TOP = Fset_buffer (TOP); 1378 TOP_LVALUE = Fset_buffer (TOP);
1286 break; 1379 break;
1287 1380
1288 case Bpoint_max: 1381 case Bpoint_max:
1289 PUSH (make_int (BUF_ZV (current_buffer))); 1382 PUSH (make_int (BUF_ZV (current_buffer)));
1290 break; 1383 break;
1296 case Bskip_chars_forward: 1389 case Bskip_chars_forward:
1297 { 1390 {
1298 Lisp_Object arg = POP; 1391 Lisp_Object arg = POP;
1299 /* Can QUIT, so can GC, right? */ 1392 /* Can QUIT, so can GC, right? */
1300 /* GCPRO_STACK; */ 1393 /* GCPRO_STACK; */
1301 TOP = Fskip_chars_forward (TOP, arg, Qnil); 1394 TOP_LVALUE = Fskip_chars_forward (TOP, arg, Qnil);
1302 break; 1395 break;
1303 } 1396 }
1304 1397
1305 case Bassq: 1398 case Bassq:
1306 { 1399 {
1307 Lisp_Object arg = POP; 1400 Lisp_Object arg = POP;
1308 TOP = Fassq (TOP, arg); 1401 TOP_LVALUE = Fassq (TOP, arg);
1309 break; 1402 break;
1310 } 1403 }
1311 1404
1312 case Bsetcar: 1405 case Bsetcar:
1313 { 1406 {
1314 Lisp_Object arg = POP; 1407 Lisp_Object arg = POP;
1315 TOP = Fsetcar (TOP, arg); 1408 TOP_LVALUE = Fsetcar (TOP, arg);
1316 break; 1409 break;
1317 } 1410 }
1318 1411
1319 case Bsetcdr: 1412 case Bsetcdr:
1320 { 1413 {
1321 Lisp_Object arg = POP; 1414 Lisp_Object arg = POP;
1322 TOP = Fsetcdr (TOP, arg); 1415 TOP_LVALUE = Fsetcdr (TOP, arg);
1323 break; 1416 break;
1324 } 1417 }
1325 1418
1326 case Bnreverse: 1419 case Bnreverse:
1327 TOP = bytecode_nreverse (TOP); 1420 TOP_LVALUE = bytecode_nreverse (TOP);
1328 break; 1421 break;
1329 1422
1330 case Bcar_safe: 1423 case Bcar_safe:
1331 TOP = CONSP (TOP) ? XCAR (TOP) : Qnil; 1424 TOP_LVALUE = CONSP (TOP) ? XCAR (TOP) : Qnil;
1332 break; 1425 break;
1333 1426
1334 case Bcdr_safe: 1427 case Bcdr_safe:
1335 TOP = CONSP (TOP) ? XCDR (TOP) : Qnil; 1428 TOP_LVALUE = CONSP (TOP) ? XCDR (TOP) : Qnil;
1336 break; 1429 break;
1337 1430
1338 } 1431 }
1339 } 1432 }
1340 } 1433 }
1349 Lisp_Object * 1442 Lisp_Object *
1350 execute_rare_opcode (Lisp_Object *stack_ptr, 1443 execute_rare_opcode (Lisp_Object *stack_ptr,
1351 const Opbyte *UNUSED (program_ptr), 1444 const Opbyte *UNUSED (program_ptr),
1352 Opcode opcode) 1445 Opcode opcode)
1353 { 1446 {
1447 REGISTER int n;
1448
1354 switch (opcode) 1449 switch (opcode)
1355 { 1450 {
1356 1451
1357 case Bsave_excursion: 1452 case Bsave_excursion:
1358 record_unwind_protect (save_excursion_restore, 1453 record_unwind_protect (save_excursion_restore,
1359 save_excursion_save ()); 1454 save_excursion_save ());
1360 break; 1455 break;
1361 1456
1457 /* This bytecode will eventually go away, once we no longer encounter
1458 byte code from 21.4. In 21.5.10 and newer, save-window-excursion is
1459 a macro. */
1362 case Bsave_window_excursion: 1460 case Bsave_window_excursion:
1363 { 1461 {
1364 int count = specpdl_depth (); 1462 int count = specpdl_depth ();
1365 record_unwind_protect (save_window_excursion_unwind, 1463 record_unwind_protect (Feval,
1366 call1 (Qcurrent_window_configuration, Qnil)); 1464 list2 (Qset_window_configuration,
1367 TOP = Fprogn (TOP); 1465 call0 (Qcurrent_window_configuration)));
1466 TOP_LVALUE = Fprogn (TOP);
1368 unbind_to (count); 1467 unbind_to (count);
1369 break; 1468 break;
1370 } 1469 }
1371 1470
1372 case Bsave_restriction: 1471 case Bsave_restriction:
1375 break; 1474 break;
1376 1475
1377 case Bcatch: 1476 case Bcatch:
1378 { 1477 {
1379 Lisp_Object arg = POP; 1478 Lisp_Object arg = POP;
1380 TOP = internal_catch (TOP, Feval, arg, 0, 0, 0); 1479 TOP_LVALUE = internal_catch (TOP, Feval, arg, 0, 0, 0);
1381 break; 1480 break;
1382 } 1481 }
1383 1482
1384 case Bskip_chars_backward: 1483 case Bskip_chars_backward:
1385 { 1484 {
1386 Lisp_Object arg = POP; 1485 Lisp_Object arg = POP;
1387 TOP = Fskip_chars_backward (TOP, arg, Qnil); 1486 TOP_LVALUE = Fskip_chars_backward (TOP, arg, Qnil);
1388 break; 1487 break;
1389 } 1488 }
1390 1489
1391 case Bunwind_protect: 1490 case Bunwind_protect:
1392 record_unwind_protect (Fprogn, POP); 1491 record_unwind_protect (Fprogn, POP);
1394 1493
1395 case Bcondition_case: 1494 case Bcondition_case:
1396 { 1495 {
1397 Lisp_Object arg2 = POP; /* handlers */ 1496 Lisp_Object arg2 = POP; /* handlers */
1398 Lisp_Object arg1 = POP; /* bodyform */ 1497 Lisp_Object arg1 = POP; /* bodyform */
1399 TOP = condition_case_3 (arg1, TOP, arg2); 1498 TOP_LVALUE = condition_case_3 (arg1, TOP, arg2);
1400 break; 1499 break;
1401 } 1500 }
1402 1501
1403 case Bset_marker: 1502 case Bset_marker:
1404 { 1503 {
1405 Lisp_Object arg2 = POP; 1504 Lisp_Object arg2 = POP;
1406 Lisp_Object arg1 = POP; 1505 Lisp_Object arg1 = POP;
1407 TOP = Fset_marker (TOP, arg1, arg2); 1506 TOP_LVALUE = Fset_marker (TOP, arg1, arg2);
1408 break; 1507 break;
1409 } 1508 }
1410 1509
1411 case Brem: 1510 case Brem:
1412 { 1511 {
1413 Lisp_Object arg = POP; 1512 Lisp_Object arg = POP;
1414 TOP = Frem (TOP, arg); 1513 TOP_LVALUE = Frem (TOP, arg);
1415 break; 1514 break;
1416 } 1515 }
1417 1516
1418 case Bmatch_beginning: 1517 case Bmatch_beginning:
1419 TOP = Fmatch_beginning (TOP); 1518 TOP_LVALUE = Fmatch_beginning (TOP);
1420 break; 1519 break;
1421 1520
1422 case Bmatch_end: 1521 case Bmatch_end:
1423 TOP = Fmatch_end (TOP); 1522 TOP_LVALUE = Fmatch_end (TOP);
1424 break; 1523 break;
1425 1524
1426 case Bupcase: 1525 case Bupcase:
1427 TOP = Fupcase (TOP, Qnil); 1526 TOP_LVALUE = Fupcase (TOP, Qnil);
1428 break; 1527 break;
1429 1528
1430 case Bdowncase: 1529 case Bdowncase:
1431 TOP = Fdowncase (TOP, Qnil); 1530 TOP_LVALUE = Fdowncase (TOP, Qnil);
1432 break; 1531 break;
1433 1532
1434 case Bfset: 1533 case Bfset:
1435 { 1534 {
1436 Lisp_Object arg = POP; 1535 Lisp_Object arg = POP;
1437 TOP = Ffset (TOP, arg); 1536 TOP_LVALUE = Ffset (TOP, arg);
1438 break; 1537 break;
1439 } 1538 }
1440 1539
1441 case Bstring_equal: 1540 case Bstring_equal:
1442 { 1541 {
1443 Lisp_Object arg = POP; 1542 Lisp_Object arg = POP;
1444 TOP = Fstring_equal (TOP, arg); 1543 TOP_LVALUE = Fstring_equal (TOP, arg);
1445 break; 1544 break;
1446 } 1545 }
1447 1546
1448 case Bstring_lessp: 1547 case Bstring_lessp:
1449 { 1548 {
1450 Lisp_Object arg = POP; 1549 Lisp_Object arg = POP;
1451 TOP = Fstring_lessp (TOP, arg); 1550 TOP_LVALUE = Fstring_lessp (TOP, arg);
1452 break; 1551 break;
1453 } 1552 }
1454 1553
1455 case Bsubstring: 1554 case Bsubstring:
1456 { 1555 {
1457 Lisp_Object arg2 = POP; 1556 Lisp_Object arg2 = POP;
1458 Lisp_Object arg1 = POP; 1557 Lisp_Object arg1 = POP;
1459 TOP = Fsubstring (TOP, arg1, arg2); 1558 TOP_LVALUE = Fsubstring (TOP, arg1, arg2);
1460 break; 1559 break;
1461 } 1560 }
1462 1561
1463 case Bcurrent_column: 1562 case Bcurrent_column:
1464 PUSH (make_int (current_column (current_buffer))); 1563 PUSH (make_int (current_column (current_buffer)));
1465 break; 1564 break;
1466 1565
1467 case Bchar_after: 1566 case Bchar_after:
1468 TOP = Fchar_after (TOP, Qnil); 1567 TOP_LVALUE = Fchar_after (TOP, Qnil);
1469 break; 1568 break;
1470 1569
1471 case Bindent_to: 1570 case Bindent_to:
1472 TOP = Findent_to (TOP, Qnil, Qnil); 1571 TOP_LVALUE = Findent_to (TOP, Qnil, Qnil);
1473 break; 1572 break;
1474 1573
1475 case Bwiden: 1574 case Bwiden:
1476 PUSH (Fwiden (Qnil)); 1575 PUSH (Fwiden (Qnil));
1477 break; 1576 break;
1508 case Binteractive_p: 1607 case Binteractive_p:
1509 PUSH (Finteractive_p ()); 1608 PUSH (Finteractive_p ());
1510 break; 1609 break;
1511 1610
1512 case Bforward_char: 1611 case Bforward_char:
1513 TOP = Fforward_char (TOP, Qnil); 1612 TOP_LVALUE = Fforward_char (TOP, Qnil);
1514 break; 1613 break;
1515 1614
1516 case Bforward_word: 1615 case Bforward_word:
1517 TOP = Fforward_word (TOP, Qnil); 1616 TOP_LVALUE = Fforward_word (TOP, Qnil);
1518 break; 1617 break;
1519 1618
1520 case Bforward_line: 1619 case Bforward_line:
1521 TOP = Fforward_line (TOP, Qnil); 1620 TOP_LVALUE = Fforward_line (TOP, Qnil);
1522 break; 1621 break;
1523 1622
1524 case Bchar_syntax: 1623 case Bchar_syntax:
1525 TOP = Fchar_syntax (TOP, Qnil); 1624 TOP_LVALUE = Fchar_syntax (TOP, Qnil);
1526 break; 1625 break;
1527 1626
1528 case Bbuffer_substring: 1627 case Bbuffer_substring:
1529 { 1628 {
1530 Lisp_Object arg = POP; 1629 Lisp_Object arg = POP;
1531 TOP = Fbuffer_substring (TOP, arg, Qnil); 1630 TOP_LVALUE = Fbuffer_substring (TOP, arg, Qnil);
1532 break; 1631 break;
1533 } 1632 }
1534 1633
1535 case Bdelete_region: 1634 case Bdelete_region:
1536 { 1635 {
1537 Lisp_Object arg = POP; 1636 Lisp_Object arg = POP;
1538 TOP = Fdelete_region (TOP, arg, Qnil); 1637 TOP_LVALUE = Fdelete_region (TOP, arg, Qnil);
1539 break; 1638 break;
1540 } 1639 }
1541 1640
1542 case Bnarrow_to_region: 1641 case Bnarrow_to_region:
1543 { 1642 {
1544 Lisp_Object arg = POP; 1643 Lisp_Object arg = POP;
1545 TOP = Fnarrow_to_region (TOP, arg, Qnil); 1644 TOP_LVALUE = Fnarrow_to_region (TOP, arg, Qnil);
1546 break; 1645 break;
1547 } 1646 }
1548 1647
1549 case Bend_of_line: 1648 case Bend_of_line:
1550 TOP = Fend_of_line (TOP, Qnil); 1649 TOP_LVALUE = Fend_of_line (TOP, Qnil);
1551 break; 1650 break;
1552 1651
1553 case Btemp_output_buffer_setup: 1652 case Btemp_output_buffer_setup:
1554 temp_output_buffer_setup (TOP); 1653 temp_output_buffer_setup (TOP);
1555 TOP = Vstandard_output; 1654 TOP_LVALUE = Vstandard_output;
1556 break; 1655 break;
1557 1656
1558 case Btemp_output_buffer_show: 1657 case Btemp_output_buffer_show:
1559 { 1658 {
1560 Lisp_Object arg = POP; 1659 Lisp_Object arg = POP;
1561 temp_output_buffer_show (TOP, Qnil); 1660 temp_output_buffer_show (TOP, Qnil);
1562 TOP = arg; 1661 TOP_LVALUE = arg;
1563 /* GAG ME!! */ 1662 /* GAG ME!! */
1564 /* pop binding of standard-output */ 1663 /* pop binding of standard-output */
1565 unbind_to (specpdl_depth() - 1); 1664 unbind_to (specpdl_depth() - 1);
1566 break; 1665 break;
1567 } 1666 }
1568 1667
1569 case Bold_eq: 1668 case Bold_eq:
1570 { 1669 {
1571 Lisp_Object arg = POP; 1670 Lisp_Object arg = POP;
1572 TOP = HACKEQ_UNSAFE (TOP, arg) ? Qt : Qnil; 1671 TOP_LVALUE = HACKEQ_UNSAFE (TOP, arg) ? Qt : Qnil;
1573 break; 1672 break;
1574 } 1673 }
1575 1674
1576 case Bold_memq: 1675 case Bold_memq:
1577 { 1676 {
1578 Lisp_Object arg = POP; 1677 Lisp_Object arg = POP;
1579 TOP = Fold_memq (TOP, arg); 1678 TOP_LVALUE = Fold_memq (TOP, arg);
1580 break; 1679 break;
1581 } 1680 }
1582 1681
1583 case Bold_equal: 1682 case Bold_equal:
1584 { 1683 {
1585 Lisp_Object arg = POP; 1684 Lisp_Object arg = POP;
1586 TOP = Fold_equal (TOP, arg); 1685 TOP_LVALUE = Fold_equal (TOP, arg);
1587 break; 1686 break;
1588 } 1687 }
1589 1688
1590 case Bold_member: 1689 case Bold_member:
1591 { 1690 {
1592 Lisp_Object arg = POP; 1691 Lisp_Object arg = POP;
1593 TOP = Fold_member (TOP, arg); 1692 TOP_LVALUE = Fold_member (TOP, arg);
1594 break; 1693 break;
1595 } 1694 }
1596 1695
1597 case Bold_assq: 1696 case Bold_assq:
1598 { 1697 {
1599 Lisp_Object arg = POP; 1698 Lisp_Object arg = POP;
1600 TOP = Fold_assq (TOP, arg); 1699 TOP_LVALUE = Fold_assq (TOP, arg);
1601 break; 1700 break;
1701 }
1702
1703 case Bbind_multiple_value_limits:
1704 {
1705 Lisp_Object upper = POP, first = TOP, speccount;
1706
1707 CHECK_NATNUM (upper);
1708 CHECK_NATNUM (first);
1709
1710 speccount = make_int (bind_multiple_value_limits (XINT (first),
1711 XINT (upper)));
1712 PUSH (upper);
1713 PUSH (speccount);
1714 break;
1715 }
1716
1717 case Bmultiple_value_call:
1718 {
1719 n = XINT (POP);
1720 DISCARD_PRESERVING_MULTIPLE_VALUES (n - 1);
1721 /* Discard multiple values for the first (function) argument: */
1722 TOP_LVALUE = TOP;
1723 TOP_LVALUE = multiple_value_call (n, TOP_ADDRESS);
1724 break;
1725 }
1726
1727 case Bmultiple_value_list_internal:
1728 {
1729 DISCARD_PRESERVING_MULTIPLE_VALUES (3);
1730 TOP_LVALUE = multiple_value_list_internal (4, TOP_ADDRESS);
1731 break;
1732 }
1733
1734 case Bthrow:
1735 {
1736 Lisp_Object arg = POP_WITH_MULTIPLE_VALUES;
1737
1738 /* We never throw to a catch tag that is a multiple value: */
1739 throw_or_bomb_out (TOP, arg, 0, Qnil, Qnil);
1740 break;
1602 } 1741 }
1603 1742
1604 default: 1743 default:
1605 ABORT(); 1744 ABORT();
1606 break; 1745 break;
2020 } 2159 }
2021 } 2160 }
2022 } 2161 }
2023 2162
2024 if (totalargs) 2163 if (totalargs)
2164 #ifdef NEW_GC
2165 f->arguments = make_compiled_function_args (totalargs);
2166 #else /* not NEW_GC */
2025 f->args = xnew_array (Lisp_Object, totalargs); 2167 f->args = xnew_array (Lisp_Object, totalargs);
2168 #endif /* not NEW_GC */
2026 2169
2027 { 2170 {
2028 LIST_LOOP_2 (arg, f->arglist) 2171 LIST_LOOP_2 (arg, f->arglist)
2029 { 2172 {
2030 if (!EQ (arg, Qand_optional) && !EQ (arg, Qand_rest)) 2173 if (!EQ (arg, Qand_optional) && !EQ (arg, Qand_rest))
2174 #ifdef NEW_GC
2175 XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i++] = arg;
2176 #else /* not NEW_GC */
2031 f->args[i++] = arg; 2177 f->args[i++] = arg;
2178 #endif /* not NEW_GC */
2032 } 2179 }
2033 } 2180 }
2034 2181
2035 f->max_args = maxargs; 2182 f->max_args = maxargs;
2036 f->min_args = minargs; 2183 f->min_args = minargs;
2059 } 2206 }
2060 2207
2061 /************************************************************************/ 2208 /************************************************************************/
2062 /* The compiled-function object type */ 2209 /* The compiled-function object type */
2063 /************************************************************************/ 2210 /************************************************************************/
2211
2064 static void 2212 static void
2065 print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun, 2213 print_compiled_function (Lisp_Object obj, Lisp_Object printcharfun,
2066 int escapeflag) 2214 int escapeflag)
2067 { 2215 {
2068 /* This function can GC */ 2216 /* This function can GC */
2141 mark_object (f->doc_and_interactive); 2289 mark_object (f->doc_and_interactive);
2142 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK 2290 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2143 mark_object (f->annotated); 2291 mark_object (f->annotated);
2144 #endif 2292 #endif
2145 for (i = 0; i < f->args_in_array; i++) 2293 for (i = 0; i < f->args_in_array; i++)
2294 #ifdef NEW_GC
2295 mark_object (XCOMPILED_FUNCTION_ARGS_DATA (f->arguments)[i]);
2296 #else /* not NEW_GC */
2146 mark_object (f->args[i]); 2297 mark_object (f->args[i]);
2298 #endif /* not NEW_GC */
2147 2299
2148 /* tail-recurse on constants */ 2300 /* tail-recurse on constants */
2149 return f->constants; 2301 return f->constants;
2150 } 2302 }
2151 2303
2177 internal_hash (f->constants, depth + 1)); 2329 internal_hash (f->constants, depth + 1));
2178 } 2330 }
2179 2331
2180 static const struct memory_description compiled_function_description[] = { 2332 static const struct memory_description compiled_function_description[] = {
2181 { XD_INT, offsetof (Lisp_Compiled_Function, args_in_array) }, 2333 { XD_INT, offsetof (Lisp_Compiled_Function, args_in_array) },
2182 { XD_BLOCK_PTR, offsetof (Lisp_Compiled_Function, args), 2334 #ifdef NEW_GC
2335 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arguments) },
2336 #else /* not NEW_GC */
2337 { XD_BLOCK_PTR, offsetof (Lisp_Compiled_Function, args),
2183 XD_INDIRECT (0, 0), { &lisp_object_description } }, 2338 XD_INDIRECT (0, 0), { &lisp_object_description } },
2339 #endif /* not NEW_GC */
2184 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, instructions) }, 2340 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, instructions) },
2185 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, constants) }, 2341 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, constants) },
2186 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arglist) }, 2342 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, arglist) },
2187 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, doc_and_interactive) }, 2343 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, doc_and_interactive) },
2188 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK 2344 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2189 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, annotated) }, 2345 { XD_LISP_OBJECT, offsetof (Lisp_Compiled_Function, annotated) },
2190 #endif 2346 #endif
2191 { XD_END } 2347 { XD_END }
2192 }; 2348 };
2193 2349
2194 #ifdef MC_ALLOC 2350 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("compiled-function", compiled_function,
2195 static void
2196 finalize_compiled_function (void *header, int for_disksave)
2197 {
2198 if (!for_disksave)
2199 {
2200 struct Lisp_Compiled_Function *cf =
2201 (struct Lisp_Compiled_Function *) header;
2202 if (cf->args_in_array)
2203 xfree (cf->args, Lisp_Object *);
2204 }
2205 }
2206
2207 DEFINE_BASIC_LISP_OBJECT ("compiled-function", compiled_function,
2208 mark_compiled_function,
2209 print_compiled_function,
2210 finalize_compiled_function,
2211 compiled_function_equal,
2212 compiled_function_hash,
2213 compiled_function_description,
2214 Lisp_Compiled_Function);
2215 #else /* not MC_ALLOC */
2216 DEFINE_BASIC_LISP_OBJECT ("compiled-function", compiled_function,
2217 mark_compiled_function, 2351 mark_compiled_function,
2218 print_compiled_function, 0, 2352 print_compiled_function, 0,
2219 compiled_function_equal, 2353 compiled_function_equal,
2220 compiled_function_hash, 2354 compiled_function_hash,
2221 compiled_function_description, 2355 compiled_function_description,
2222 Lisp_Compiled_Function); 2356 Lisp_Compiled_Function);
2223 #endif /* not MC_ALLOC */ 2357
2224 2358
2225 DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /* 2359 DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /*
2226 Return t if OBJECT is a byte-compiled function object. 2360 Return t if OBJECT is a byte-compiled function object.
2227 */ 2361 */
2228 (object)) 2362 (object))
2590 2724
2591 void 2725 void
2592 syms_of_bytecode (void) 2726 syms_of_bytecode (void)
2593 { 2727 {
2594 INIT_LISP_OBJECT (compiled_function); 2728 INIT_LISP_OBJECT (compiled_function);
2729 #ifdef NEW_GC
2730 INIT_LISP_OBJECT (compiled_function_args);
2731 #endif /* NEW_GC */
2595 2732
2596 DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state); 2733 DEFERROR_STANDARD (Qinvalid_byte_code, Qinvalid_state);
2597 DEFSYMBOL (Qbyte_code); 2734 DEFSYMBOL (Qbyte_code);
2598 DEFSYMBOL_MULTIWORD_PREDICATE (Qcompiled_functionp); 2735 DEFSYMBOL_MULTIWORD_PREDICATE (Qcompiled_functionp);
2599 2736