0.pre8.100:

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

diff --git a/src/compiler/main.lisp b/src/compiler/main.lisp
index 6b3debf..41c49a1 100644 (file)
--- a/src/compiler/main.lisp
+++ b/src/compiler/main.lisp
@@ -87,6 +87,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 +132,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 +145,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
@@ -871,10 +877,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