1.0.6.46: better standard-specializer-p implementation
[sbcl.git] / 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 (proclaim '(optimize (compilation-speed 1)
17                      (debug #+sb-show 2 #-sb-show 1)
18                      (inhibit-warnings 2)
19                      (safety 2)
20                      (space 1)
21                      (speed 2)))
22
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 (let ((package (find-package "SB-SEQUENCE")))
64   (rename-package package (package-name package) (list "SEQUENCE")))
65 \f
66 ;;;; compiling and loading more of the system
67
68 (let* ((sys *default-pathname-defaults*)
69        (src
70         (merge-pathnames
71          (make-pathname :directory '(:relative "src" :wild-inferiors)
72                         :name :wild :type :wild)
73          sys))
74        (contrib
75         (merge-pathnames
76          (make-pathname :directory '(:relative "contrib" :wild-inferiors)
77                         :name :wild :type :wild)
78          sys)))
79   (setf (logical-pathname-translations "SYS")
80         `(("SYS:SRC;**;*.*.*" ,src)
81           ("SYS:CONTRIB;**;*.*.*" ,contrib))))
82
83 ;;; FIXME: CMU CL's pclcom.lisp had extra optional stuff wrapped around
84 ;;; COMPILE-PCL, at least some of which we should probably have too:
85 ;;;
86 ;;; (with-compilation-unit
87 ;;;     (:optimize '(optimize (debug #+(and (not high-security) small) .5
88 ;;;                               #-(or high-security small) 2
89 ;;;                               #+high-security 3)
90 ;;;                        (speed 2) (safety #+(and (not high-security) small) 0
91 ;;;                                          #-(or high-security small) 2
92 ;;;                                          #+high-security 3)
93 ;;;                        (inhibit-warnings 2))
94 ;;;      :optimize-interface '(optimize-interface #+(and (not high-security) small)
95 ;;; (safety 1)
96 ;;;                                            #+high-security (safety 3))
97 ;;;      :context-declarations
98 ;;;      '((:external (declare (optimize-interface (safety #-high-security 2 #+high-
99 ;;; security 3)
100 ;;;                                             (debug #-high-security 1 #+high-s
101 ;;; ecurity 3))))
102 ;;;     ((:or :macro (:match "$EARLY-") (:match "$BOOT-"))
103 ;;;     (declare (optimize (speed 0))))))
104 ;;;
105 ;;; FIXME: This has mutated into a hack which crudely duplicates
106 ;;; functionality from the existing mechanism to load files from
107 ;;; build-order.lisp-expr, without being quite parallel. (E.g. object
108 ;;; files end up alongside the source files instead of ending up in
109 ;;; parallel directory trees.) Maybe we could merge the filenames here
110 ;;; into build-order.lisp-expr with some new flag (perhaps :WARM) to
111 ;;; indicate that the files should be handled not in cold load but
112 ;;; afterwards.
113 (dolist (stem '(;; CLOS, derived from the PCL reference implementation
114                 ;;
115                 ;; This PCL build order is based on a particular
116                 ;; (arbitrary) linearization of the declared build
117                 ;; order dependencies from the old PCL defsys.lisp
118                 ;; dependency database.
119                 #+nil "src/pcl/walk" ; #+NIL = moved to build-order.lisp-expr
120                 "SRC;PCL;EARLY-LOW"
121                 "SRC;PCL;MACROS"
122                 "SRC;PCL;COMPILER-SUPPORT"
123                 "SRC;PCL;LOW"
124                 "SRC;PCL;SLOT-NAME"
125                 "SRC;PCL;DEFCLASS"
126                 "SRC;PCL;DEFS"
127                 "SRC;PCL;FNGEN"
128                 "SRC;PCL;WRAPPER"
129                 "SRC;PCL;CACHE"
130                 "SRC;PCL;DLISP"
131                 "SRC;PCL;BOOT"
132                 "SRC;PCL;VECTOR"
133                 "SRC;PCL;SLOTS-BOOT"
134                 "SRC;PCL;COMBIN"
135                 "SRC;PCL;DFUN"
136                 "SRC;PCL;CTOR"
137                 "SRC;PCL;BRAID"
138                 "SRC;PCL;DLISP3"
139                 "SRC;PCL;GENERIC-FUNCTIONS"
140                 "SRC;PCL;SLOTS"
141                 "SRC;PCL;INIT"
142                 "SRC;PCL;STD-CLASS"
143                 "SRC;PCL;CPL"
144                 "SRC;PCL;FSC"
145                 "SRC;PCL;METHODS"
146                 "SRC;PCL;FIXUP"
147                 "SRC;PCL;DEFCOMBIN"
148                 "SRC;PCL;CTYPES"
149                 "SRC;PCL;ENV"
150                 "SRC;PCL;DOCUMENTATION"
151                 "SRC;PCL;PRINT-OBJECT"
152                 "SRC;PCL;PRECOM1"
153                 "SRC;PCL;PRECOM2"
154
155                 ;; miscellaneous functionality which depends on CLOS
156                 "SRC;CODE;FORCE-DELAYED-DEFBANGMETHODS"
157                 "SRC;CODE;LATE-CONDITION"
158
159                 ;; CLOS-level support for the Gray OO streams
160                 ;; extension (which is also supported by various
161                 ;; lower-level hooks elsewhere in the code)
162                 "SRC;PCL;GRAY-STREAMS-CLASS"
163                 "SRC;PCL;GRAY-STREAMS"
164
165                 ;; CLOS-level support for User-extensible sequences.
166                 "SRC;PCL;SEQUENCE"
167
168                 ;; other functionality not needed for cold init, moved
169                 ;; to warm init to reduce peak memory requirement in
170                 ;; cold init
171                 "SRC;CODE;DESCRIBE"
172                 "SRC;CODE;DESCRIBE-POLICY"
173                 "SRC;CODE;INSPECT"
174                 "SRC;CODE;PROFILE"
175                 "SRC;CODE;NTRACE"
176                 "SRC;CODE;STEP"
177                 "SRC;CODE;RUN-PROGRAM"
178
179                 ;; Code derived from PCL's pre-ANSI DESCRIBE-OBJECT
180                 ;; facility is still used in our ANSI DESCRIBE
181                 ;; facility, and should be compiled and loaded after
182                 ;; our DESCRIBE facility is compiled and loaded.
183                 "SRC;PCL;DESCRIBE"))
184
185   (let ((fullname (concatenate 'string "SYS:" stem ".LISP")))
186     (sb-int:/show "about to compile" fullname)
187     (flet ((report-recompile-restart (stream)
188              (format stream "Recompile file ~S" fullname))
189            (report-continue-restart (stream)
190              (format stream
191                      "Continue, using possibly bogus file ~S"
192                      (compile-file-pathname fullname))))
193       (tagbody
194        retry-compile-file
195          (multiple-value-bind (output-truename warnings-p failure-p)
196              (if *compile-files-p*
197                  (compile-file fullname)
198                  (compile-file-pathname fullname))
199            (declare (ignore warnings-p))
200            (sb-int:/show "done compiling" fullname)
201            (cond ((not output-truename)
202                   (error "COMPILE-FILE of ~S failed." fullname))
203                  (failure-p
204                   (unwind-protect
205                        (restart-case
206                            (error "FAILURE-P was set when creating ~S."
207                                   output-truename)
208                          (recompile ()
209                            :report report-recompile-restart
210                            (go retry-compile-file))
211                          (continue ()
212                            :report report-continue-restart
213                            (setf failure-p nil)))
214                     ;; Don't leave failed object files lying around.
215                     (when (and failure-p (probe-file output-truename))
216                           (delete-file output-truename)
217                           (format t "~&deleted ~S~%" output-truename))))
218                  ;; Otherwise: success, just fall through.
219                  (t nil))
220            (unless (load output-truename)
221              (error "LOAD of ~S failed." output-truename))
222            (sb-int:/show "done loading" output-truename))))))
223 \f
224 ;;;; setting package documentation
225
226 ;;; While we were running on the cross-compilation host, we tried to
227 ;;; be portable and not overwrite the doc strings for the standard
228 ;;; packages. But now the cross-compilation host is only a receding
229 ;;; memory, and we can have our way with the doc strings.
230 (sb-int:/show "setting package documentation")
231 #+sb-doc (setf (documentation (find-package "COMMON-LISP") t)
232 "public: home of symbols defined by the ANSI language specification")
233 #+sb-doc (setf (documentation (find-package "COMMON-LISP-USER") t)
234                "public: the default package for user code and data")
235 #+sb-doc (setf (documentation (find-package "KEYWORD") t)
236                "public: home of keywords")
237 \f
238