--- a/lisp/ChangeLog	Wed Sep 02 20:38:14 2009 -0600
+++ b/lisp/ChangeLog	Sun Sep 06 19:36:02 2009 +0100
@@ -1,3 +1,29 @@
+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.
+
 2009-08-27  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl.el (bytecomp-load-hook): New.

--- a/lisp/byte-optimize.el	Wed Sep 02 20:38:14 2009 -0600
+++ b/lisp/byte-optimize.el	Sun Sep 06 19:36:02 2009 +0100
@@ -436,7 +436,7 @@
 	       (cons 'prog1
 		     (cons (byte-optimize-form (nth 1 form) for-effect)
 			   (byte-optimize-body (cdr (cdr form)) t)))
-	     (byte-optimize-form (nth 1 form) for-effect)))
+	     (byte-optimize-form `(or ,(nth 1 form) nil) for-effect)))
 	  ((eq fn 'prog2)
 	   (cons 'prog2
 	     (cons (byte-optimize-form (nth 1 form) t)
@@ -950,12 +950,22 @@
 	((byte-optimize-predicate form))))
 
 (defun byte-optimize-or (form)
-  ;; Throw away nil's, and simplify if less than 2 args.
-  ;; If there is a literal non-nil constant in the args to `or', throw away all
-  ;; following forms.
-  (if (memq nil form)
-      (setq form (delq nil (copy-sequence form))))
-  (let ((rest form))
+  ;; Throw away unneeded nils, and simplify if less than 2 args.
+  ;; XEmacs; change to be more careful about discarding multiple values. 
+  (let* ((memqueued (memq nil form))
+         (trailing-nil (and (cdr memqueued)
+                            (equal '(nil) (last form))))
+         rest)
+    ;; A trailing nil indicates to discard multiple values, and we need to
+    ;; respect that:
+    (when (and memqueued (cdr memqueued))
+      (setq form (delq nil (copy-sequence form)))
+      (when trailing-nil
+        (setcdr (last form) '(nil))))
+    (setq rest form)
+    ;; If there is a literal non-nil constant in the args to `or', throw
+    ;; away all following forms. We can do this because a literal non-nil
+    ;; constant cannot be multiple.
     (while (cdr (setq rest (cdr rest)))
       (if (byte-compile-trueconstp (car rest))
 	  (setq form (copy-sequence form)
@@ -978,7 +988,10 @@
    ((consp (car clauses))
     (nconc
      (case (length (car clauses))
-       (1 `(or ,(nth 0 (car clauses))))
+       (1 (if (cdr clauses)
+              `(or ,(nth 0 (car clauses)))
+            ;; XEmacs: don't pass any multiple values back:
+            `(or ,(nth 0 (car clauses)) nil)))
        (2 `(if ,(nth 0 (car clauses)) ,(nth 1 (car clauses))))
        (t `(if ,(nth 0 (car clauses)) (progn ,@(cdr (car clauses))))))
      (when (cdr clauses) (list (byte-optimize-cond-1 (cdr clauses))))))

--- a/lisp/bytecomp.el	Wed Sep 02 20:38:14 2009 -0600
+++ b/lisp/bytecomp.el	Sun Sep 06 19:36:02 2009 +0100
@@ -1816,7 +1816,7 @@
 (defun byte-compile-insert-header (filename byte-compile-inbuffer
 				   byte-compile-outbuffer)
   (set-buffer byte-compile-inbuffer)
-  (let (checks-string comments)
+  (let (comments)
     (set-buffer byte-compile-outbuffer)
     (delete-region 1 (1+ byte-compile-checks-and-comments-space))
     (goto-char 1)
@@ -1840,17 +1840,34 @@
       (insert (format ";;;###coding system: %s\n"
 		      (coding-system-name buffer-file-coding-system))))
     (insert (format
-	     "\n(or %s\n    (error \"Loading this file requires: %s\"))\n"
-	     (setq checks-string
-		   (let ((print-readably t))
-		     (prin1-to-string (if (> (length 
-					      byte-compile-checks-on-load)
-					     1)
-					  (cons 'and
-						(reverse
-						 byte-compile-checks-on-load))
-					(car byte-compile-checks-on-load)))))
-	     checks-string))
+	     "\n(or %s\n    (error \"Loading this file requires %s\"))\n"
+             (let ((print-readably t))
+               (prin1-to-string (if (> (length 
+                                        byte-compile-checks-on-load)
+                                       1)
+                                    (cons 'and
+                                          (setq byte-compile-checks-on-load
+                                                (reverse
+                                                 byte-compile-checks-on-load)))
+                                  (car byte-compile-checks-on-load))))
+             (loop
+               for check in byte-compile-checks-on-load
+               with seen-first = nil
+               with res = ""
+               do
+               (if seen-first
+                   (setq res (concat res ", "))
+                 (setq seen-first t))
+               ;; Print featurep calls differently: 
+               (if (and (eq (car check) 'featurep)
+                        (eq (car (second check)) 'quote)
+                        (symbolp (second (second check))))
+                   (setq res (concat res 
+                                     (symbol-name (second (second check)))))
+                 (setq res (concat res
+                                   (let ((print-readably t)) 
+                                     (prin1-to-string check)))))
+               finally return res)))
     (setq comments 
 	  (with-string-as-buffer-contents ""
 	    (insert "\n;;; compiled by "
@@ -2176,13 +2193,29 @@
   (eval form)
   (byte-compile-keep-pending form 'byte-compile-normal-call))
 
-(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
-(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
-(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)
-(defun byte-compile-file-form-progn (form)
-  (mapcar 'byte-compile-file-form (cdr form))
-  ;; Return nil so the forms are not output twice.
-  nil)
+;; XEmacs change: be careful about multiple values with these three forms.
+(put 'progn 'byte-hunk-handler
+     #'(lambda (form)
+         (mapc 'byte-compile-file-form (cdr form))
+         ;; Return nil so the forms are not output twice.
+         nil))
+
+(put 'prog1 'byte-hunk-handler
+     #'(lambda (form)
+         (when (first form)
+           (byte-compile-file-form `(or ,(first form) nil))
+           (mapc 'byte-compile-file-form (cdr form))
+           nil)))
+
+(put 'prog2 'byte-hunk-handler
+     #'(lambda (form)
+         (when (first form)
+           (byte-compile-file-form (first form))
+           (when (second form)
+             (setq form (cdr form))
+             (byte-compile-file-form `(or ,(first form) nil))
+             (mapc 'byte-compile-file-form (cdr form))
+             nil))))
 
 ;; This handler is not necessary, but it makes the output from dont-compile
 ;; and similar macros cleaner.
@@ -3677,7 +3710,7 @@
 (defun byte-compile-prog1 (form)
   (setq form (cdr form))
   ;; #'prog1 never returns multiple values:
-  (byte-compile-form-do-effect (list 'values (pop form)))
+  (byte-compile-form-do-effect `(or ,(pop form) nil))
   (byte-compile-body form t))
 
 (defun byte-compile-multiple-value-prog1 (form)
@@ -3686,9 +3719,11 @@
   (byte-compile-body form t))
 
 (defun byte-compile-values (form)
-  (if (and (= 2 (length form))
-           (byte-compile-constp (second form)))
-      (byte-compile-form-do-effect (second form))
+  (if (= 2 (length form))
+      (if (byte-compile-constp (second form))
+	  (byte-compile-form-do-effect (second form))
+	;; #'or compiles to bytecode, #'values doesn't:
+	(byte-compile-form-do-effect `(or ,(second form) nil)))
     (byte-compile-normal-call form)))
 
 (defun byte-compile-values-list (form)
@@ -3705,7 +3740,7 @@
   (setq form (cdr form))
   (byte-compile-form (pop form) t)
   ;; #'prog2 never returns multiple values:
-  (byte-compile-form-do-effect (list 'values (pop form)))
+  (byte-compile-form-do-effect `(or ,(pop form) nil))
   (byte-compile-body form t))
 
 (defmacro byte-compile-goto-if (cond discard tag)

--- a/src/ChangeLog	Wed Sep 02 20:38:14 2009 -0600
+++ b/src/ChangeLog	Sun Sep 06 19:36:02 2009 +0100
@@ -1,3 +1,13 @@
+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. 
+
 2009-08-24  Jerry James  <james@xemacs.org>
 
 	* lisp.h (INT_64_BIT): define as __int64 on WIN32.

--- a/src/eval.c	Wed Sep 02 20:38:14 2009 -0600
+++ b/src/eval.c	Sun Sep 06 19:36:02 2009 +0100
@@ -243,6 +243,7 @@
 
 Lisp_Object Qthrow;
 Lisp_Object Qobsolete_throw;
+Lisp_Object Qmultiple_value_list_internal;
 
 static int first_desired_multiple_value;
 /* Used outside this file, somewhat uncleanly, in the IGNORE_MULTIPLE_VALUES
@@ -838,7 +839,7 @@
        (args))
 {
   /* This function can GC */
-  REGISTER Lisp_Object val;
+  Lisp_Object val = Qnil;
 
   LIST_LOOP_3 (arg, args, tail)
     {
@@ -870,7 +871,7 @@
        (args))
 {
   /* This function can GC */
-  REGISTER Lisp_Object val = Qt;
+  Lisp_Object val = Qt;
 
   LIST_LOOP_3 (arg, args, tail)
     {
@@ -4795,9 +4796,16 @@
        (args))
 {
   Lisp_Object argv[4];
-  int first, upper;
+  int first, upper, nargs;
   struct gcpro gcpro1;
 
+  GET_LIST_LENGTH (args, nargs);
+  if (nargs != 3)
+    {
+      Fsignal (Qwrong_number_of_arguments,
+               list2 (Qmultiple_value_list_internal, make_int (nargs)));
+    }
+
   argv[0] = IGNORE_MULTIPLE_VALUES (Feval (XCAR (args)));
   CHECK_NATNUM (argv[0]);
   first = XINT (argv[0]);
@@ -7226,6 +7234,7 @@
   DEFSYMBOL (Qif);
   DEFSYMBOL (Qthrow);
   DEFSYMBOL (Qobsolete_throw);  
+  DEFSYMBOL (Qmultiple_value_list_internal);
 
   DEFSUBR (For);
   DEFSUBR (Fand);

--- a/tests/ChangeLog	Wed Sep 02 20:38:14 2009 -0600
+++ b/tests/ChangeLog	Sun Sep 06 19:36:02 2009 +0100
@@ -2,6 +2,16 @@
 
 	* reproduce-crashes.el (12): New bug.
 
+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.) 
+
 2009-08-16  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* automated/lisp-tests.el (foo): 

--- a/tests/automated/lisp-tests.el	Wed Sep 02 20:38:14 2009 -0600
+++ b/tests/automated/lisp-tests.el	Sun Sep 06 19:36:02 2009 +0100
@@ -1475,11 +1475,8 @@
 			 first one-round-result))
 	 (Assert (equal one-round-result (multiple-value-list
 					  (round first 1)))
-		 (format "checking (round %S 1) gives %S, types %S, actual %S, types %S"
-			 first one-round-result (mapcar #'type-of one-round-result)
-			 (multiple-value-list (round first 1))
-			 (mapcar #'type-of (multiple-value-list (round first 1)))))
-
+		 (format "checking (round %S 1) gives %S"
+			 first one-round-result))
 	 (Check-Error arith-error (round first 0))
 	 (Check-Error arith-error (round first 0.0))
 	 (Assert (equal two-round-result (multiple-value-list
@@ -1949,7 +1946,7 @@
        (multiple-value-function-returning-t ()
 	 (values t pi e degrees-to-radians radians-to-degrees))
        (multiple-value-function-returning-nil ()
-	 (values t pi e radians-to-degrees degrees-to-radians))
+	 (values nil pi e radians-to-degrees degrees-to-radians))
        (function-throwing-multiple-values ()
 	 (let* ((listing '(0 3 4 nil "string" symbol))
 		(tail listing)
@@ -2051,7 +2048,7 @@
 		 (cond ((multiple-value-function-returning-t))))))
    "Checking cond doesn't pass back multiple values in tests.")
   (Assert
-   (equal (list t pi e degrees-to-radians radians-to-degrees)
+   (equal (list nil pi e radians-to-degrees degrees-to-radians)
 	  (multiple-value-list
 	   (cond (t (multiple-value-function-returning-nil)))))
    "Checking cond passes back multiple values in clauses.")
@@ -2069,10 +2066,28 @@
 	  (multiple-value-list
 	   (catch 'VoN61Lo4Y (function-throwing-multiple-values)))))
   (Assert
-   (equal (list t pi e radians-to-degrees degrees-to-radians)
+   (equal (list t pi e degrees-to-radians radians-to-degrees)
 	  (multiple-value-list
 	   (loop
 	     for eye in `(a b c d ,e f g ,nil ,pi)
 	     do (when (null eye)
 		  (return (multiple-value-function-returning-t))))))
-   "Checking #'loop passes back multiple values correctly."))
+   "Checking #'loop passes back multiple values correctly.")
+  (Assert
+   (null (or))
+   "Checking #'or behaves correctly with zero arguments.")
+  (Assert
+   (eq t (and))
+   "Checking #'and behaves correctly with zero arguments.")
+  ;; This bug was here before the full multiple-value functionality
+  ;; was introduced (check it with (floor* pi) if you're
+  ;; curious). #'setf works, though, which is what most people are
+  ;; interested in. If you know the setf-method code better than I do,
+  ;; please post a patch; otherwise this is going to the back of the
+  ;; queue of things to do. I didn't break it :-) Aidan Kehoe, Mon Aug
+  ;; 31 10:45:50 GMTDT 2009. 
+  (Known-Bug-Expect-Error
+   void-variable
+   (letf (((values three one-four-one-five-nine) (floor pi)))
+     (* three one-four-one-five-nine))))
+