src/cold/warm.lisp

   1 ;;;; "warm initialization": initialization which comes after cold init
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "COMMON-LISP-USER")
  13
  14 ;;;; $Header$
  15 \f
  16 ;;;; general warm init compilation policy
  17
  18 (proclaim '(optimize (compilation-speed 1)
  19                      (debug #+sb-show 2 #-sb-show 1)
  20                      (inhibit-warnings 2)
  21                      (safety 1)
  22                      (space 1)
  23                      (speed 2)))
  24 \f
  25 ;;;; KLUDGE: Compile and load files which really belong in cold load but are
  26 ;;;; here for various unsound reasons. We handle them here, before the package
  27 ;;;; hacking below, because they use the SB!FOO cold package name convention
  28 ;;;; instead of the SB-FOO final package name convention (since they really
  29 ;;;; do belong in cold load and will hopefully make it back there reasonably
  30 ;;;; soon). -- WHN 19991207
  31
  32 (dolist (stem '(;; FIXME: The files here from outside the src/pcl/ directory
  33                 ;; probably belong in cold load instead of warm load. They
  34                 ;; ended up here as a quick hack to work around the
  35                 ;; consequences of my misunderstanding how ASSEMBLE-FILE works
  36                 ;; when I wrote the cold build code. The cold build code
  37                 ;; expects only one FASL filename per source file, when it
  38                 ;; turns out we really need one FASL file for ASSEMBLE-FILE
  39                 ;; output and another for COMPILE-FILE output. It would
  40                 ;; probably be good to redo the cold build code so that the
  41                 ;; COMPILE-FILE stuff generated here can be loaded at the same
  42                 ;; time as the ASSEMBLE-FILE stuff generated there.
  43                 "src/assembly/target/assem-rtns"
  44                 "src/assembly/target/array"
  45                 "src/assembly/target/arith"
  46                 "src/assembly/target/alloc"))
  47   ;; KLUDGE: Cut-and-paste programming, the sign of a true professional.:-|
  48   ;; (Hopefully this will go away as we move the files above into cold load.)
  49   ;; -- WHN 19991214
  50   (let ((fullname (concatenate 'string stem ".lisp")))
  51     (sb!int:/show "about to compile" fullname)
  52     (multiple-value-bind
  53         (compiled-truename compilation-warnings-p compilation-failure-p)
  54         (compile-file fullname)
  55       (declare (ignore compilation-warnings-p))
  56       (sb!int:/show "done compiling" fullname)
  57       (if compilation-failure-p
  58           (error "COMPILE-FILE of ~S failed." fullname)
  59           (unless (load compiled-truename)
  60             (error "LOAD of ~S failed." compiled-truename))))))
  61 \f
  62 ;;;; package hacking
  63
  64 ;;; Our cross-compilation host is out of the picture now, so we no longer need
  65 ;;; to worry about collisions between our package names and cross-compilation
  66 ;;; host package names, so now is a good time to rename any package with a
  67 ;;; bootstrap-only name SB!FOO to its permanent name SB-FOO.
  68 ;;;
  69 ;;; (In principle it might be tidier to do this when dumping the cold image in
  70 ;;; genesis, but in practice the logic might be a little messier because
  71 ;;; genesis dumps both symbols and packages, and we'd need to make that dumped
  72 ;;; symbols were renamed in the same way as dumped packages. Or we could do it
  73 ;;; in cold init, but it's easier to experiment with and debug things here in
  74 ;;; warm init than in cold init, so we do it here instead.)
  75 (let ((boot-prefix "SB!")
  76       (perm-prefix "SB-"))
  77   (dolist (package (list-all-packages))
  78     (let ((old-package-name (package-name package)))
  79       (when (and (>= (length old-package-name) (length boot-prefix))
  80                  (string= boot-prefix old-package-name
  81                           :end2 (length boot-prefix)))
  82         (let ((new-package-name (concatenate 'string
  83                                              perm-prefix
  84                                              (subseq old-package-name
  85                                                      (length boot-prefix)))))
  86           (rename-package package
  87                           new-package-name
  88                           (package-nicknames package)))))))
  89
  90 ;;; KLUDGE: This is created here (instead of in package-data-list.lisp-expr)
  91 ;;; because it doesn't have any symbols in it, so even if it's
  92 ;;; present at cold load time, genesis thinks it's unimportant
  93 ;;; and doesn't dump it. There's gotta be a better way, but for now
  94 ;;; I'll just do it here. (As noted below, I'd just as soon have this
  95 ;;; go away entirely, so I'm disinclined to fiddle with it too much.)
  96 ;;; -- WHN 19991206
  97 ;;;
  98 ;;; FIXME: Why do slot accessor names need to be interned anywhere? For
  99 ;;; low-level debugging? Perhaps this should go away, or at least
 100 ;;; be optional, controlled by SB-SHOW or something.
 101 (defpackage "SB-SLOT-ACCESSOR-NAME"
 102   (:use))
 103 \f
 104 ;;;; compiling and loading more of the system
 105
 106 ;;; KLUDGE: In SBCL, almost all in-the-flow-of-control package hacking has
 107 ;;; gone away in favor of package setup controlled by tables. However, that
 108 ;;; mechanism isn't smart enough to handle shadowing, and since this shadowing
 109 ;;; is inherently a non-ANSI KLUDGE anyway (i.e. there ought to be no
 110 ;;; difference between e.g. CL:CLASS and SB-PCL:CLASS) there's not much
 111 ;;; point in trying to polish it by implementing a non-KLUDGEy way of
 112 ;;; setting it up. -- WHN 19991203
 113 (let ((*package* (the package (find-package "SB-PCL"))))
 114   (shadow '(;; CLASS itself and operations thereon
 115             "CLASS" "CLASS-NAME" "CLASS-OF" "FIND-CLASS"
 116             ;; some system classes
 117             "BUILT-IN-CLASS" "STANDARD-CLASS" "STRUCTURE-CLASS"))
 118   ;; Of the shadowing symbols above, these are external symbols in CMU CL ca.
 119   ;; 19991203. I'm not sure what's the basis of the decision to export some and
 120   ;; not others; we'll just follow along..
 121   (export (mapcar #'intern '("CLASS-NAME" "CLASS-OF" "FIND-CLASS"))))
 122
 123 ;;; FIXME: CMU CL's pclcom.lisp had extra optional stuff wrapped around
 124 ;;; COMPILE-PCL, at least some of which we should probably have too:
 125 ;;;
 126 ;;; (with-compilation-unit
 127 ;;;     (:optimize '(optimize (debug #+(and (not high-security) small) .5
 128 ;;;                               #-(or high-security small) 2
 129 ;;;                               #+high-security 3)
 130 ;;;                        (speed 2) (safety #+(and (not high-security) small) 0
 131 ;;;                                          #-(or high-security small) 2
 132 ;;;                                          #+high-security 3)
 133 ;;;                        (inhibit-warnings 2))
 134 ;;;      :optimize-interface '(optimize-interface #+(and (not high-security) small)
 135 ;;; (safety 1)
 136 ;;;                                            #+high-security (safety 3))
 137 ;;;      :context-declarations
 138 ;;;      '((:external (declare (optimize-interface (safety #-high-security 2 #+high-
 139 ;;; security 3)
 140 ;;;                                             (debug #-high-security 1 #+high-s
 141 ;;; ecurity 3))))
 142 ;;;     ((:or :macro (:match "$EARLY-") (:match "$BOOT-"))
 143 ;;;     (declare (optimize (speed 0))))))
 144 ;;;
 145 ;;; FIXME: This has mutated into a hack which crudely duplicates
 146 ;;; functionality from the existing mechanism to load files from
 147 ;;; stems-and-flags.lisp-expr, without being quite parallel. (E.g.
 148 ;;; object files end up alongside the source files instead of ending
 149 ;;; up in parallel directory trees.) Maybe we could merge the
 150 ;;; filenames here into stems-and-flags.lisp-expr with some new flag
 151 ;;; (perhaps :WARM) to indicate that the files should be handled not
 152 ;;; in cold load but afterwards. Alternatively, we could call
 153 (dolist (stem '(
 154                 ;; CLOS, derived from the PCL reference implementation
 155                 ;;
 156                 ;; This PCL build order is based on a particular
 157                 ;; linearization of the declared build order
 158                 ;; dependencies from the old PCL defsys.lisp
 159                 ;; dependency database.
 160                 "src/pcl/walk"
 161                 "src/pcl/iterate"
 162                 "src/pcl/early-low"
 163                 "src/pcl/macros"
 164                 "src/pcl/low"
 165                 "src/pcl/fin"
 166                 "src/pcl/defclass"
 167                 "src/pcl/defs"
 168                 "src/pcl/fngen"
 169                 "src/pcl/cache"
 170                 "src/pcl/dlisp"
 171                 "src/pcl/dlisp2"
 172                 "src/pcl/boot"
 173                 "src/pcl/vector"
 174                 "src/pcl/slots-boot"
 175                 "src/pcl/combin"
 176                 "src/pcl/dfun"
 177                 "src/pcl/fast-init"
 178                 "src/pcl/braid"
 179                 "src/pcl/dlisp3"
 180                 "src/pcl/generic-functions"
 181                 "src/pcl/slots"
 182                 "src/pcl/init"
 183                 "src/pcl/std-class"
 184                 "src/pcl/cpl"
 185                 "src/pcl/fsc"
 186                 "src/pcl/methods"
 187                 "src/pcl/fixup"
 188                 "src/pcl/defcombin"
 189                 "src/pcl/ctypes"
 190                 "src/pcl/construct"
 191                 "src/pcl/env"
 192                 "src/pcl/documentation"
 193                 "src/pcl/print-object"
 194                 "src/pcl/precom1"
 195                 "src/pcl/precom2"
 196                 ;; functionality which depends on CLOS
 197                 "src/code/force-delayed-defbangmethods"
 198                 ;; other functionality not needed for cold init, moved
 199                 ;; to warm init to reduce peak memory requirement in
 200                 ;; cold init
 201                 "src/code/describe" ; FIXME: should be byte compiled
 202                 "src/code/inspect" ; FIXME: should be byte compiled
 203                 "src/code/profile"
 204                 "src/code/ntrace"
 205                 #+nil "src/code/run-program" ; not working as of 0.6.7
 206                 "src/code/foreign"
 207                 ;; Code derived from PCL's pre-ANSI DESCRIBE-OBJECT
 208                 ;; facility is still used in our ANSI DESCRIBE
 209                 ;; facility, and should be compiled and loaded after
 210                 ;; our DESCRIBE facility is compiled and loaded.
 211                 "src/pcl/describe" ; FIXME: should probably be byte compiled
 212                 ;; FIXME: What about Gray streams? e.g. "gray-streams.lisp"
 213                 ;; and "gray-streams-class.lisp"?
 214                 ))
 215   (let ((fullname (concatenate 'string stem ".lisp")))
 216     (sb-int:/show "about to compile" fullname)
 217     (multiple-value-bind
 218         (compiled-truename compilation-warnings-p compilation-failure-p)
 219         (compile-file fullname)
 220       (declare (ignore compilation-warnings-p))
 221       (sb-int:/show "done compiling" fullname)
 222       (cond (compilation-failure-p
 223              (error "COMPILE-FILE of ~S failed." fullname))
 224             (t
 225              (unless (load compiled-truename)
 226                (error "LOAD of ~S failed." compiled-truename))
 227              (sb-int:/show "done loading" compiled-truename))))))
 228 \f
 229 ;;;; setting package documentation
 230
 231 ;;; While we were running on the cross-compilation host, we tried to
 232 ;;; be portable and not overwrite the doc strings for the standard
 233 ;;; packages. But now the cross-compilation host is only a receding
 234 ;;; memory, and we can have our way with the doc strings.
 235 (sb-int:/show "setting package documentation")
 236 #+sb-doc (setf (documentation (find-package "COMMON-LISP") t)
 237 "public: home of symbols defined by the ANSI language specification")
 238 #+sb-doc (setf (documentation (find-package "COMMON-LISP-USER") t)
 239                "public: the default package for user code and data")
 240 #+sb-doc (setf (documentation (find-package "KEYWORD") t)
 241                "public: home of keywords")
 242
 243 ;;; KLUDGE: It'd be nicer to do this in the table with the other
 244 ;;; non-standard packages. -- WHN 19991206
 245 #+sb-doc (setf (documentation (find-package "SB-SLOT-ACCESSOR-NAME") t)
 246                "private: home of CLOS slot accessor internal names")
 247
 248 ;;; FIXME: There doesn't seem to be any easy way to get package doc strings
 249 ;;; through the cold boot process. They need to be set somewhere. Maybe the
 250 ;;; easiest thing to do is to read them out of package-data-list.lisp-expr
 251 ;;; now?
 252 \f
 253 ;;;; restoring compilation policy to neutral values in preparation for
 254 ;;;; SAVE-LISP-AND-DIE as final SBCL core
 255
 256 (sb-int:/show "setting compilation policy to neutral values")
 257 (proclaim '(optimize (compilation-speed 1)
 258                      (debug 1)
 259                      (inhibit-warnings 1)
 260                      (safety 1)
 261                      (space 1)
 262                      (speed 1)))
 263 \f
 264 ;;; FIXME: It would be good to unintern stuff we will no longer need
 265 ;;; before we go on to PURIFY. E.g.
 266 ;;;  * various PCL stuff like INITIAL-CLASSES-AND-WRAPPERS; and
 267 ;;;  * *BUILT-IN-CLASSES* (which can't actually be freed by UNINTERN at
 268 ;;;    this point, since it passed through another PURIFY earlier
 269 ;;;    at cold init time).