0.8.3.3:

[sbcl.git] / src / compiler / main.lisp

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 77567cc..9c8597a 100644 (file)
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -28,7 +28,7 @@
                  #!+sb-show *compiler-trace-output*
                  *last-source-context* *last-original-source*
                  *last-source-form* *last-format-string* *last-format-args*
-                 *last-message-count* *lexenv*))
+                 *last-message-count* *lexenv* *fun-names-in-this-file*))
 
 ;;; Whether call of a function which cannot be defined causes a full
 ;;; warning.
@@ -139,9 +139,6 @@
             (multiple-value-prog1 (funcall fn) (setf succeeded-p t))
          (unless succeeded-p
            (incf *aborted-compilation-unit-count*)))
-       ;; FIXME: Now *COMPILER-FOO-COUNT* stuff is bound in more than
-       ;; one place. If we can get rid of the IR1 interpreter, this
-       ;; should be easier to clean up.
        (let ((*aborted-compilation-unit-count* 0)
              (*compiler-error-count* 0)
              (*compiler-warning-count* 0)
@@ -161,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
@@ -184,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))
@@ -429,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)
@@ -614,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*)
@@ -818,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
@@ -1156,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
@@ -1164,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)
@@ -1329,6 +1350,7 @@
         (sb!xc:*compile-file-pathname* nil)
         (sb!xc:*compile-file-truename* nil)
         (*toplevel-lambdas* ())
+        (*fun-names-in-this-file* ())
         (*compiler-error-bailout*
          (lambda ()
            (compiler-mumble "~2&; fatal error, aborting compilation~%")