/[cmucl]/src/tools/worldload.lisp
ViewVC logotype

Contents of /src/tools/worldload.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.112 - (show annotations)
Tue Jul 20 21:34:30 2010 UTC (3 years, 8 months ago) by rtoy
Branch: MAIN
CVS Tags: release-20b-pre1, release-20b-pre2, GIT-CONVERSION, cross-sol-x86-merged, RELEASE_20b, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2010-08, cross-sol-x86-2010-12-20, cross-sparc-branch-base, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, cross-sol-x86-branch
Changes since 1.111: +3 -1 lines
Need to precompile the ef slots for both unicode and non-unicode
builds.  (This was broken in the 2010-04 snapshot.)

code/fd-stream-comp.lisp:
o Precompile ef slots there for ISO8859-1.

code/fd-stream-extfmts.lisp:
o Remove the precompile stuff.

tools/worldcom.lisp:
o Compile fd-stream-comp.

tools/worldload.lisp:
o Load fd-stream-comp.
1 ;;; -*- Mode: Lisp; Package: Lisp; Log: code.log -*-
2 ;;;
3 ;;; **********************************************************************
4 ;;; This code was written as part of the CMU Common Lisp project at
5 ;;; Carnegie Mellon University, and has been placed in the public domain.
6 ;;; If you want to use this code or any part of CMU Common Lisp, please contact
7 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
8 ;;;
9 ;;; $Header: /tiger/var/lib/cvsroots/cmucl/src/tools/worldload.lisp,v 1.112 2010/07/20 21:34:30 rtoy Rel $
10 ;;;
11 ;;; **********************************************************************
12 ;;;
13 ;;; This file loads the parts of the system that aren't cold loaded and saves
14 ;;; the resulting core image. It writes "lisp.core" in the DEFAULT-DIRECTORY.
15
16 ;;; Make sure the core will start up in the user package.
17 (lisp::assert-user-package)
18
19 (in-package "LISP")
20
21 ;;; Since it is unlikely that native code top-level forms are moved
22 ;;; before being executed during worldload it is probably safe to load
23 ;;; these into the dynamic space under CGC even without enabling
24 ;;; dynamic space code below.
25 ;(setf *load-x86-tlf-to-dynamic-space* t)
26
27 ;;; Purify and GENCGC can move native code so all code can be loading
28 ;;; into the dynamic space during worldload; overrides the above when
29 ;;; enabled. Enable by default for GENCGC. May also be safe with CGC
30 ;;; but untested.
31 ;(setf lisp::*enable-dynamic-space-code* t)
32
33
34 ;;; Get some data on this core.
35 ;;;
36 (write-string "What is the current lisp-implementation-version? ")
37 (force-output)
38 (set '*lisp-implementation-version* (read-line))
39
40 ;;; Load the rest of the reader (maybe byte-compiled.)
41 (maybe-byte-load "target:code/sharpm")
42 (maybe-byte-load "target:code/backq")
43 (maybe-byte-load "target:code/pprint-loop")
44 (setq std-lisp-readtable (copy-readtable *readtable*))
45
46 ;;; The pretty printer is part of the kernel core, but we don't turn it in
47 ;;; until now.
48 ;;;
49 (pp::pprint-init)
50
51
52 (maybe-byte-load "target:code/extensions")
53 (maybe-byte-load "target:code/defmacro")
54 (maybe-byte-load "target:code/sysmacs")
55
56 ;;; Define a bunch of search lists relative to target:
57 ;;;
58 (setf (ext:search-list "code:") '("target:code/"))
59 (setf (ext:search-list "c:") '("target:compiler/"))
60 (setf (ext:search-list "vm:")
61 '(#+(or pmax sgi) "c:mips/"
62 #+sparc "c:sparc/"
63 #+rt "c:rt/"
64 #+hppa "c:hppa/"
65 #+x86 "c:x86/"
66 #+amd64 "c:amd64/"
67 #+alpha "c:alpha/"
68 #+ppc "c:ppc/"
69 "c:generic/"))
70 (setf (ext:search-list "assem:")
71 '(#+(or pmax sgi) "target:assembly/mips/"
72 #+sparc "target:assembly/sparc/"
73 #+rt "target:assembly/rt/"
74 #+hppa "target:assembly/hppa/"
75 #+x86 "target:assembly/x86/"
76 #+amd64 "target:assembly/amd64/"
77 #+alpha "target:assembly/alpha/"
78 #+ppc "target:assembly/ppc/"
79 "target:assembly/"))
80 (setf (ext:search-list "hem:") '("target:hemlock/"))
81 (setf (ext:search-list "clx:") '("target:clx/"))
82 (setf (ext:search-list "pcl:") '("target:pcl/"))
83 (setf (ext:search-list "tools:") '("target:tools/"))
84
85 ;;; Make sure the package structure is correct.
86 ;;;
87 (maybe-byte-load "code:exports")
88
89 ;;; Load random code sources.
90
91 (maybe-byte-load "code:format-time")
92 (maybe-byte-load "code:parse-time")
93 #-gengc (maybe-byte-load "code:purify")
94 (maybe-byte-load "code:commandline")
95 (maybe-byte-load "code:sort")
96 (maybe-byte-load "code:time")
97 (maybe-byte-load "code:tty-inspect")
98 (maybe-byte-load "code:describe")
99 #+random-mt19937 (maybe-byte-load "code:rand-mt19937")
100 #-random-mt19937 (maybe-byte-load "code:rand")
101 (maybe-byte-load "target:pcl/walk")
102 (maybe-byte-load "code:fwrappers")
103 (maybe-byte-load "code:ntrace")
104 #-runtime (maybe-byte-load "code:profile")
105 (maybe-byte-load "code:weak")
106 (maybe-byte-load "code:final")
107 (maybe-byte-load "code:sysmacs")
108 #-gengc (maybe-byte-load "code:run-program")
109 (maybe-byte-load "code:query")
110 #-runtime (maybe-byte-load "code:internet")
111 #-runtime (maybe-byte-load "code:wire")
112 #-runtime (maybe-byte-load "code:remote")
113 (maybe-byte-load "code:foreign")
114 (maybe-byte-load "code:setf-funs")
115 (maybe-byte-load "code:module")
116 (maybe-byte-load "code:loop")
117 (maybe-byte-load "code:dfixnum")
118 #-(or gengc runtime) (maybe-byte-load "code:room")
119 (maybe-byte-load "code:stream-vector-io")
120
121 (maybe-byte-load "code:extfmts")
122 (maybe-byte-load "code:env-access")
123
124 ;;; Overwrite some cold-loaded stuff with byte-compiled versions, if any.
125 #-(or gengc cgc) ; x86/cgc has stuff in static space.
126 (progn
127 (byte-load-over "target:code/debug")
128 (byte-load-over "target:code/error")
129 (maybe-byte-load "target:code/pprint" nil)
130 (maybe-byte-load "target:code/pprint-loop" nil)
131 (maybe-byte-load "target:code/format" nil)
132 (maybe-byte-load "target:code/reader" nil)
133 (maybe-byte-load "target:code/pathname" nil)
134 (maybe-byte-load "target:code/filesys" nil)
135 (maybe-byte-load "target:code/macros" nil))
136
137 (purify :root-structures
138 `(lisp::%top-level extensions:save-lisp ,lisp::fop-codes)
139 :environment-name "Kernel")
140
141 ;;; Load the compiler.
142 #-(or no-compiler runtime)
143 (progn
144 (maybe-byte-load "c:loadcom.lisp")
145 (purify :root-structures '(compile-file)
146 :environment-name "Compiler")
147
148 (maybe-byte-load "c:loadbackend.lisp")
149 ;;
150 ;; If we want a small core, blow away the meta-compile time VOP info.
151 ;; Redundant clrhash to work around gc leakage.
152 #+small
153 (progn
154 (clrhash (c::backend-parsed-vops c:*backend*))
155 (setf (c::backend-parsed-vops c:*backend*)
156 (make-hash-table :test #'eq)))
157
158 (purify :root-structures (list c:*backend*)
159 :environment-name (concatenate 'string (c:backend-name c:*backend*)
160 " backend")))
161
162 ;; extfmts needs the compiler
163 ;;#-(or no-compiler runtime unicode-bootstrap)
164 #+(and unicode (not (or unicode-bootstrap no-compiler runtime)))
165 (maybe-byte-load "code:fd-stream-extfmt")
166
167 (maybe-byte-load "code:fd-stream-comp")
168
169 (maybe-byte-load "target:code/intl")
170
171
172 ;;; PCL.
173 ;;;
174 #-(or no-pcl runtime) (maybe-byte-load "pcl:pclload")
175
176 ;;; CLX.
177 ;;;
178 #-(or no-clx runtime)
179 (maybe-byte-load "clx:clx-library")
180
181 ;;; Hemlock.
182 ;;;
183 #-(or no-hemlock runtime)
184 (maybe-byte-load "target:hemlock/hemlock-library")
185
186 ;;; CLM.
187 ;;;
188 #-(or no-clm runtime)
189 (maybe-byte-load "target:interface/clm-library")
190
191 #+(or no-compiler runtime) (proclaim '(special *target-sl*))
192 #-(or no-compiler runtime) (defvar *target-sl*)
193 (setq *target-sl* (search-list "target:"))
194
195 #+(or no-compiler runtime) (proclaim '(special *target-core-name*))
196 #-(or no-compiler runtime) (defvar *target-core-name*)
197 (setq *target-core-name*
198 (unix-namestring (if (c:backend-featurep :x86)
199 (if (c:backend-featurep :sse2)
200 "target:lisp/lisp-sse2.core"
201 "target:lisp/lisp-x87.core")
202 "target:lisp/lisp.core")
203 nil))
204
205 ;;; Don't include the search lists used for loading in the resultant core.
206 ;;;
207 (lisp::clear-all-search-lists)
208
209 ;;; Set up a default for modules and target:
210 ;;;
211 (setf (search-list "modules:") '("./"))
212 (setf (search-list "target:") *target-sl*)
213
214 ;;; Remove temporarily added OLD-XX nicknames
215 #+pmax
216 (rename-package "PMAX" "PMAX" '("VM"))
217 #+sparc
218 (rename-package "SPARC" "SPARC" '("VM"))
219 #+ibmrt
220 (rename-package "RT" "RT" '("VM"))
221 #+x86
222 (rename-package "X86" "X86" '("VM"))
223 #+hppa
224 (rename-package "HPPA" "HPPA" '("VM"))
225 #+alpha
226 (rename-package "ALPHA" "ALPHA" '("VM"))
227 #+sgi
228 (rename-package "SGI" "SGI" '("VM"))
229 #+ppc
230 (rename-package "PPC" "PPC" '("VM"))
231
232 ;;; Okay, build the thing!
233 ;;;
234 (progn
235 ;; We want to be in the USER package when the command line switches run.
236 (in-package "CL-USER")
237 ;; Clean random top-level specials.
238 (setq - nil)
239 (setq + nil)
240 (setq * nil)
241 (setq / nil)
242 (setq ++ nil)
243 (setq ** nil)
244 (setq // nil)
245 (setq +++ nil)
246 (setq *** nil)
247 (setq /// nil)
248 ;;
249 ;; Enable the garbage collector. But first fake it into thinking that
250 ;; we don't need to garbage collect. The save-lisp is going to call purify
251 ;; so any garbage will be collected then.
252 #-gengc (setf *need-to-collect-garbage* nil)
253 #-gengc (gc-on)
254 (setf *gc-run-time* 0)
255
256 ;; Disable the loading of native code top level forms into the
257 ;; dynamic space under CGC as it is potentially dangerous if a
258 ;; native code top level form is executed after being moved without
259 ;; fixups.
260 #+x86 (setf *load-x86-tlf-to-dynamic-space* nil)
261
262 ;;; GENCGC can move native code so all code can be loaded into the
263 ;;; dynamic space; overrides the above when enabled.
264 #+gencgc (setf lisp::*enable-dynamic-space-code* t)
265 ;;; Reset the counter of the number of native code fixups.
266 #+x86 (setf x86::*num-fixups* 0)
267
268 ;; Maybe enable ANSI defstruct :print-function/:print-object processing
269 #-NO-PCL
270 (setq ext:*ansi-defstruct-options-p* t)
271 ;;
272 ;; Save the lisp. If RUNTIME, there is nothing new to purify, so don't.
273 ;; the following features are only used to control the build
274 ;; process, so we remove them from the generated image
275 (setq *features*
276 (nreverse
277 (set-difference
278 *features*
279 '(:runtime :no-compiler :no-pcl :no-clx :no-clm :no-hemlock))))
280 (save-lisp *target-core-name*
281 :root-structures
282 #-(or runtime no-hemlock) `(ed ,hi::*global-command-table*)
283 #+(or runtime no-hemlock) ()
284 :purify #+runtime nil #-runtime t))

  ViewVC Help
Powered by ViewVC 1.1.5