0.8.5.3:

[sbcl.git] / src / cold / warm.lisp

diff --git a/src/cold/warm.lisp b/src/cold/warm.lisp
index 455e932..d02357c 100644 (file)
--- a/src/cold/warm.lisp
+++ b/src/cold/warm.lisp
@@ -136,6 +136,7 @@
 
                ;; miscellaneous functionality which depends on CLOS
                "src/code/force-delayed-defbangmethods"
+                "src/code/late-condition"
 
                ;; CLOS-level support for the Gray OO streams
                ;; extension (which is also supported by various
@@ -162,17 +163,40 @@
 
   (let ((fullname (concatenate 'string stem ".lisp")))
     (sb-int:/show "about to compile" fullname)
-    (multiple-value-bind
-       (compiled-truename compilation-warnings-p compilation-failure-p)
-       (compile-file fullname)
-      (declare (ignore compilation-warnings-p))
-      (sb-int:/show "done compiling" fullname)
-      (cond (compilation-failure-p
-            (error "COMPILE-FILE of ~S failed." fullname))
-           (t
-            (unless (load compiled-truename)
-              (error "LOAD of ~S failed." compiled-truename))
-            (sb-int:/show "done loading" compiled-truename))))))
+    (flet ((report-recompile-restart (stream)
+             (format stream "Recompile file ~S" fullname))
+           (report-continue-restart (stream)
+             (format stream
+                    "Continue, using possibly bogus file ~S"
+                    (compile-file-pathname fullname))))
+      (tagbody
+       retry-compile-file
+         (multiple-value-bind (output-truename warnings-p failure-p)
+             (compile-file fullname)
+           (declare (ignore warnings-p))
+          (sb-int:/show "done compiling" fullname)
+           (cond ((not output-truename)
+                  (error "COMPILE-FILE of ~S failed." fullname))
+                 (failure-p
+                 (unwind-protect
+                      (restart-case
+                          (error "FAILURE-P was set when creating ~S."
+                                 output-truename)
+                        (recompile ()
+                          :report report-recompile-restart
+                          (go retry-compile-file))
+                        (continue ()
+                          :report report-continue-restart
+                          (setf failure-p nil)))
+                   ;; Don't leave failed object files lying around.
+                   (when (and failure-p (probe-file output-truename))
+                          (delete-file output-truename)
+                          (format t "~&deleted ~S~%" output-truename))))
+                 ;; Otherwise: success, just fall through.
+                 (t nil))
+          (unless (load output-truename)
+            (error "LOAD of ~S failed." output-truename))
+          (sb-int:/show "done loading" output-truename))))))
 \f
 ;;;; setting package documentation
 
@@ -187,13 +211,3 @@
               "public: the default package for user code and data")
 #+sb-doc (setf (documentation (find-package "KEYWORD") t)
               "public: home of keywords")
-
-;;; KLUDGE: It'd be nicer to do this in the table with the other
-;;; non-standard packages. -- WHN 19991206
-#+sb-doc (setf (documentation (find-package "SB-SLOT-ACCESSOR-NAME") t)
-              "private: home of CLOS slot accessor internal names")
-
-;;; FIXME: There doesn't seem to be any easy way to get package doc strings
-;;; through the cold boot process. They need to be set somewhere. Maybe the
-;;; easiest thing to do is to read them out of package-data-list.lisp-expr
-;;; now?