--- a/lisp/ChangeLog	Thu Feb 10 08:46:10 2011 +0000
+++ b/lisp/ChangeLog	Sat Feb 12 14:07:38 2011 +0000
@@ -1,3 +1,25 @@
+2011-02-12  Aidan Kehoe  <kehoea@parhasard.net>
+
+	* bytecomp.el:
+	* bytecomp.el (byte-compile-initial-macro-environment):
+	* bytecomp.el (unwind-protect):
+	* bytecomp.el (byte-compile-active-blocks):
+	* bytecomp.el (byte-compile-catch):
+	* bytecomp.el ('return-from-1): Removed.
+	* bytecomp.el ('block-1): Removed.
+	* bytecomp.el (byte-compile-block-1): Removed.
+	* bytecomp.el (byte-compile-return-from-1): Removed.
+	* bytecomp.el (byte-compile-throw):
+	* cl-macs.el (block):
+	* cl-macs.el (return-from):
+	In my last change, the elimination of `block's that were never
+	`return-from'd didn't work if `cl-macroexpand-all' was called
+	explicitly, something much code in cl-macs.el does.  Change the
+	implementation to something that doesn't require shadowing of the
+	macros in `byte-compile-initial-macro-environment', putting a
+	`cl-block-name' property on the gensym'd symbol argument to
+	`catch' instead.
+
 2011-02-09  Aidan Kehoe  <kehoea@parhasard.net>
 
 	* cl.el (acons): Removed, make the implementation in alloc.c

--- a/lisp/bytecomp.el	Thu Feb 10 08:46:10 2011 +0000
+++ b/lisp/bytecomp.el	Sat Feb 12 14:07:38 2011 +0000
@@ -511,11 +511,7 @@
 		    "%s is not of type %s" form type)))
 	   (if byte-compile-delete-errors
 	       form
-	     (funcall (cdr (symbol-function 'the)) type form))))
-    (return-from .
-      ,#'(lambda (name &optional result) `(return-from-1 ',name ,result)))
-    (block .
-      ,#'(lambda (name &rest body) `(block-1 ',name ,@body))))
+	     (funcall (cdr (symbol-function 'the)) type form)))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
 expanded by the compiler as when expanded by the interpreter.")
@@ -4186,8 +4182,6 @@
 ;;; other tricky macro-like special-operators
 
 (byte-defop-compiler-1 catch)
-(byte-defop-compiler-1 block-1)
-(byte-defop-compiler-1 return-from-1)
 (byte-defop-compiler-1 unwind-protect)
 (byte-defop-compiler-1 condition-case)
 (byte-defop-compiler-1 save-excursion)
@@ -4196,44 +4190,33 @@
 (byte-defop-compiler-1 with-output-to-temp-buffer)
 ;; no track-mouse.
 
+(defvar byte-compile-active-blocks nil)
+
 (defun byte-compile-catch (form)
-  (byte-compile-form (car (cdr form)))
-  (byte-compile-push-constant
-    (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect))
-  (byte-compile-out 'byte-catch 0))
-
-;; `return-from' and `block' are different from `throw' and `catch' when it
-;; comes to scope and extent. These differences are implemented for
-;; interpreted code in cl-macs.el, in compiled code in bytecomp.el. There's
-;; a certain amount of bootstrapping needed for the latter, and until this
-;; is done return-from and block behave as throw and catch in their scope
-;; and extent. This is only relevant to people working on bytecomp.el.
-
-(defalias 'return-from-1 'throw)
-(defalias 'block-1 'catch)
-
-(defvar byte-compile-active-blocks nil)
-
-(defun byte-compile-block-1 (form)
-  (let* ((name (nth 1 (nth 1 form)))
-	 (elt (list name (copy-symbol name) nil))
-	 (byte-compile-active-blocks (cons elt byte-compile-active-blocks))
-	 (body (byte-compile-top-level (cons 'progn (cddr form)))))
-    (if (nth 2 elt)
-	(byte-compile-catch `(catch ',(nth 1 elt) ,body))
-      (byte-compile-form body))))
-
-(defun byte-compile-return-from-1 (form)
-  (let* ((name (nth 1 (nth 1 form)))
-	 (assq (assq name byte-compile-active-blocks)))
-    (if assq
-	(setf (nth 2 assq) t)
-      (byte-compile-warn
-       "return-from: %S: no current lexical block with this name"
-       name))
-    (byte-compile-throw
-     `(throw ',(or (nth 1 assq) (copy-symbol name))
-             ,@(nthcdr 2 form)))))
+  "Byte-compile and return a `catch' from.
+
+If FORM is the result of macroexpanding a `block' form (the TAG argument is
+a quoted symbol with a non-nil `cl-block-name' property) and there is no
+corresponding `return-from' within the block--or equivalently, it was
+optimized away--just byte compile and return the BODY."
+  (let* ((symbol (car-safe (cdr-safe (nth 1 form))))
+	 (block (and symbol (symbolp symbol) (get symbol 'cl-block-name)))
+	 (elt (and block (cons block nil)))
+	 (byte-compile-active-blocks
+	  (if block
+	      (cons elt byte-compile-active-blocks)
+	    byte-compile-active-blocks))
+	 (body
+	  (byte-compile-top-level (cons 'progn (cddr form))
+				  (if block nil for-effect))))
+    (if (and block (not (cdr elt)))
+	;; A lexical block without any contained return-from clauses:
+	(byte-compile-form body)
+      ;; A normal catch call, or a lexical block with a contained
+      ;; return-from clause.
+      (byte-compile-form (car (cdr form)))
+      (byte-compile-push-constant body)
+      (byte-compile-out 'byte-catch 0))))
 
 (defun byte-compile-unwind-protect (form)
   (byte-compile-push-constant
@@ -4383,6 +4366,12 @@
         (byte-compile-normal-call
          `(signal 'wrong-number-of-arguments '(,(car form)
                                                ,(length (cdr form))))))
+    ;; If this form was macroexpanded from `return-from', mark the
+    ;; corresponding block as having been referenced.
+    (let* ((symbol (car-safe (cdr-safe (nth 1 form))))
+	   (block (and symbol (symbolp symbol) (get symbol 'cl-block-name)))
+	   (assq (and block (assq block byte-compile-active-blocks))))
+      (and assq (setcdr assq t)))
     (byte-compile-form (nth 1 form))  ;; Push the arguments
     (byte-compile-form (nth 2 form))
     (byte-compile-out (get (car form) 'byte-opcode) 0)

--- a/lisp/cl-macs.el	Thu Feb 10 08:46:10 2011 +0000
+++ b/lisp/cl-macs.el	Sat Feb 12 14:07:38 2011 +0000
@@ -747,6 +747,9 @@
   (let ((cl-active-block-names (acons name (copy-symbol name)
 				      cl-active-block-names))
 	(body (cons 'progn body)))
+    ;; Tell the byte-compiler this is a block, not a normal catch call, and
+    ;; as such it can eliminate it if that's appropriate:
+    (put (cdar cl-active-block-names) 'cl-block-name name)
     `(catch ',(cdar cl-active-block-names)
       ,(cl-macroexpand-all body cl-macro-environment))))
 
@@ -763,8 +766,13 @@
 returning RESULT from that form (or nil if RESULT is omitted).
 This is compatible with Common Lisp, but note that `defun' and
 `defmacro' do not create implicit blocks as they do in Common Lisp."
-  `(throw ',(or (cdr (assq name cl-active-block-names)) (copy-symbol name))
-	  ,result))
+  `(throw ',(or (cdr (assq name cl-active-block-names))
+		(prog1 (copy-symbol name)
+		  (and-fboundp 'byte-compile-warn (cl-compiling-file)
+			       (byte-compile-warn
+				"return-from: no enclosing block named `%s'"
+				name))))
+	 ,result))
 
 ;;; The "loop" macro.