X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=67ac1239581e530bc8be3bd955cc07f0d074028a;hb=0e5a40455a1a3cc16cc71ad0f0b063eb4f1f2c3f;hp=bb0ecb52702c12459f7b50686e888fc5908c27f6;hpb=28ce7a00cbce6d27b127fd6a2783325c8198a568;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index bb0ecb5..67ac123 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -91,11 +91,6 @@
 ;;; normally causes nested uses to be no-ops).
 (defvar *in-compilation-unit* nil)
 
-;;; This lock is siezed in the same situation: the compiler is not
-;;; presently thread-safe
-(defvar *big-compiler-lock*
-  (sb!thread:make-mutex :name "big compiler lock"))
-
 ;;; Count of the number of compilation units dynamically enclosed by
 ;;; the current active WITH-COMPILATION-UNIT that were unwound out of.
 (defvar *aborted-compilation-unit-count*)
@@ -205,23 +200,34 @@
                        defined later, the code doing so would not be ~
                        portable.~:@>"
 		      kind name)))
-                  (compiler-style-warn "undefined ~(~A~): ~S" kind name)))
+		  (if (eq kind :variable)
+		      (compiler-warn "undefined ~(~A~): ~S" kind name)
+		      (compiler-style-warn "undefined ~(~A~): ~S" kind name))))
 	    (let ((warn-count (length warnings)))
 	      (when (and warnings (> undefined-warning-count warn-count))
 		(let ((more (- undefined-warning-count warn-count)))
-		  (compiler-style-warn
-		   "~W more use~:P of undefined ~(~A~) ~S"
-		   more kind name))))))
+		  (if (eq kind :variable)
+		      (compiler-warn
+		       "~W more use~:P of undefined ~(~A~) ~S"
+		       more kind name)
+		      (compiler-style-warn
+		       "~W more use~:P of undefined ~(~A~) ~S"
+		       more kind name)))))))
 
 	(dolist (kind '(:variable :function :type))
 	  (let ((summary (mapcar #'undefined-warning-name
-				 (remove kind undefs :test-not #'eq
+				 (remove kind undefs :test #'neq
 					 :key #'undefined-warning-kind))))
 	    (when summary
-	      (compiler-style-warn
-	       "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
-		~%  ~{~<~%  ~1:;~S~>~^ ~}"
-	       (cdr summary) kind summary)))))))
+	      (if (eq kind :variable)
+		  (compiler-warn
+		   "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
+		    ~%  ~{~<~%  ~1:;~S~>~^ ~}"
+		   (cdr summary) kind summary)
+		  (compiler-style-warn
+		   "~:[This ~(~A~) is~;These ~(~A~)s are~] undefined:~
+		   ~%  ~{~<~%  ~1:;~S~>~^ ~}"
+		   (cdr summary) kind summary))))))))
 
   (unless (and (not abort-p)
 	       (zerop *aborted-compilation-unit-count*)
@@ -442,7 +448,7 @@
 	    (describe-ir2-component component *compiler-trace-output*))
 
 	  (maybe-mumble "code ")
-	  (multiple-value-bind (code-length trace-table fixups)
+	  (multiple-value-bind (code-length trace-table fixup-notes)
 	      (generate-code component)
 
             #-sb-xc-host
@@ -459,7 +465,7 @@
 				    *code-segment*
 				    code-length
 				    trace-table
-				    fixups
+				    fixup-notes
 				    *compile-object*))
 	      (core-object
 	       (maybe-mumble "core")
@@ -467,7 +473,7 @@
 				    *code-segment*
 				    code-length
 				    trace-table
-				    fixups
+				    fixup-notes
 				    *compile-object*))
 	      (null))))))
 
@@ -835,7 +841,8 @@
 ;;; 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)
+  (multiple-value-bind (forms decls)
+      (parse-body body :doc-string-allowed nil :toplevel t)
     (let* ((*lexenv* (process-decls decls vars funs))
            ;; FIXME: VALUES declaration
            ;;
@@ -1341,33 +1348,35 @@
 ;;; Return (VALUES NIL WARNINGS-P FAILURE-P).
 (defun sub-compile-file (info)
   (declare (type source-info info))
-  (let* ((*block-compile* *block-compile-arg*)
-	 (*package* (sane-package))
-	 (*policy* *policy*)
-	 (*lexenv* (make-null-lexenv))
-	 (*source-info* info)
-	 (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~%")
-	    (return-from sub-compile-file (values nil t t))))
-	 (*current-path* nil)
-	 (*last-source-context* nil)
-	 (*last-original-source* nil)
-	 (*last-source-form* nil)
-	 (*last-format-string* nil)
-	 (*last-format-args* nil)
-	 (*last-message-count* 0)
-	 ;; FIXME: Do we need this rebinding here? It's a literal
-	 ;; translation of the old CMU CL rebinding to
-	 ;; (OR *BACKEND-INFO-ENVIRONMENT* *INFO-ENVIRONMENT*),
-	 ;; and it's not obvious whether the rebinding to itself is
-	 ;; needed that SBCL doesn't need *BACKEND-INFO-ENVIRONMENT*.
-	 (*info-environment* *info-environment*)
-	 (*gensym-counter* 0))
+  (let ((*package* (sane-package))
+        (*readtable* *readtable*)
+        (sb!xc:*compile-file-pathname* nil) ; really bound in
+        (sb!xc:*compile-file-truename* nil) ; SUB-SUB-COMPILE-FILE
+
+        (*policy* *policy*)
+        (*lexenv* (make-null-lexenv))
+        (*block-compile* *block-compile-arg*)
+        (*source-info* info)
+        (*toplevel-lambdas* ())
+        (*fun-names-in-this-file* ())
+        (*compiler-error-bailout*
+         (lambda ()
+           (compiler-mumble "~2&; fatal error, aborting compilation~%")
+           (return-from sub-compile-file (values nil t t))))
+        (*current-path* nil)
+        (*last-source-context* nil)
+        (*last-original-source* nil)
+        (*last-source-form* nil)
+        (*last-format-string* nil)
+        (*last-format-args* nil)
+        (*last-message-count* 0)
+        ;; FIXME: Do we need this rebinding here? It's a literal
+        ;; translation of the old CMU CL rebinding to
+        ;; (OR *BACKEND-INFO-ENVIRONMENT* *INFO-ENVIRONMENT*),
+        ;; and it's not obvious whether the rebinding to itself is
+        ;; needed that SBCL doesn't need *BACKEND-INFO-ENVIRONMENT*.
+        (*info-environment* *info-environment*)
+        (*gensym-counter* 0))
     (handler-case
 	(with-compilation-values
 	 (sb!xc:with-compilation-unit ()