--- a/lisp/cl-macs.el	Sat Jan 22 00:59:20 2011 +0100
+++ b/lisp/cl-macs.el	Mon Feb 07 21:22:17 2011 +0100
@@ -730,6 +730,7 @@
 
 
 ;;; Blocks and exits.
+(defvar cl-active-block-names nil)
 
 ;;;###autoload
 (defmacro block (name &rest body)
@@ -739,45 +740,19 @@
 in two respects:  First, the NAME is an unevaluated symbol rather than a
 quoted symbol or other form; and second, NAME is lexically rather than
 dynamically scoped:  Only references to it within BODY will work.  These
-references may appear inside macro expansions, but not inside functions
-called from BODY."
-  (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body)
-    (list 'cl-block-wrapper
-	  (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name)))
-		 body))))
-
-(defvar cl-active-block-names nil)
-
-(put 'cl-block-wrapper 'byte-compile
-     #'(lambda (cl-form)
-         (if (/= (length cl-form) 2)
-             (byte-compile-warn-wrong-args cl-form 1))
-
-         (if (fboundp 'byte-compile-form-do-effect)  ; Check for optimizing
-						     ; compiler
-             (progn
-               (let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil))
-                      (cl-active-block-names (cons cl-entry
-                                                   cl-active-block-names))
-                      (cl-body (byte-compile-top-level
-                                (cons 'progn (cddr (nth 1 cl-form))))))
-                 (if (cdr cl-entry)
-                     (byte-compile-form (list 'catch (nth 1 (nth 1 cl-form))
-                                              cl-body))
-                   (byte-compile-form cl-body))))
-           (byte-compile-form (nth 1 cl-form)))))
-
-(put 'cl-block-throw 'byte-compile
-     #'(lambda (cl-form)
-         (let ((cl-found (assq (nth 1 (nth 1 cl-form)) cl-active-block-names)))
-           (if cl-found (setcdr cl-found t)))
-         (byte-compile-throw (cons 'throw (cdr cl-form)))))
+references may appear inside macro expansions and in lambda expressions, but
+not inside other functions called from BODY."
+  (let ((cl-active-block-names (acons name (copy-symbol name)
+				      cl-active-block-names))
+	(body (cons 'progn body)))
+    `(catch ',(cdar cl-active-block-names)
+      ,(cl-macroexpand-all body cl-macro-environment))))
 
 ;;;###autoload
 (defmacro return (&optional result)
   "Return from the block named nil.
 This is equivalent to `(return-from nil RESULT)'."
-  (list 'return-from nil result))
+  `(return-from nil ,result))
 
 ;;;###autoload
 (defmacro return-from (name &optional result)
@@ -786,9 +761,8 @@
 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."
-  (let ((name2 (intern (format "--cl-block-%s--" name))))
-    (list 'cl-block-throw (list 'quote name2) result)))
-
+  `(throw ',(or (cdr (assq name cl-active-block-names)) (copy-symbol name))
+	  ,result))
 
 ;;; The "loop" macro.
 
@@ -3341,42 +3315,49 @@
     form))
 
 (define-compiler-macro delete (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
-		   (characterp cl-const-expr-val)))
-	  (cons 'delete* (cdr form))
-	`(delete* ,@(cdr form) :test #'equal)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
+                       (characterp cl-const-expr-val)))
+              (cons 'delete* (cdr form))
+            `(delete* ,@(cdr form) :test #'equal))))
+    form))
 
 (define-compiler-macro delq (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (not (cl-non-fixnum-number-p cl-const-expr-val)))
-	  (cons 'delete* (cdr form))
-	`(delete* ,@(cdr form) :test #'eq)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet
+          ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (not (cl-non-fixnum-number-p cl-const-expr-val)))
+              (cons 'delete* (cdr form))
+            `(delete* ,@(cdr form) :test #'eq))))
+    form))
 
 (define-compiler-macro remove (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
-		   (characterp cl-const-expr-val)))
-	  (cons 'remove* (cdr form))
-	`(remove* ,@(cdr form) :test #'equal)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet
+          ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (or (symbolp cl-const-expr-val) (fixnump cl-const-expr-val)
+                       (characterp cl-const-expr-val)))
+              (cons 'remove* (cdr form))
+            `(remove* ,@(cdr form) :test #'equal))))
+    form))
 
 (define-compiler-macro remq (&whole form &rest args)
-  (symbol-macrolet
-      ((not-constant '#:not-constant))
-    (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
-      (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
-	       (not (cl-non-fixnum-number-p cl-const-expr-val)))
-	  (cons 'remove* (cdr form))
-	`(remove* ,@(cdr form) :test #'eq)))))
+  (if (eql 3 (length form))
+      (symbol-macrolet
+          ((not-constant '#:not-constant))
+        (let ((cl-const-expr-val (cl-const-expr-val (nth 1 form) not-constant)))
+          (if (and (cdr form) (not (eq not-constant cl-const-expr-val))
+                   (not (cl-non-fixnum-number-p cl-const-expr-val)))
+              (cons 'remove* (cdr form))
+            `(remove* ,@(cdr form) :test #'eq))))
+    form))
  
 (macrolet
     ((define-foo-if-compiler-macros (&rest alist)