X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcold%2Fwarm.lisp;h=fc6f1c4df8e0398471c5d7cab26688b2343b0586;hb=6dc30bee17d029acf6bb6da730f03e63b2a01948;hp=a361fde7a43232fb74da5e46029aa894949332fd;hpb=204f2fa9771ad9e55718dc76205afec7d11b3011;p=sbcl.git diff --git a/src/cold/warm.lisp b/src/cold/warm.lisp index a361fde..fc6f1c4 100644 --- a/src/cold/warm.lisp +++ b/src/cold/warm.lisp @@ -14,223 +14,191 @@ ;;;; general warm init compilation policy (proclaim '(optimize (compilation-speed 1) - (debug #+sb-show 2 #-sb-show 1) - (inhibit-warnings 2) - (safety 1) - (space 1) - (speed 2))) - -;;;; 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 + (debug #+sb-show 2 #-sb-show 1) + (inhibit-warnings 2) + (safety 2) + (space 1) + (speed 2))) -(dolist (stem '(;; FIXME: The files here from outside the src/pcl directory - ;; 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"))) - (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) - (if compilation-failure-p - (error "COMPILE-FILE of ~S failed." fullname) - (unless (load compiled-truename) - (error "LOAD of ~S failed." compiled-truename)))))) ;;;; package hacking -;;; Our cross-compilation host is out of the picture now, so we no longer need -;;; to worry about collisions between our package names and cross-compilation -;;; host package names, so now is a good time to rename any package with a -;;; bootstrap-only name SB!FOO to its permanent name SB-FOO. +;;; Our cross-compilation host is out of the picture now, so we no +;;; longer need to worry about collisions between our package names +;;; and cross-compilation host package names, so now is a good time to +;;; rename any package with a bootstrap-only name SB!FOO to its +;;; permanent name SB-FOO. ;;; -;;; (In principle it might be tidier to do this when dumping the cold image in -;;; genesis, but in practice the logic might be a little messier because -;;; genesis dumps both symbols and packages, and we'd need to make that dumped -;;; symbols were renamed in the same way as dumped packages. Or we could do it -;;; in cold init, but it's easier to experiment with and debug things here in -;;; warm init than in cold init, so we do it here instead.) +;;; (In principle it might be tidier to do this when dumping the cold +;;; image in genesis, but in practice the logic might be a little +;;; messier because genesis dumps both symbols and packages, and we'd +;;; need to make sure that dumped symbols were renamed in the same way +;;; as dumped packages. Or we could do it in cold init, but it's +;;; easier to experiment with and debug things here in warm init than +;;; in cold init, so we do it here instead.) (let ((boot-prefix "SB!") (perm-prefix "SB-")) (dolist (package (list-all-packages)) (let ((old-package-name (package-name package))) (when (and (>= (length old-package-name) (length boot-prefix)) - (string= boot-prefix old-package-name - :end2 (length boot-prefix))) - (let ((new-package-name (concatenate 'string - perm-prefix - (subseq old-package-name - (length boot-prefix))))) - (rename-package package - new-package-name - (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)) + (string= boot-prefix old-package-name + :end2 (length boot-prefix))) + (let ((new-package-name (concatenate 'string + perm-prefix + (subseq old-package-name + (length boot-prefix))))) + (rename-package package + new-package-name + (package-nicknames package))))))) + +;;; FIXME: This nickname is a deprecated hack for backwards +;;; compatibility with code which assumed the CMU-CL-style +;;; SB-ALIEN/SB-C-CALL split. That split went away and was deprecated +;;; in 0.7.0, so we should get rid of this nickname after a while. +(let ((package (find-package "SB-ALIEN"))) + (rename-package package + (package-name package) + (cons "SB-C-CALL" (package-nicknames package)))) + +(let ((package (find-package "SB-SEQUENCE"))) + (rename-package package (package-name package) (list "SEQUENCE"))) ;;;; 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: ;;; ;;; (with-compilation-unit ;;; (:optimize '(optimize (debug #+(and (not high-security) small) .5 -;;; #-(or high-security small) 2 -;;; #+high-security 3) -;;; (speed 2) (safety #+(and (not high-security) small) 0 -;;; #-(or high-security small) 2 -;;; #+high-security 3) -;;; (inhibit-warnings 2)) +;;; #-(or high-security small) 2 +;;; #+high-security 3) +;;; (speed 2) (safety #+(and (not high-security) small) 0 +;;; #-(or high-security small) 2 +;;; #+high-security 3) +;;; (inhibit-warnings 2)) ;;; :optimize-interface '(optimize-interface #+(and (not high-security) small) ;;; (safety 1) -;;; #+high-security (safety 3)) +;;; #+high-security (safety 3)) ;;; :context-declarations ;;; '((:external (declare (optimize-interface (safety #-high-security 2 #+high- ;;; security 3) -;;; (debug #-high-security 1 #+high-s +;;; (debug #-high-security 1 #+high-s ;;; ecurity 3)))) -;;; ((:or :macro (:match "$EARLY-") (:match "$BOOT-")) -;;; (declare (optimize (speed 0)))))) +;;; ((:or :macro (:match "$EARLY-") (:match "$BOOT-")) +;;; (declare (optimize (speed 0)))))) ;;; ;;; FIXME: This has mutated into a hack which crudely duplicates ;;; functionality from the existing mechanism to load files from -;;; stems-and-flags.lisp-expr, without being quite parallel. (E.g. -;;; object files end up alongside the source files instead of ending -;;; up in parallel directory trees.) Maybe we could merge the -;;; filenames here into stems-and-flags.lisp-expr with some new flag -;;; (perhaps :WARM) to indicate that the files should be handled not -;;; in cold load but afterwards. Alternatively, we could call -(dolist (stem '( - ;; CLOS, derived from the PCL reference implementation - ;; - ;; This PCL build order is based on a particular - ;; linearization of the declared build order - ;; dependencies from the old PCL defsys.lisp - ;; dependency database. - "src/pcl/walk" - "src/pcl/iterate" - "src/pcl/early-low" - "src/pcl/macros" - "src/pcl/compiler-support" - "src/pcl/low" - ;; "src/pcl/fin" merged into "src/pcl/low" in 0.6.11.43 - "src/pcl/defclass" - "src/pcl/defs" - "src/pcl/fngen" - "src/pcl/cache" - "src/pcl/dlisp" - "src/pcl/dlisp2" - "src/pcl/boot" - "src/pcl/vector" - "src/pcl/slots-boot" - "src/pcl/combin" - "src/pcl/dfun" - "src/pcl/fast-init" - "src/pcl/braid" - "src/pcl/dlisp3" - "src/pcl/generic-functions" - "src/pcl/slots" - "src/pcl/init" - "src/pcl/std-class" - "src/pcl/cpl" - "src/pcl/fsc" - "src/pcl/methods" - "src/pcl/fixup" - "src/pcl/defcombin" - "src/pcl/ctypes" - "src/pcl/construct" - "src/pcl/env" - "src/pcl/documentation" - "src/pcl/print-object" - "src/pcl/precom1" - "src/pcl/precom2" - - ;; miscellaneous functionality which depends on CLOS - "src/code/force-delayed-defbangmethods" - - ;; CLOS-level support for the Gray OO streams - ;; extension (which is also supported by various - ;; lower-level hooks elsewhere in the code) - "src/pcl/gray-streams-class" - "src/pcl/gray-streams" - - ;; other functionality not needed for cold init, moved - ;; to warm init to reduce peak memory requirement in - ;; cold init - "src/code/describe" - "src/code/inspect" - "src/code/profile" - "src/code/ntrace" - "src/code/foreign" - "src/code/run-program" - - ;; Code derived from PCL's pre-ANSI DESCRIBE-OBJECT - ;; facility is still used in our ANSI DESCRIBE - ;; facility, and should be compiled and loaded after - ;; our DESCRIBE facility is compiled and loaded. - "src/pcl/describe")) - - (let ((fullname (concatenate 'string stem ".lisp"))) +;;; build-order.lisp-expr, without being quite parallel. (E.g. object +;;; files end up alongside the source files instead of ending up in +;;; parallel directory trees.) Maybe we could merge the filenames here +;;; into build-order.lisp-expr with some new flag (perhaps :WARM) to +;;; indicate that the files should be handled not in cold load but +;;; afterwards. +(dolist (stem '(;; CLOS, derived from the PCL reference implementation + ;; + ;; This PCL build order is based on a particular + ;; (arbitrary) linearization of the declared build + ;; order dependencies from the old PCL defsys.lisp + ;; dependency database. + #+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;WRAPPER" + "SRC;PCL;CACHE" + "SRC;PCL;DLISP" + "SRC;PCL;BOOT" + "SRC;PCL;VECTOR" + "SRC;PCL;SLOTS-BOOT" + "SRC;PCL;COMBIN" + "SRC;PCL;DFUN" + "SRC;PCL;CTOR" + "SRC;PCL;BRAID" + "SRC;PCL;DLISP3" + "SRC;PCL;GENERIC-FUNCTIONS" + "SRC;PCL;SLOTS" + "SRC;PCL;INIT" + "SRC;PCL;STD-CLASS" + "SRC;PCL;CPL" + "SRC;PCL;FSC" + "SRC;PCL;METHODS" + "SRC;PCL;FIXUP" + "SRC;PCL;DEFCOMBIN" + "SRC;PCL;CTYPES" + "SRC;PCL;ENV" + "SRC;PCL;DOCUMENTATION" + "SRC;PCL;PRINT-OBJECT" + "SRC;PCL;PRECOM1" + "SRC;PCL;PRECOM2" + + ;; 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 + ;; lower-level hooks elsewhere in the code) + "SRC;PCL;GRAY-STREAMS-CLASS" + "SRC;PCL;GRAY-STREAMS" + + ;; CLOS-level support for User-extensible sequences. + "SRC;PCL;SEQUENCE" + + ;; other functionality not needed for cold init, moved + ;; 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" + "SRC;CODE;STEP" + "SRC;CODE;RUN-PROGRAM")) + + (let ((fullname (concatenate 'string "SYS:" 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) + (if *compile-files-p* + (compile-file fullname) + (compile-file-pathname 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)))))) ;;;; setting package documentation @@ -242,34 +210,8 @@ #+sb-doc (setf (documentation (find-package "COMMON-LISP") t) "public: home of symbols defined by the ANSI language specification") #+sb-doc (setf (documentation (find-package "COMMON-LISP-USER") t) - "public: the default package for user code and data") + "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? + "public: home of keywords") -;;;; restoring 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))) - -;;; FIXME: It would be good to unintern stuff we will no longer need -;;; before we go on to PURIFY. E.g. -;;; * various PCL stuff like INITIAL-CLASSES-AND-WRAPPERS; and -;;; * *BUILT-IN-CLASSES* (which can't actually be freed by UNINTERN at -;;; this point, since it passed through another PURIFY earlier -;;; at cold init time).