comparison src/eval.c @ 4686:cdabd56ce1b5

Fix various small issues with the multiple-value implementation. lisp/ChangeLog addition: 2009-08-31 Aidan Kehoe <kehoea@parhasard.net> * byte-optimize.el (byte-optimize-form-code-walker): Be careful about discarding multiple values when optimising #'prog1 calls. (byte-optimize-or): Preserve any trailing nil, as this is a supported way to explicitly discard multiple values. (byte-optimize-cond-1): Discard multiple values with a singleton followed by no more clauses. * bytecomp.el (progn): (prog1): (prog2): Be careful about discarding multiple values in the byte-hunk handler of these three forms. * bytecomp.el (byte-compile-prog1, byte-compile-prog2): Don't call #'values explicitly, use `(or ,(pop form) nil) instead, since that compiles to bytecode, not a funcall. * bytecomp.el (byte-compile-values): With one non-const argument, byte-compile to `(or ,(second form) nil), not an explicit #'values call. * bytecomp.el (byte-compile-insert-header): Be nicer in the error message to emacs versions that don't understand our bytecode. src/ChangeLog addition: 2009-08-31 Aidan Kehoe <kehoea@parhasard.net> * eval.c (For, Fand): Don't declare val as REGISTER in these functions, for some reason it breaks the non-DEBUG union build. These functions are only called from interpreted code, the performance implication doesn't matter. Thank you Robert Delius Royar! * eval.c (Fmultiple_value_list_internal): Error on too many arguments. tests/ChangeLog addition: 2009-08-31 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-tests.el (Assert-rounding): Remove an overly-verbose failure message here. Correct a couple of tests which were buggy in themselves. Add three new tests, checking the behaviour of #'or and #'and when passed zero arguments, and a Known-Bug-Expect-Failure call involving letf and values. (The bug predates the C-level multiple-value implementation.)
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 06 Sep 2009 19:36:02 +0100
parents 8f1ee2d15784
children 80cd90837ac5
comparison
equal deleted inserted replaced
4685:945247a8112f 4686:cdabd56ce1b5
241 Lisp_Object Vpending_warnings, Vpending_warnings_tail; 241 Lisp_Object Vpending_warnings, Vpending_warnings_tail;
242 Lisp_Object Qif; 242 Lisp_Object Qif;
243 243
244 Lisp_Object Qthrow; 244 Lisp_Object Qthrow;
245 Lisp_Object Qobsolete_throw; 245 Lisp_Object Qobsolete_throw;
246 Lisp_Object Qmultiple_value_list_internal;
246 247
247 static int first_desired_multiple_value; 248 static int first_desired_multiple_value;
248 /* Used outside this file, somewhat uncleanly, in the IGNORE_MULTIPLE_VALUES 249 /* Used outside this file, somewhat uncleanly, in the IGNORE_MULTIPLE_VALUES
249 macro: */ 250 macro: */
250 int multiple_value_current_limit; 251 int multiple_value_current_limit;
836 arguments: (&rest ARGS) 837 arguments: (&rest ARGS)
837 */ 838 */
838 (args)) 839 (args))
839 { 840 {
840 /* This function can GC */ 841 /* This function can GC */
841 REGISTER Lisp_Object val; 842 Lisp_Object val = Qnil;
842 843
843 LIST_LOOP_3 (arg, args, tail) 844 LIST_LOOP_3 (arg, args, tail)
844 { 845 {
845 if (!NILP (IGNORE_MULTIPLE_VALUES (val = Feval (arg)))) 846 if (!NILP (IGNORE_MULTIPLE_VALUES (val = Feval (arg))))
846 { 847 {
868 arguments: (&rest ARGS) 869 arguments: (&rest ARGS)
869 */ 870 */
870 (args)) 871 (args))
871 { 872 {
872 /* This function can GC */ 873 /* This function can GC */
873 REGISTER Lisp_Object val = Qt; 874 Lisp_Object val = Qt;
874 875
875 LIST_LOOP_3 (arg, args, tail) 876 LIST_LOOP_3 (arg, args, tail)
876 { 877 {
877 if (NILP (IGNORE_MULTIPLE_VALUES (val = Feval (arg)))) 878 if (NILP (IGNORE_MULTIPLE_VALUES (val = Feval (arg))))
878 { 879 {
4793 arguments: (FIRST-DESIRED-MULTIPLE-VALUE MULTIPLE-VALUE-UPPER-LIMIT FORM) 4794 arguments: (FIRST-DESIRED-MULTIPLE-VALUE MULTIPLE-VALUE-UPPER-LIMIT FORM)
4794 */ 4795 */
4795 (args)) 4796 (args))
4796 { 4797 {
4797 Lisp_Object argv[4]; 4798 Lisp_Object argv[4];
4798 int first, upper; 4799 int first, upper, nargs;
4799 struct gcpro gcpro1; 4800 struct gcpro gcpro1;
4801
4802 GET_LIST_LENGTH (args, nargs);
4803 if (nargs != 3)
4804 {
4805 Fsignal (Qwrong_number_of_arguments,
4806 list2 (Qmultiple_value_list_internal, make_int (nargs)));
4807 }
4800 4808
4801 argv[0] = IGNORE_MULTIPLE_VALUES (Feval (XCAR (args))); 4809 argv[0] = IGNORE_MULTIPLE_VALUES (Feval (XCAR (args)));
4802 CHECK_NATNUM (argv[0]); 4810 CHECK_NATNUM (argv[0]);
4803 first = XINT (argv[0]); 4811 first = XINT (argv[0]);
4804 4812
7224 DEFSYMBOL (Qrun_hooks); 7232 DEFSYMBOL (Qrun_hooks);
7225 DEFSYMBOL (Qfinalize_list); 7233 DEFSYMBOL (Qfinalize_list);
7226 DEFSYMBOL (Qif); 7234 DEFSYMBOL (Qif);
7227 DEFSYMBOL (Qthrow); 7235 DEFSYMBOL (Qthrow);
7228 DEFSYMBOL (Qobsolete_throw); 7236 DEFSYMBOL (Qobsolete_throw);
7237 DEFSYMBOL (Qmultiple_value_list_internal);
7229 7238
7230 DEFSUBR (For); 7239 DEFSUBR (For);
7231 DEFSUBR (Fand); 7240 DEFSUBR (Fand);
7232 DEFSUBR (Fif); 7241 DEFSUBR (Fif);
7233 DEFSUBR_MACRO (Fwhen); 7242 DEFSUBR_MACRO (Fwhen);