X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=9c8597a350c5a941f12f671d247ce16cb906bfa4;hb=94cc1963322581d9e4b6bbd96c399a0507c601be;hp=49d1b70a95421fba9f5bf7dc0a26d1357594d7c4;hpb=2d4a0df3457bcd50916b33d374da592d8776db0a;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 49d1b70..9c8597a 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -158,6 +158,12 @@
 		  (incf *aborted-compilation-unit-count*))
 		(summarize-compilation-unit (not succeeded-p)))))))))
 
+;;; Is FUN-NAME something that no conforming program can rely on
+;;; defining as a function?
+(defun fun-name-reserved-by-ansi-p (fun-name)
+  (eq (symbol-package (fun-name-block-name fun-name))
+      *cl-package*))
+
 ;;; This is to be called at the end of a compilation unit. It signals
 ;;; any residual warnings about unknown stuff, then prints the total
 ;;; error counts. ABORT-P should be true when the compilation unit was
@@ -181,11 +187,24 @@
 		(undefined-warning-count (undefined-warning-count undef)))
 	    (dolist (*compiler-error-context* warnings)
               (if #-sb-xc-host (and (eq kind :function)
-                                    (symbolp name) ; FIXME: (SETF CL:fo)
-                                    (eq (symbol-package name) *cl-package*)
+				    (fun-name-reserved-by-ansi-p name)
                                     *flame-on-necessarily-undefined-function*)
                   #+sb-xc-host nil
-                  (compiler-warn "undefined ~(~A~): ~S" kind name)
+		  (case name
+		    ((declare)
+		     (compiler-warn
+		      "~@<There is no function named ~S. References to ~S in ~
+                       some contexts (like starts of blocks) have special ~
+                       meaning, but here it would have to be a function, ~
+                       and that shouldn't be right.~:@>"
+		      name name))
+		    (t
+		     (compiler-warn
+		      "~@<The ~(~A~) ~S is undefined, and its name is ~
+                       reserved by ANSI CL so that even if it it were ~
+                       defined later, the code doing so would not be ~
+                       portable.~:@>"
+		      kind name)))
                   (compiler-style-warn "undefined ~(~A~): ~S" kind name)))
 	    (let ((warn-count (length warnings)))
 	      (when (and warnings (> undefined-warning-count warn-count))
@@ -426,6 +445,7 @@
 	  (multiple-value-bind (code-length trace-table fixups)
 	      (generate-code component)
 
+            #-sb-xc-host
 	    (when *compiler-trace-output*
 	      (format *compiler-trace-output*
 		      "~|~%disassembly of code for ~S~2%" component)
@@ -611,7 +631,7 @@
 (defun describe-component (component *standard-output*)
   (declare (type component component))
   (format t "~|~%;;;; component: ~S~2%" (component-name component))
-  (print-blocks component)
+  (print-all-blocks component)
   (values))
 
 (defun describe-ir2-component (component *standard-output*)
@@ -815,9 +835,11 @@
 ;;; We parse declarations and then recursively process the body.
 (defun process-toplevel-locally (body path compile-time-too &key vars funs)
   (declare (list path))
-  (multiple-value-bind (forms decls) (parse-body body nil)
-    (let* ((*lexenv*
-	    (process-decls decls vars funs (make-continuation)))
+  (multiple-value-bind (forms decls)
+      (parse-body body :doc-string-allowed nil :toplevel t)
+    (let* ((*lexenv* (process-decls decls vars funs))
+           ;; FIXME: VALUES declaration
+           ;;
 	   ;; Binding *POLICY* is pretty much of a hack, since it
 	   ;; causes LOCALLY to "capture" enclosed proclamations. It
 	   ;; is necessary because CONVERT-AND-MAYBE-COMPILE uses the
@@ -1153,7 +1175,8 @@
                          (declare (ignore funs))
                          (process-toplevel-locally body
                                                    path
-                                                   compile-time-too))))
+                                                   compile-time-too))
+                       :compile))
                      ((symbol-macrolet)
                       (funcall-in-symbol-macrolet-lexenv
                        magic
@@ -1161,7 +1184,8 @@
                          (process-toplevel-locally body
                                                    path
                                                    compile-time-too
-                                                   :vars vars)))))))
+                                                   :vars vars))
+                       :compile)))))
                 ((locally)
                  (process-toplevel-locally (rest form) path compile-time-too))
                 ((progn)