--- a/lisp/ChangeLog	Mon Apr 23 10:06:39 2012 +0200
+++ b/lisp/ChangeLog	Tue May 01 12:43:22 2012 +0100
@@ -1,3 +1,22 @@
+2012-05-01  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* byte-optimize.el (byte-optimize-form-code-walker):
+	* byte-optimize.el (byte-optimize-or):
+	Improve handling of for-effect here; we don't need to worry about
+	discarding multiple values when for-effect is non-nil, this
+	applies to both #'prog1 and #'or.
+	* bytecomp.el (progn):
+	* bytecomp.el (byte-compile-file-form-progn): New.
+	Put back this function, since it's for-effect there's no need to
+	worry about passing back multiple values.
+	* cl-macs.el (cl-pop2):
+	* cl-macs.el (cl-do-pop):
+	* cl-macs.el (remf):
+	* cl.el (pop):
+	Expand to (prog1 (car-safe PLACE) (setq PLACE (cdr PLACE))) in all
+	these macros, since that optimizes better (especially for-effect
+	handling) when byte-compile-delete-errors is nil.
+
 2012-04-23  Michael Sperber  <mike@xemacs.org>
 
 	* bytecomp.el (batch-byte-recompile-directory): Accept an optional

--- a/lisp/byte-optimize.el	Mon Apr 23 10:06:39 2012 +0200
+++ b/lisp/byte-optimize.el	Tue May 01 12:43:22 2012 +0100
@@ -431,7 +431,7 @@
 	     (byte-optimize-form (nth 1 form) for-effect)))
 	  ((eq fn 'prog1)
 	   (if (cdr (cdr form))
-	       (cons 'prog1
+	       (cons (if for-effect 'progn 'prog1)
 		     (cons (byte-optimize-form (nth 1 form) for-effect)
 			   (byte-optimize-body (cdr (cdr form)) t)))
 	     (byte-optimize-form `(or ,(nth 1 form) nil) for-effect)))
@@ -537,6 +537,12 @@
 		(setq tmp (byte-optimize-side-effect-free-p form))
 		(or byte-compile-delete-errors
 		    (eq tmp 'error-free)
+                    ;; XEmacs; GNU handles the expansion of (pop foo) specially
+                    ;; here. We changed the macro to expand to (prog1 (car-safe
+                    ;; PLACE) (setq PLACE (cdr PLACE))) , which has the same
+                    ;; effect. (This only matters when
+                    ;; byte-compile-delete-errors is nil, which is usually true
+                    ;; for GNU and usually false for XEmacs.)
 		    (progn
 		      (byte-compile-warn "%s called for effect"
 					 (prin1-to-string form))
@@ -947,20 +953,17 @@
 (defun byte-optimize-or (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.
+  (if (memq nil form)
+      (setq form (remove* nil form
+                          ;; A trailing nil indicates to discard multiple
+                          ;; values, and we need to respect that. No need if
+                          ;; this is for-effect, though, multiple values
+                          ;; will be discarded anyway.
+                          :end (if (not for-effect) (1- (length 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.
+  (let ((rest form))
     (while (cdr (setq rest (cdr rest)))
       (if (byte-compile-trueconstp (car rest))
 	  (setq form (copy-sequence form)

--- a/lisp/bytecomp.el	Mon Apr 23 10:06:39 2012 +0200
+++ b/lisp/bytecomp.el	Tue May 01 12:43:22 2012 +0100
@@ -2411,29 +2411,13 @@
   (eval form)
   (byte-compile-keep-pending form 'byte-compile-normal-call))
 
-;; 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))))
+(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)
+  (mapc 'byte-compile-file-form (cdr form))
+  ;; Return nil so the forms are not output twice.
+  nil)
 
 ;; This handler is not necessary, but it makes the output from dont-compile
 ;; and similar macros cleaner.

--- a/lisp/cl-macs.el	Mon Apr 23 10:06:39 2012 +0200
+++ b/lisp/cl-macs.el	Tue May 01 12:43:22 2012 +0100
@@ -46,7 +46,7 @@
 ;;; Code:
 
 (defmacro cl-pop2 (place)
-  (list 'prog1 (list 'car (list 'cdr place))
+  (list 'prog1 (list 'car-safe (list 'cdr-safe place))
 	(list 'setq place (list 'cdr (list 'cdr place)))))
 (put 'cl-pop2 'edebug-form-spec 'edebug-sexps)
 
@@ -2456,14 +2456,14 @@
 ;;;###autoload
 (defun cl-do-pop (place)
   (if (cl-simple-expr-p place)
-      (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place)))
+      (list 'prog1 (list 'car-safe place) (list 'setf place (list 'cdr place)))
     (let* ((method (cl-setf-do-modify place t))
 	   (temp (gensym "--pop--")))
       (list 'let*
 	    (append (car method)
 		    (list (list temp (nth 2 method))))
 	    (list 'prog1
-		  (list 'car temp)
+		  (list 'car-safe temp)
 		  (cl-setf-do-store (nth 1 method) (list 'cdr temp)))))))
 
 ;;;###autoload

--- a/lisp/cl.el	Mon Apr 23 10:06:39 2012 +0200
+++ b/lisp/cl.el	Tue May 01 12:43:22 2012 +0100
@@ -152,7 +152,7 @@
 careful about evaluating each argument only once and in the right order.
 PLACE may be a symbol, or any generalized variable allowed by `setf'."
   (if (symbolp place)
-      `(car (prog1 ,place (setq ,place (cdr ,place))))
+      `(car-safe (prog1 ,place (setq ,place (cdr ,place))))
     (cl-do-pop place)))
 
 (defmacro push (newelt listname)