X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fwarm.lisp;h=0015e82b0d5534acbfbc7ebcb8a3d27308961358;hb=f1407e424f1063203af07d2e61ceef58515a4797;hp=59332643b29c8bc75794b6e92ff3810205fefd39;hpb=2bdf5a3484eda55b0d4b9313aa6b3505b6d7cbd8;p=sbcl.git

diff --git a/src/cold/warm.lisp b/src/cold/warm.lisp
index 5933264..0015e82 100644
--- a/src/cold/warm.lisp
+++ b/src/cold/warm.lisp
@@ -59,40 +59,9 @@
   (rename-package package
 		  (package-name package)
 		  (cons "SB-C-CALL" (package-nicknames package))))
-
-;;; KLUDGE: This is created here (instead of in package-data-list.lisp-expr)
-;;; because it doesn't have any symbols in it, so even if it's
-;;; present at cold load time, genesis thinks it's unimportant
-;;; and doesn't dump it. There's gotta be a better way, but for now
-;;; I'll just do it here. (As noted below, I'd just as soon have this
-;;; go away entirely, so I'm disinclined to fiddle with it too much.)
-;;; -- WHN 19991206
-;;;
-;;; FIXME: Why do slot accessor names need to be interned anywhere? For
-;;; low-level debugging? Perhaps this should go away, or at least
-;;; be optional, controlled by SB-SHOW or something.
-(defpackage "SB-SLOT-ACCESSOR-NAME"
-  (:use))
 
 ;;;; compiling and loading more of the system
 
-;;; KLUDGE: In SBCL, almost all in-the-flow-of-control package hacking has
-;;; gone away in favor of package setup controlled by tables. However, that
-;;; mechanism isn't smart enough to handle shadowing, and since this shadowing
-;;; is inherently a non-ANSI KLUDGE anyway (i.e. there ought to be no
-;;; difference between e.g. CL:CLASS and SB-PCL:CLASS) there's not much
-;;; point in trying to polish it by implementing a non-KLUDGEy way of
-;;; setting it up. -- WHN 19991203
-(let ((*package* (the package (find-package "SB-PCL"))))
-  (shadow '(;; CLASS itself and operations thereon
-	    "CLASS" "CLASS-NAME" "CLASS-OF" "FIND-CLASS"
-	    ;; some system classes
-	    "BUILT-IN-CLASS" "STANDARD-CLASS" "STRUCTURE-CLASS"))
-  ;; Of the shadowing symbols above, these are external symbols in CMU CL ca.
-  ;; 19991203. I'm not sure what's the basis of the decision to export some and
-  ;; not others; we'll just follow along..
-  (export (mapcar #'intern '("CLASS-NAME" "CLASS-OF" "FIND-CLASS"))))
-
 ;;; FIXME: CMU CL's pclcom.lisp had extra optional stuff wrapped around
 ;;; COMPILE-PCL, at least some of which we should probably have too:
 ;;;
@@ -129,7 +98,7 @@
 		;; (arbitrary) linearization of the declared build
 		;; order dependencies from the old PCL defsys.lisp
 		;; dependency database.
-		"src/pcl/walk"
+		#+nil "src/pcl/walk" ; #+NIL = moved to build-order.lisp-expr
 		"src/pcl/early-low"
 		"src/pcl/macros"
                 "src/pcl/compiler-support"
@@ -193,17 +162,38 @@
 
   (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" 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)
+             (compile-file fullname)
+           (declare (ignore warnings-p))
+	   (sb-int:/show "done compiling" fullname)
+           (cond ((not output-truename)
+                  (error "COMPILE-FILE of ~S failed." src))
+                 (failure-p
+		  (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 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" compiled-truename))))))
 
 ;;;; setting package documentation