X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmain.lisp;h=0d6bebd8d8dfece62cd700c90b7b5f28cedc4930;hb=77c80b85dc9ae9bde0692d4193187bfca507b936;hp=6b3debf8cd5315cc16d1fc3110d725176fad023f;hpb=148e3820ad314a9b59d0133c1d60eaac4af9118b;p=sbcl.git

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 6b3debf..0d6bebd 100644
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -30,6 +30,10 @@
 		  *last-source-form* *last-format-string* *last-format-args*
 		  *last-message-count* *lexenv*))
 
+;;; Whether call of a function which cannot be defined causes a full
+;;; warning.
+(defvar *flame-on-necessarily-undefined-function* nil)
+
 (defvar *check-consistency* nil)
 (defvar *all-components*)
 
@@ -87,6 +91,11 @@
 ;;; 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*)
@@ -127,7 +136,7 @@
 	;; Inside another WITH-COMPILATION-UNIT, a WITH-COMPILATION-UNIT is
 	;; ordinarily (unless OVERRIDE) basically a no-op.
 	(unwind-protect
-	    (multiple-value-prog1 (funcall fn) (setf succeeded-p t))
+	     (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
@@ -140,16 +149,17 @@
 	      (*compiler-note-count* 0)
 	      (*undefined-warnings* nil)
 	      (*in-compilation-unit* t))
-	  (handler-bind ((parse-unknown-type
-			  (lambda (c)
-			    (note-undefined-reference
-			     (parse-unknown-type-specifier c)
-			     :type))))
-	    (unwind-protect
-		(multiple-value-prog1 (funcall fn) (setf succeeded-p t))
-	      (unless succeeded-p
-		(incf *aborted-compilation-unit-count*))
-	      (summarize-compilation-unit (not succeeded-p))))))))
+	  (sb!thread:with-recursive-lock (*big-compiler-lock*)
+	    (handler-bind ((parse-unknown-type
+			    (lambda (c)
+			      (note-undefined-reference
+			       (parse-unknown-type-specifier c)
+			       :type))))
+	      (unwind-protect
+		   (multiple-value-prog1 (funcall fn) (setf succeeded-p t))
+		(unless succeeded-p
+		  (incf *aborted-compilation-unit-count*))
+		(summarize-compilation-unit (not succeeded-p)))))))))
 
 ;;; This is to be called at the end of a compilation unit. It signals
 ;;; any residual warnings about unknown stuff, then prints the total
@@ -173,14 +183,20 @@
 		(warnings (undefined-warning-warnings undef))
 		(undefined-warning-count (undefined-warning-count undef)))
 	    (dolist (*compiler-error-context* warnings)
-	      (compiler-style-warn "undefined ~(~A~): ~S" kind name))
+              (if #-sb-xc-host (and (eq kind :function)
+                                    (symbolp name) ; FIXME: (SETF CL:fo)
+                                    (eq (symbol-package name) *cl-package*)
+                                    *flame-on-necessarily-undefined-function*)
+                  #+sb-xc-host nil
+                  (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))))))
-	
+
 	(dolist (kind '(:variable :function :type))
 	  (let ((summary (mapcar #'undefined-warning-name
 				 (remove kind undefs :test-not #'eq
@@ -871,10 +887,14 @@
     (setf (component-name component)
 	  (debug-namify "~S initial component" name))
     (setf (component-kind component) :initial)
-    (let* ((locall-fun (ir1-convert-lambda
+    (let* ((locall-fun (ir1-convert-lambdalike
                         definition
                         :debug-name (debug-namify "top level local call ~S"
-                                                  name)))
+                                                  name)
+			;; KLUDGE: we do this so that we get to have
+			;; nice debug returnness in functions defined
+			;; from the REPL
+			:allow-debug-catch-tag t))
            (fun (ir1-convert-lambda (make-xep-lambda-expression locall-fun)
 				    :source-name (or name '.anonymous.)
 				    :debug-name (unless name
@@ -1445,7 +1465,7 @@
 	 (input-pathname (verify-source-file input-file))
 	 (source-info (make-file-source-info input-pathname))
 	 (*compiler-trace-output* nil)) ; might be modified below
-				
+
     (unwind-protect
 	(progn
 	  (when output-file