0.8.0.58:
[sbcl.git] / src / cold / warm.lisp
index 1292f46..546f45b 100644 (file)
 \f
 ;;;; general warm init compilation policy
 
-#+(and sbcl alpha) ; SBCL/Alpha uses stop-and-copy, and Alphas have lotso RAM.
-(progn
-  (sb!ext::gc-off)
-  (setf (sb!ext::bytes-consed-between-gcs) (* 30 (expt 10 6)))
-  (sb!ext::gc-on)
-  (sb!ext::gc))
-
 
 (proclaim '(optimize (compilation-speed 1)
                     (debug #+sb-show 2 #-sb-show 1)
                     (space 1)
                     (speed 2)))
 \f
-;;;; KLUDGE: Compile and load files which really belong in cold load but are
-;;;; here for various unsound reasons. We handle them here, before the package
-;;;; hacking below, because they use the SB!FOO cold package name convention
-;;;; instead of the SB-FOO final package name convention (since they really
-;;;; do belong in cold load and will hopefully make it back there reasonably
-;;;; soon). -- WHN 19991207
-
-(dolist (stem '(;; FIXME: The assembly files here probably belong in
-               ;; cold load instead of warm load. They ended up here
-               ;; as a quick hack to work around the consequences of
-               ;; my misunderstanding how ASSEMBLE-FILE works when I
-               ;; wrote the cold build code. The cold build code
-               ;; expects only one FASL filename per source file,
-               ;; when it turns out we really need one FASL file for
-               ;; ASSEMBLE-FILE output and another for COMPILE-FILE
-               ;; output. It would probably be good to redo the cold
-               ;; build code so that the COMPILE-FILE stuff generated
-               ;; here can be loaded at the same time as the
-               ;; ASSEMBLE-FILE stuff generated there.
-               "src/assembly/target/assem-rtns"
-               "src/assembly/target/array"
-               "src/assembly/target/arith"
-               "src/assembly/target/alloc"))
-  ;; KLUDGE: Cut-and-paste programming, the sign of a true professional.:-|
-  ;; (Hopefully this will go away as we move the files above into cold load.)
-  ;; -- WHN 19991214
-  (let ((fullname (concatenate 'string stem ".lisp")))
-    ;; (Now that we use byte compiler for interpretation, /SHOW
-    ;; doesn't get compiled properly until the src/assembly files have
-    ;; been loaded, so we use PRINT instead.)
-    #+sb-show (print "/about to compile src/assembly file")
-    #+sb-show (print fullname)
-    (multiple-value-bind
-       (compiled-truename compilation-warnings-p compilation-failure-p)
-       (compile-file fullname)
-      (declare (ignore compilation-warnings-p))
-      #+sb-show (print "/done compiling src/assembly file")
-      (if compilation-failure-p
-         (error "COMPILE-FILE of ~S failed." fullname)
-         (unless (load compiled-truename)
-           (error "LOAD of ~S failed." compiled-truename))))))
-\f
 ;;;; package hacking
 
 ;;; Our cross-compilation host is out of the picture now, so we no
   (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))
 \f
 ;;;; 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:
 ;;;
                ;; (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"
                "src/pcl/low"
+                "src/pcl/slot-name"
                "src/pcl/defclass"
                "src/pcl/defs"
                "src/pcl/fngen"
                "src/pcl/slots-boot"
                "src/pcl/combin"
                "src/pcl/dfun"
-               "src/pcl/fast-init"
+               "src/pcl/ctor"
                "src/pcl/braid"
                "src/pcl/dlisp3"
                "src/pcl/generic-functions"
                ;; to warm init to reduce peak memory requirement in
                ;; cold init
                "src/code/describe"
+                "src/code/describe-policy"
                "src/code/inspect"
                "src/code/profile"
                "src/code/ntrace"
 
   (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
 
 ;;; 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?
-\f
-;;;; resetting compilation policy to neutral values in preparation for
-;;;; SAVE-LISP-AND-DIE as final SBCL core
-
-(sb-int:/show "setting compilation policy to neutral values")
-(proclaim '(optimize (compilation-speed 1)
-                    (debug 1)
-                    (inhibit-warnings 1)
-                    (safety 1)
-                    (space 1)
-                    (speed 1)))