X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fshared.lisp;h=f17fedf2034ef2b071973a32a1e6e22c4f4f33be;hb=94ac5b7c3ff37850210b6fc9a7593cf1c5752993;hp=a55036c4108c27ef93b2cccf39b3ab4c8686bff4;hpb=ec2616d216958a608581802c47496c0194478dc8;p=sbcl.git

diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp
index a55036c..f17fedf 100644
--- a/src/cold/shared.lisp
+++ b/src/cold/shared.lisp
@@ -46,6 +46,7 @@
    ;; that we never explicitly refer to host object file suffixes,
    ;; only to the result of CL:COMPILE-FILE-PATHNAME.
    #+lispworks ".ufsl" ; as per Lieven Marchand sbcl-devel 2002-02-01
+   #+openmcl ".pfsl"
    ;; On most xc hosts, any old extension works, so we use an
    ;; arbitrary one.
    ".lisp-obj"))
@@ -162,29 +163,37 @@
 	    (truename stream)))
 
     ;; Try to use the compiler to generate a new temporary object file.
-    (multiple-value-bind (output-truename warnings-p failure-p)
-	(funcall compile-file src :output-file tmp-obj)
-      (declare (ignore warnings-p))
-      (cond ((not output-truename)
-	     (error "couldn't compile ~S" src))
-	    (failure-p
-	     (if ignore-failure-p
-		 (warn "ignoring FAILURE-P return value from compilation of ~S"
-		       src)
-		 (unwind-protect
-		     (progn
-		       ;; FIXME: This should have another option,
-		       ;; redoing compilation.
-		       (cerror "Continue, using possibly-bogus ~S."
-			       "FAILURE-P was set when creating ~S."
-			       obj)
-		       (setf failure-p nil))
-		   ;; Don't leave failed object files lying around.
-		   (when (and failure-p (probe-file tmp-obj))
-		     (delete-file tmp-obj)
-		     (format t "~&deleted ~S~%" tmp-obj)))))
-	    ;; Otherwise: success, just fall through.
-	    (t nil)))
+    (flet ((report-recompile-restart (stream)
+             (format stream "Recompile file ~S" src))
+           (report-continue-restart (stream)
+             (format stream "Continue, using possibly bogus file ~S" obj)))
+      (tagbody
+       retry-compile-file
+         (multiple-value-bind (output-truename warnings-p failure-p)
+             (funcall compile-file src :output-file tmp-obj)
+           (declare (ignore warnings-p))
+           (cond ((not output-truename)
+                  (error "couldn't compile ~S" src))
+                 (failure-p
+                  (if ignore-failure-p
+                      (warn "ignoring FAILURE-P return value from compilation of ~S"
+                            src)
+                      (unwind-protect
+                           (restart-case
+                               (error "FAILURE-P was set when creating ~S."
+                                      obj)
+                             (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 tmp-obj))
+                          (delete-file tmp-obj)
+                          (format t "~&deleted ~S~%" tmp-obj)))))
+                 ;; Otherwise: success, just fall through.
+                 (t nil)))))
 
     ;; If we get to here, compilation succeeded, so it's OK to rename
     ;; the temporary output file to the permanent object file.
@@ -236,7 +245,6 @@
 				  (read-from-file customizer-file-name))
 			 #'identity)))
     (funcall customizer default-subfeatures)))
-(export '*shebang-backend-subfeatures*)
 (let ((*print-length* nil)
       (*print-level* nil))
   (format t