diff --git a/src/CHANGELOG b/src/CHANGELOG
index 0c59253b3..ecf61ddb9 100644
--- a/src/CHANGELOG
+++ b/src/CHANGELOG
@@ -6,23 +6,24 @@ ECL 0.9l-p1:
  - The compiler now signals compiler-error, compiler-warning and compiler-note
    for errors, warnings and notes, respectively.
 
- - WITH-COMPILATION-UNIT allows the user to set up handlers for different
-   compiler conditions, including errors, warnings and simple notes. The
-   recommended procedure is to use HANDLER-BIND and _NOT_ to transfer control
-   out of the handler, but to defer to the default ones.
+ - ECL allows the user to set up handlers for different compiler conditions,
+   including errors, warnings and simple notes. The recommended procedure is to
+   use HANDLER-BIND and _NOT_ to transfer control out of the compilation
+   environment, but to defer to the default handlers or use the restarts ABORT
+   and MUFFLE-WARNING.
+
 	(use-package :c)
-	(let ((warnings nil))
-	  (with-compilation-unit ()
-	    (handler-bind ((compiler-error #'(lambda (c)
-					       (push c warnings)
-					       (abort)))
-			   (compiler-message #'(lambda (c)
-						 (push c warnings)
-						 (muffle-warning))))
-	      (let ((*compile-verbose* nil))
-		(compile-file "foo.lsp"))))
+	(let ((messages nil))
+	  (handler-bind ((compiler-error #'(lambda (c)
+					     (push c messages)
+					     (abort c)))
+			 (compiler-message #'(lambda (c)
+					       (push c messages)
+					       (muffle-warning))))
+	    (let ((*compile-verbose* nil))
+	      (compile-file "foo.lsp")))
 	  (format t "~&;;; Printing compiler messages")
-	  (loop for m in (nreverse warnings)
+	  (loop for m in (nreverse messages)
 	     for i from 0
 	     do (format t "~&~@<;;; ~@;Message #~D~%~A~:>" i m)))
 
diff --git a/src/cmp/cmpdefs.lsp b/src/cmp/cmpdefs.lsp
index 8b456f18a..bcc533fa2 100644
--- a/src/cmp/cmpdefs.lsp
+++ b/src/cmp/cmpdefs.lsp
@@ -259,7 +259,6 @@
 (defvar *current-form* '|compiler preprocess|)
 (defvar *compile-file-position* nil)
 (defvar *first-error* t)
-(defvar *error-p* nil)
 (defconstant *cmperr-tag* (cons nil nil))
 
 (defvar *active-handlers* nil)
diff --git a/src/cmp/cmpenv.lsp b/src/cmp/cmpenv.lsp
index eeafca6ba..9eaa1d875 100644
--- a/src/cmp/cmpenv.lsp
+++ b/src/cmp/cmpenv.lsp
@@ -19,7 +19,8 @@
 ;;; included in the compiled code.  The default value is OFF.
 
 (defconstant +init-env-form+
-  '((*compiler-phase* 't1)
+  '((*compiler-in-use* t)
+    (*compiler-phase* 't1)
     (*callbacks* nil)
     (*max-stack* 0)
     (*max-temp* 0)
@@ -44,7 +45,8 @@
     (*clines-string-list* '())
     (*inline-functions* nil)
     (*inline-blocks* 0)
-    (*notinline* nil)))
+    (*notinline* nil)
+    (*debugger-hook* 'compiler-debugger)))
 
 (defun next-lcl () (list 'LCL (incf *lcl*)))
 
diff --git a/src/cmp/cmpmain.lsp b/src/cmp/cmpmain.lsp
index 7b5af0964..b58ce25f9 100644
--- a/src/cmp/cmpmain.lsp
+++ b/src/cmp/cmpmain.lsp
@@ -20,7 +20,7 @@
   `(progn ,@body))
 
 (defun safe-system (string)
-  (cmpnote "Invoking external command:~%;;; ~A" string)
+  (cmpnote "Invoking external command:~%  ~A" string)
   (let ((result (si:system string)))
     (unless (zerop result)
       (cerror "Continues anyway."
@@ -63,7 +63,8 @@
 	 (cmpprogress "~%Postponing deletion of ~A" file)
 	 (push file *files-to-be-deleted*))
 	(t
-	 (delete-file file))))
+	 (and (probe-file file)
+	      (delete-file file)))))
 
 (push #'(lambda () (mapc #'delete-file *files-to-be-deleted*))
       si::*exit-hooks*)
@@ -504,19 +505,10 @@ static cl_object VV[VM];
   (when (and system-p load)
     (error "Cannot load system files."))
 
-  (when *compiler-in-use*
-    (format t "~&;;; The compiler was called recursively.~%~
-Cannot compile ~a."
-	    (namestring input-pathname))
-    (setq *error-p* t)
-    (return-from compile-file (values nil t t)))
-
-  (setq *error-p* nil
-	*compiler-in-use* t)
-
   (cmpprogress "~&;;; Compiling ~a." (namestring input-pathname))
 
   (let* ((eof '(NIL))
+	 (*compiler-in-use* *compiler-in-use*)
 	 (*load-time-values* nil) ;; Load time values are compiled
 	 (o-pathname (or #+dlopen (and system-p output-file)
 			 #-dlopen output-file
@@ -527,9 +519,10 @@ Cannot compile ~a."
          (h-pathname (get-output-pathname o-pathname h-file :h))
          (data-pathname (get-output-pathname o-pathname data-file :data))
 	 (shared-data-pathname (get-output-pathname o-pathname shared-data-file
-						    :sdata)))
+						    :sdata))
+	 (compiler-conditions nil))
 
-    (with-compiler-env (*error-p*)
+    (with-compiler-env (compiler-conditions)
 
       (print-compiler-info)
 
@@ -552,62 +545,50 @@ Cannot compile ~a."
 	  (t1expr form)
 	  (incf (cdr ext:*source-location*))))
 
-      (unless *error-p*
-	(cmpprogress "~&;;; End of Pass 1.")
-	(setf init-name (guess-init-name output-file :kind
-					 (if system-p :object :fasl)))
-	(compiler-pass2 c-pathname h-pathname data-pathname system-p
-			init-name
-			shared-data-file))
-
+      (cmpprogress "~&;;; End of Pass 1.")
+      (setf init-name (guess-init-name output-file :kind
+				       (if system-p :object :fasl)))
+      (compiler-pass2 c-pathname h-pathname data-pathname system-p
+		      init-name
+		      shared-data-file)
+    
       (if shared-data-file
 	  (data-dump shared-data-pathname t)
 	  (data-dump data-pathname))
+      
+      (when output-file
+	(compiler-cc c-pathname o-pathname)
+	#+dlopen
+	(unless system-p (bundle-cc (si::coerce-to-filename so-pathname)
+				    init-name
+				    (si::coerce-to-filename o-pathname)))
+	(unless (if system-p
+		    (probe-file o-pathname)
+		    (probe-file so-pathname))
+	  (cmperr "The C compiler failed to compile the intermediate file.")))
+      (cmpprogress "~&;;; Finished compiling ~a.~%" (namestring input-pathname))
+      
+      ) ; with-compiler-env
 
-      (if (null *error-p*)
-	  (progn
-	    (cond (output-file
-		   (compiler-cc c-pathname o-pathname)
-		   #+dlopen
-		   (unless system-p (bundle-cc (si::coerce-to-filename so-pathname)
-					       init-name
-					       (si::coerce-to-filename o-pathname)))
-		   (cond #+dlopen
-			 ((and (not system-p) (probe-file so-pathname))
-			  (when load (load so-pathname))
-			  (cmpprogress "~&;;; Finished compiling ~a.~%"
-				       (namestring input-pathname)))
-			 ((and system-p (probe-file o-pathname))
-			  (cmpprogress "~&;;; Finished compiling ~a.~%"
-				       (namestring input-pathname)))
-			 (t
-			  (cmpprogress "~&;;; The C compiler failed to compile the intermediate file.~%")
-			  (setq *error-p* t))))
-		  (*compile-verbose*
-		   (cmpprogress "~&;;; Finished compiling ~a.~%"
-				(namestring input-pathname))))
-	    (unless c-file (cmp-delete-file c-pathname))
-	    (unless h-file (cmp-delete-file h-pathname))
-	    (unless (or data-file shared-data-file)
-	      (cmp-delete-file data-pathname))
-	    #+dlopen
-	    (unless system-p (cmp-delete-file o-pathname))
-	    (values (truename #+dlopen (if system-p o-pathname so-pathname)
-			      #-dlopen o-pathname)
-		    nil nil))
-	  (progn
-	    (when (probe-file c-pathname) (cmp-delete-file c-pathname))
-	    (when (probe-file h-pathname) (cmp-delete-file h-pathname))
-	    (when (probe-file data-pathname) (cmp-delete-file data-pathname))
-	    (when (probe-file shared-data-pathname) (cmp-delete-file shared-data-pathname))
-	    (when (probe-file o-pathname) (cmp-delete-file o-pathname))
-	    (cmpprogress "~&;;; Due to errors in the compilation process, no FASL was generated.
-;;; Search above for the \"Error:\" tag to find the error messages.~%")
-	    (setq *error-p* t)
-	    (values nil t t))
-	  ))
-    )
-)
+    (unless c-file (cmp-delete-file c-pathname))
+    (unless h-file (cmp-delete-file h-pathname))
+    (unless (or data-file shared-data-file)
+      (cmp-delete-file data-pathname))
+    #+dlopen
+    (unless system-p (cmp-delete-file o-pathname))
+    (compiler-output-values (truename #+dlopen (if system-p o-pathname so-pathname)
+				      #-dlopen o-pathname)
+			    compiler-conditions)))
+
+(defun compiler-output-values (main-value conditions)
+  (loop for i in conditions
+     with warning-p = nil
+     with failure-p = nil
+     do (cond ((typep i 'style-warning)
+	       (setf warning-p t))
+	      ((typep i '(or error warning))
+	       (setf warning-p t failure-p t)))
+     finally (return (values (and (not failure-p) main-value) warning-p failure-p))))
 
 #-dlopen
 (defun compile (name &optional (def nil supplied-p))
@@ -634,15 +615,6 @@ Cannot compile ~a."
 
   (unless (symbolp name) (error "~s is not a symbol." name))
 
-  (when *compiler-in-use*
-    (format t "~&;;; The compiler was called recursively.~
-		~%Cannot compile ~s." name)
-    (setq *error-p* t)
-    (return-from compile (values name nil t)))
-
-  (setq *error-p* nil
-	*compiler-in-use* t)
-
   (cond ((and supplied-p def)
 	 (when (functionp def)
 	   (unless (function-lambda-expression def)
@@ -664,63 +636,63 @@ Cannot compile ~a."
 
   (let ((template (format nil "TMP:ECL~3,'0x" (incf *gazonk-counter*))))
     (unless (setq data-pathname (si::mkstemp template))
-      (format t "~&;;; Unable to create temporay file~%~
-;;;	~AXXXXXX
-;;; Make sure you have enough free space in disk, check permissions or set~%~
-;;; the environment variable TMPDIR to a different value." template)
-      (setq *error-p* t)
+      (error "Unable to create temporay file~%~
+	~AXXXXXX
+Make sure you have enough free space in disk, check permissions or set~%~
+the environment variable TMPDIR to a different value." template)
       (return-from compile (values nil t t))))
 
   (let*((*load-time-values* 'values) ;; Only the value is kept
+	(template (format nil "TMP:ECL~3,'0x" (incf *gazonk-counter*)))
+	(data-pathname (or (si::mkstemp template) "foo"))
 	(c-pathname (compile-file-pathname data-pathname :type :c))
 	(h-pathname (compile-file-pathname data-pathname :type :h))
 	(o-pathname (compile-file-pathname data-pathname :type :object))
 	(so-pathname (compile-file-pathname data-pathname))
-	(init-name (guess-init-name so-pathname :kind :fasl)))
+	(init-name (guess-init-name so-pathname :kind :fasl))
+	(compiler-conditions nil))
 
-    (with-compiler-env (*error-p*)
+    (with-compiler-env (compiler-conditions)
       (print-compiler-info)
       (data-init)
       (t1expr form)
-      (unless *error-p*
-	(cmpprogress "~&;;; End of Pass 1.")
-	(let (#+(or mingw32 msvc cygwin)(*self-destructing-fasl* t))
-	  (compiler-pass2 c-pathname h-pathname data-pathname nil
-			  init-name nil)))
+      (cmpprogress "~&;;; End of Pass 1.")
+      (let (#+(or mingw32 msvc cygwin)(*self-destructing-fasl* t))
+	(compiler-pass2 c-pathname h-pathname data-pathname nil
+			init-name nil))
       (setf *compiler-constants* (data-dump data-pathname))
 
-      (if (null *error-p*)
-	  (progn
-	    (compiler-cc c-pathname o-pathname)
-	    (bundle-cc (si::coerce-to-filename so-pathname)
-		       init-name
-		       (si::coerce-to-filename o-pathname))
-	    (cmp-delete-file c-pathname)
-	    (cmp-delete-file h-pathname)
-	    (cmp-delete-file o-pathname)
-	    (cmp-delete-file data-pathname)
-	    (cond ((probe-file so-pathname)
-		   (load so-pathname :verbose nil)
-		   #-(or mingw32 msvc cygwin)(cmp-delete-file so-pathname)
-		   #+msvc (delete-msvc-generated-files so-pathname)
-		   (setf name (or name (symbol-value 'GAZONK)))
-		   ;; By unsetting GAZONK we avoid spurious references to the
-		   ;; loaded code.
-		   (set 'GAZONK nil)
-		   (si::gc t)
-		   (values name nil nil))
-		  (t (cmpprogress "~&;;; The C compiler failed to compile the intermediate code for ~s.~%" name)
-		     (setq *error-p* t)
-		     (values name t t))))
-	  (progn
-	    (when (probe-file c-pathname) (cmp-delete-file c-pathname))
-	    (when (probe-file h-pathname) (cmp-delete-file h-pathname))
-	    (when (probe-file so-pathname) (cmp-delete-file so-pathname))
-	    (when (probe-file data-pathname) (cmp-delete-file data-pathname))
-	    #+msvc (delete-msvc-generated-files so-pathname)
-	    (cmpprogress "~&;;; Failed to compile ~s.~%" name)
-	    (setq *error-p* t)
-	    (values name t t))))))
+      (compiler-cc c-pathname o-pathname)
+      (bundle-cc (si::coerce-to-filename so-pathname)
+		 init-name
+		 (si::coerce-to-filename o-pathname))
+      (cmp-delete-file c-pathname)
+      (cmp-delete-file h-pathname)
+      (cmp-delete-file o-pathname)
+      (cmp-delete-file data-pathname)
+      (cond ((probe-file so-pathname)
+	     (load so-pathname :verbose nil)
+	     #-(or mingw32 msvc cygwin)
+	     (cmp-delete-file so-pathname)
+	     #+msvc
+	     (delete-msvc-generated-files so-pathname)
+	     (setf name (or name (symbol-value 'GAZONK)))
+	     ;; By unsetting GAZONK we avoid spurious references to the
+	     ;; loaded code.
+	     (set 'GAZONK nil)
+	     (si::gc t)
+	     (values name nil nil))
+	    (t
+	     (cmperr "The C compiler failed to compile the intermediate code for ~s." name)))
+      ) ; with-compiler-env
+
+    (when (probe-file c-pathname) (cmp-delete-file c-pathname))
+    (when (probe-file h-pathname) (cmp-delete-file h-pathname))
+    (when (probe-file so-pathname) (cmp-delete-file so-pathname))
+    (when (probe-file data-pathname) (cmp-delete-file data-pathname))
+    #+msvc
+    (delete-msvc-generated-files so-pathname)
+    (compiler-output-values name compiler-conditions)))
 
 (defun disassemble (thing &key (h-file nil) (data-file nil)
 		    &aux def disassembled-form
@@ -749,20 +721,15 @@ Cannot compile ~a."
 		:expected-type '(OR FUNCTION (SATISFIES SI:VALID-FUNCTION-NAME-P))
 		:format-control "DISASSEMBLE cannot accept ~A"
 		:format-arguments (list thing))))
-  (when *compiler-in-use*
-    (cmpprogress "~&;;; The compiler was called recursively.~%Cannot disassemble ~a." thing)
-    (setq *error-p* t)
-    (return-from disassemble nil))
-  (setq *error-p* nil
-	*compiler-in-use* t)
 
   (let* ((null-stream (make-broadcast-stream))
          (*compiler-output1* null-stream)
          (*compiler-output2* (if h-file
 				 (open h-file :direction :output)
 				 null-stream))
-         (t3local-fun (symbol-function 'T3LOCAL-FUN)))
-    (with-compiler-env (*error-p*)
+         (t3local-fun (symbol-function 'T3LOCAL-FUN))
+	 (compiler-conditions nil))
+    (with-compiler-env (compiler-conditions)
       (unwind-protect
 	   (progn
 	     (setf (symbol-function 'T3LOCAL-FUN)
@@ -771,15 +738,13 @@ Cannot compile ~a."
 			 (apply t3local-fun args))))
 	     (data-init)
 	     (t1expr disassembled-form)
-	     (unless *error-p*
-	       (ctop-write (guess-init-name "foo" :kind :fasl)
-			   (if h-file h-file "")
-			   (if data-file data-file "")))
+	     (ctop-write (guess-init-name "foo" :kind :fasl)
+			 (if h-file h-file "")
+			 (if data-file data-file ""))
 	     (data-dump data-file))
 	(setf (symbol-function 'T3LOCAL-FUN) t3local-fun)
 	(when h-file (close *compiler-output2*)))))
-  nil
-  )
+  nil)
 
 (defun compiler-pass2 (c-pathname h-pathname data-pathname system-p init-name
 		       shared-data)
diff --git a/src/cmp/cmputil.lsp b/src/cmp/cmputil.lsp
index ad671e4d1..37f958c79 100644
--- a/src/cmp/cmputil.lsp
+++ b/src/cmp/cmputil.lsp
@@ -14,22 +14,39 @@
 
 (in-package "COMPILER")
 
-(define-condition compiler-message (condition)
-  ((file :initarg :file :initform *compile-file-pathname*
+(define-condition compiler-message (simple-condition)
+  ((prefix :initform "Note" :accessor compiler-message-prefix)
+   (file :initarg :file :initform *compile-file-pathname*
 	 :accessor compiler-message-file)
    (position :initarg :file :initform *compile-file-position*
 	     :accessor compiler-message-file-position)
-   (form :initarg :form :initform *current-form* :accessor compiler-message-form)))
+   (form :initarg :form :initform *current-form* :accessor compiler-message-form))
+  (:REPORT
+   (lambda (c stream)
+     (let ((position (compiler-message-file-position c)))
+       (if position
+	   (let ((*print-length* 3)
+		 (*print-level* 2))
+	     (format stream "~A: in file ~A, position ~D, and form ~%  ~A~%"
+		     (compiler-message-prefix c)
+		     (compiler-message-file c) position (compiler-message-form c)))
+	   (format stream "~A: " (compiler-message-prefix c)))
+       (format stream "~?"
+	       (simple-condition-format-control c)
+	       (simple-condition-format-arguments c))))))
 
-(define-condition compiler-note (compiler-message simple-condition warning) ())
+(define-condition compiler-note (compiler-message) ())
 
-(define-condition compiler-warning (compiler-message simple-condition style-warning) ())
+(define-condition compiler-warning (compiler-message simple-condition style-warning)
+  ((prefix :initform "Warning")))
 
-(define-condition compiler-error (compiler-message simple-error) ())
+(define-condition compiler-error (compiler-message simple-error)
+  ((prefix :initform "Error")))
 
 (define-condition compiler-fatal-error (compiler-error) ())
 
-(define-condition compiler-internal-error (compiler-fatal-error) ())
+(define-condition compiler-internal-error (compiler-fatal-error)
+  ((prefix :initform "Internal error")))
 
 (define-condition compiler-undefined-variable (compiler-message warning)
   ((variable :initarg :name :initform nil))
@@ -38,38 +55,31 @@
      (format stream "Variable ~A was undefined. Compiler assumes it is a global."
 	     (slot-value condition 'variable)))))
 
-(defun handle-fatal-error (c)
-  (push c *compiler-conditions*)
-  (abort))
-
-(defun print-compiler-message (c stream &optional (header "Error"))
-  (let ((position (compiler-message-file-position c)))
-    (if position
-	(let ((*print-length* 3)
-	      (*print-level* 2))
-	  (format stream "~&;;; ~A: in file ~A, position ~D, and form ~%;;;   ~A~%~@<;;; ~@;~A~:>"
-		  header (compiler-message-file c)
-		  position (compiler-message-form c) c))
-	(format stream "~&~@<;;; ~@;~A: ~A~:>" header c))))
+(defun print-compiler-message (c stream)
+  (format stream "~&~@<;;; ~@;~A~:>" c))
 
 (defun handle-note (c)
-  (unless *suppress-compiler-notes*
-    (print-compiler-message c t "Note")))
+  nil)
 
 (defun handle-warning (c)
   (push c *compiler-conditions*)
-  (unless *suppress-compiler-warnings*
-    (print-compiler-message c t "Warning")))
+  nil)
 
 (defun handle-error (c)
   (push c *compiler-conditions*)
-  (print-compiler-message c t)
-  (invoke-restart (find-restart-never-fail 'abort-form c)))
+  nil)
+
+(defun handle-internal-error (c)
+  (unless (typep c 'compiler-error)
+    (signal 'compiler-internal-error
+	    :format-control "~A"
+	    :format-arguments (list c))
+    (print-compiler-message c t)
+    (abort)))
 
 (defun do-compilation-unit (closure &key override)
   (cond (override
-	 (let* ((*active-handlers* nil)
-		(*active-protection* nil))
+	 (let* ((*active-protection* nil))
 	   (do-compilation-unit closure)))
 	((null *active-protection*)
 	 (let* ((*active-protection* t)
@@ -77,27 +87,33 @@
 	   (unwind-protect (do-compilation-unit closure)
 	     (loop for action in *pending-actions*
 		do (funcall action)))))
-	((null *active-handlers*)
-	 (let ((*active-handlers* t))
-	   (handler-bind ((compiler-note #'handle-note)
-			  (compiler-warning #'handle-warning)
-			  (compiler-error #'handle-error)
-			  (compiler-fatal-error #'handle-fatal-error))
-	     (funcall closure))))
 	(t
 	 (funcall closure))))
 
 (defmacro with-compilation-unit ((&rest options) &body body)
  `(do-compilation-unit #'(lambda () ,@body) ,@options))
 
-(defmacro with-compiler-env ((error-flag) &body body)
-  `(with-lock (+load-compile-lock+)
+(defun compiler-debugger (condition old-hook)
+  (when *compiler-break-enable*
+    (si::default-debugger condition))
+  (abort))
+
+(defmacro with-compiler-env ((compiler-conditions) &body body)
+  `(let ((*compiler-conditions* nil))
+     (declare (special *compiler-conditions*))
      (restart-case
-	 (let ,+init-env-form+
-	   (setf ,error-flag nil)
-	   (with-compilation-unit ()
-	     ,@body))
-       (abort (c) (setf ,error-flag t)))))
+	 (handler-bind ((compiler-note #'handle-note)
+			(warning #'handle-warning)
+			(compiler-error #'handle-error))
+	   (handler-bind ((error #'handle-internal-error))
+	     (if *compiler-in-use*
+		 (error "The compiler was called recursively.")
+		 (with-lock (+load-compile-lock+)
+		   (let ,+init-env-form+
+		     (with-compilation-unit ()
+		     ,@body))))))
+       (abort ()))
+     (setf ,compiler-conditions *compiler-conditions*)))
 
 (defvar *c1form-level* 0)
 (defun print-c1forms (form)
@@ -126,7 +142,9 @@
 (defun cmperr (string &rest args)
   (signal 'compiler-error
 	  :format-control string
-	  :format-arguments args))
+	  :format-arguments args)
+  (print-compiler-message c t)
+  (abort))
 
 (defun check-args-number (operator args &optional (min 0) (max nil))
   (let ((l (length args)))
@@ -147,21 +165,23 @@
           lower-bound
           n))
 
-(defun do-cmpwarn (&rest args)
+(defun do-cmpwarn (suppress &rest args)
   (declare (si::c-local))
   (let ((condition (apply #'make-condition args)))
     (restart-case (signal condition)
       (muffle-warning ()
 	:REPORT "Skip warning"
-	(return-from do-cmpwarn nil)))))
+	(return-from do-cmpwarn nil)))
+    (unless suppress
+      (print-compiler-message condition t))))
 
 (defun cmpwarn (string &rest args)
-  (do-cmpwarn 'compiler-warning
+  (do-cmpwarn *suppress-compiler-warnings* 'compiler-warning
     :format-control string
     :format-arguments args))
 
 (defun cmpnote (string &rest args)
-  (do-cmpwarn 'compiler-note
+  (do-cmpwarn *suppress-compiler-notes* 'compiler-note
     :format-control string
     :format-arguments args))
 
@@ -180,7 +200,8 @@
       (format t "~&;;; Emitting code for ~s.~%" name))))
 
 (defun undefined-variable (sym)
-  (do-cmpwarn 'compiler-undefined-variable :name sym))
+  (do-cmpwarn *suppress-compiler-warnings*
+    'compiler-undefined-variable :name sym))
   
 (defun baboon (&aux (*print-case* :upcase))
   (signal 'compiler-internal-error