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 \f
  14 ;;;; general warm init compilation policy
  15
  16
  17 (proclaim '(optimize (compilation-speed 1)
  18                      (debug #+sb-show 2 #-sb-show 1)
  19                      (inhibit-warnings 2)
  20                      (safety 2)
  21                      (space 1)
  22                      (speed 2)))
  23 \f
  24 ;;;; package hacking
  25
  26 ;;; Our cross-compilation host is out of the picture now, so we no
  27 ;;; longer need to worry about collisions between our package names
  28 ;;; and cross-compilation host package names, so now is a good time to
  29 ;;; rename any package with a bootstrap-only name SB!FOO to its
  30 ;;; permanent name SB-FOO.
  31 ;;;
  32 ;;; (In principle it might be tidier to do this when dumping the cold
  33 ;;; image in genesis, but in practice the logic might be a little
  34 ;;; messier because genesis dumps both symbols and packages, and we'd
  35 ;;; need to make sure that dumped symbols were renamed in the same way
  36 ;;; as dumped packages. Or we could do it in cold init, but it's
  37 ;;; easier to experiment with and debug things here in warm init than
  38 ;;; in cold init, so we do it here instead.)
  39 (let ((boot-prefix "SB!")
  40       (perm-prefix "SB-"))
  41   (dolist (package (list-all-packages))
  42     (let ((old-package-name (package-name package)))
  43       (when (and (>= (length old-package-name) (length boot-prefix))
  44                  (string= boot-prefix old-package-name
  45                           :end2 (length boot-prefix)))
  46         (let ((new-package-name (concatenate 'string
  47                                              perm-prefix
  48                                              (subseq old-package-name
  49                                                      (length boot-prefix)))))
  50           (rename-package package
  51                           new-package-name
  52                           (package-nicknames package)))))))
  53
  54 ;;; FIXME: This nickname is a deprecated hack for backwards
  55 ;;; compatibility with code which assumed the CMU-CL-style
  56 ;;; SB-ALIEN/SB-C-CALL split. That split went away and was deprecated
  57 ;;; in 0.7.0, so we should get rid of this nickname after a while.
  58 (let ((package (find-package "SB-ALIEN")))
  59   (rename-package package
  60                   (package-name package)
  61                   (cons "SB-C-CALL" (package-nicknames package))))
  62
  63 ;;; KLUDGE: This is created here (instead of in package-data-list.lisp-expr)
  64 ;;; because it doesn't have any symbols in it, so even if it's
  65 ;;; present at cold load time, genesis thinks it's unimportant
  66 ;;; and doesn't dump it. There's gotta be a better way, but for now
  67 ;;; I'll just do it here. (As noted below, I'd just as soon have this
  68 ;;; go away entirely, so I'm disinclined to fiddle with it too much.)
  69 ;;; -- WHN 19991206
  70 ;;;
  71 ;;; FIXME: Why do slot accessor names need to be interned anywhere? For
  72 ;;; low-level debugging? Perhaps this should go away, or at least
  73 ;;; be optional, controlled by SB-SHOW or something.
  74 (defpackage "SB-SLOT-ACCESSOR-NAME"
  75   (:use))
  76 \f
  77 ;;;; compiling and loading more of the system
  78
  79 ;;; KLUDGE: In SBCL, almost all in-the-flow-of-control package hacking has
  80 ;;; gone away in favor of package setup controlled by tables. However, that
  81 ;;; mechanism isn't smart enough to handle shadowing, and since this shadowing
  82 ;;; is inherently a non-ANSI KLUDGE anyway (i.e. there ought to be no
  83 ;;; difference between e.g. CL:CLASS and SB-PCL:CLASS) there's not much
  84 ;;; point in trying to polish it by implementing a non-KLUDGEy way of
  85 ;;; setting it up. -- WHN 19991203
  86 (let ((*package* (the package (find-package "SB-PCL"))))
  87   (shadow '(;; CLASS itself and operations thereon
  88             "CLASS" "CLASS-NAME" "CLASS-OF" "FIND-CLASS"
  89             ;; some system classes
  90             "BUILT-IN-CLASS" "STANDARD-CLASS" "STRUCTURE-CLASS"))
  91   ;; Of the shadowing symbols above, these are external symbols in CMU CL ca.
  92   ;; 19991203. I'm not sure what's the basis of the decision to export some and
  93   ;; not others; we'll just follow along..
  94   (export (mapcar #'intern '("CLASS-NAME" "CLASS-OF" "FIND-CLASS"))))
  95
  96 ;;; FIXME: CMU CL's pclcom.lisp had extra optional stuff wrapped around
  97 ;;; COMPILE-PCL, at least some of which we should probably have too:
  98 ;;;
  99 ;;; (with-compilation-unit
 100 ;;;     (:optimize '(optimize (debug #+(and (not high-security) small) .5
 101 ;;;                               #-(or high-security small) 2
 102 ;;;                               #+high-security 3)
 103 ;;;                        (speed 2) (safety #+(and (not high-security) small) 0
 104 ;;;                                          #-(or high-security small) 2
 105 ;;;                                          #+high-security 3)
 106 ;;;                        (inhibit-warnings 2))
 107 ;;;      :optimize-interface '(optimize-interface #+(and (not high-security) small)
 108 ;;; (safety 1)
 109 ;;;                                            #+high-security (safety 3))
 110 ;;;      :context-declarations
 111 ;;;      '((:external (declare (optimize-interface (safety #-high-security 2 #+high-
 112 ;;; security 3)
 113 ;;;                                             (debug #-high-security 1 #+high-s
 114 ;;; ecurity 3))))
 115 ;;;     ((:or :macro (:match "$EARLY-") (:match "$BOOT-"))
 116 ;;;     (declare (optimize (speed 0))))))
 117 ;;;
 118 ;;; FIXME: This has mutated into a hack which crudely duplicates
 119 ;;; functionality from the existing mechanism to load files from
 120 ;;; build-order.lisp-expr, without being quite parallel. (E.g. object
 121 ;;; files end up alongside the source files instead of ending up in
 122 ;;; parallel directory trees.) Maybe we could merge the filenames here
 123 ;;; into build-order.lisp-expr with some new flag (perhaps :WARM) to
 124 ;;; indicate that the files should be handled not in cold load but
 125 ;;; afterwards.
 126 (dolist (stem '(;; CLOS, derived from the PCL reference implementation
 127                 ;;
 128                 ;; This PCL build order is based on a particular
 129                 ;; (arbitrary) linearization of the declared build
 130                 ;; order dependencies from the old PCL defsys.lisp
 131                 ;; dependency database.
 132                 "src/pcl/walk"
 133                 "src/pcl/early-low"
 134                 "src/pcl/macros"
 135                 "src/pcl/compiler-support"
 136                 "src/pcl/low"
 137                 "src/pcl/slot-name"
 138                 "src/pcl/defclass"
 139                 "src/pcl/defs"
 140                 "src/pcl/fngen"
 141                 "src/pcl/cache"
 142                 "src/pcl/dlisp"
 143                 "src/pcl/dlisp2"
 144                 "src/pcl/boot"
 145                 "src/pcl/vector"
 146                 "src/pcl/slots-boot"
 147                 "src/pcl/combin"
 148                 "src/pcl/dfun"
 149                 "src/pcl/fast-init"
 150                 "src/pcl/braid"
 151                 "src/pcl/dlisp3"
 152                 "src/pcl/generic-functions"
 153                 "src/pcl/slots"
 154                 "src/pcl/init"
 155                 "src/pcl/std-class"
 156                 "src/pcl/cpl"
 157                 "src/pcl/fsc"
 158                 "src/pcl/methods"
 159                 "src/pcl/fixup"
 160                 "src/pcl/defcombin"
 161                 "src/pcl/ctypes"
 162                 "src/pcl/env"
 163                 "src/pcl/documentation"
 164                 "src/pcl/print-object"
 165                 "src/pcl/precom1"
 166                 "src/pcl/precom2"
 167
 168                 ;; miscellaneous functionality which depends on CLOS
 169                 "src/code/force-delayed-defbangmethods"
 170
 171                 ;; CLOS-level support for the Gray OO streams
 172                 ;; extension (which is also supported by various
 173                 ;; lower-level hooks elsewhere in the code)
 174                 "src/pcl/gray-streams-class"
 175                 "src/pcl/gray-streams"
 176
 177                 ;; other functionality not needed for cold init, moved
 178                 ;; to warm init to reduce peak memory requirement in
 179                 ;; cold init
 180                 "src/code/describe"
 181                 "src/code/inspect"
 182                 "src/code/profile"
 183                 "src/code/ntrace"
 184                 "src/code/foreign"
 185                 "src/code/run-program"
 186
 187                 ;; Code derived from PCL's pre-ANSI DESCRIBE-OBJECT
 188                 ;; facility is still used in our ANSI DESCRIBE
 189                 ;; facility, and should be compiled and loaded after
 190                 ;; our DESCRIBE facility is compiled and loaded.
 191                 "src/pcl/describe"))
 192
 193   (let ((fullname (concatenate 'string stem ".lisp")))
 194     (sb-int:/show "about to compile" fullname)
 195     (multiple-value-bind
 196         (compiled-truename compilation-warnings-p compilation-failure-p)
 197         (compile-file fullname)
 198       (declare (ignore compilation-warnings-p))
 199       (sb-int:/show "done compiling" fullname)
 200       (cond (compilation-failure-p
 201              (error "COMPILE-FILE of ~S failed." fullname))
 202             (t
 203              (unless (load compiled-truename)
 204                (error "LOAD of ~S failed." compiled-truename))
 205              (sb-int:/show "done loading" compiled-truename))))))
 206 \f
 207 ;;;; setting package documentation
 208
 209 ;;; While we were running on the cross-compilation host, we tried to
 210 ;;; be portable and not overwrite the doc strings for the standard
 211 ;;; packages. But now the cross-compilation host is only a receding
 212 ;;; memory, and we can have our way with the doc strings.
 213 (sb-int:/show "setting package documentation")
 214 #+sb-doc (setf (documentation (find-package "COMMON-LISP") t)
 215 "public: home of symbols defined by the ANSI language specification")
 216 #+sb-doc (setf (documentation (find-package "COMMON-LISP-USER") t)
 217                "public: the default package for user code and data")
 218 #+sb-doc (setf (documentation (find-package "KEYWORD") t)
 219                "public: home of keywords")
 220
 221 ;;; KLUDGE: It'd be nicer to do this in the table with the other
 222 ;;; non-standard packages. -- WHN 19991206
 223 #+sb-doc (setf (documentation (find-package "SB-SLOT-ACCESSOR-NAME") t)
 224                "private: home of CLOS slot accessor internal names")
 225
 226 ;;; FIXME: There doesn't seem to be any easy way to get package doc strings
 227 ;;; through the cold boot process. They need to be set somewhere. Maybe the
 228 ;;; easiest thing to do is to read them out of package-data-list.lisp-expr
 229 ;;; now?