worldload.lisp 8.97 KB
Newer Older
ram's avatar
ram committed
1 2 3
;;; -*- Mode: Lisp; Package: Lisp; Log: code.log -*-
;;;
;;; **********************************************************************
4 5 6 7 8
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
9
;;; $Header: src/tools/worldload.lisp $
10
;;;
ram's avatar
ram committed
11 12 13 14
;;; **********************************************************************
;;;
;;; This file loads the parts of the system that aren't cold loaded and saves
;;; the resulting core image.  It writes "lisp.core" in the DEFAULT-DIRECTORY.
15

ram's avatar
ram committed
16 17 18 19 20
;;; Make sure the core will start up in the user package.
(lisp::assert-user-package)

(in-package "LISP")

21 22 23
;;; Since it is unlikely that native code top-level forms are moved
;;; before being executed during worldload it is probably safe to load
;;; these into the dynamic space under CGC even without enabling
dtc's avatar
dtc committed
24
;;; dynamic space code below.
25 26 27 28
;(setf *load-x86-tlf-to-dynamic-space* t)

;;; Purify and GENCGC can move native code so all code can be loading
;;; into the dynamic space during worldload; overrides the above when
29 30
;;; enabled. Enable by default for GENCGC.  May also be safe with CGC
;;; but untested.
31
;(setf lisp::*enable-dynamic-space-code* t)
32

33

ram's avatar
ram committed
34 35 36 37 38 39
;;; Get some data on this core.
;;;
(write-string "What is the current lisp-implementation-version? ")
(force-output)
(set '*lisp-implementation-version* (read-line))

40
;;; Load the rest of the reader (maybe byte-compiled.)
41 42
(maybe-byte-load "target:code/sharpm")
(maybe-byte-load "target:code/backq")
43
(maybe-byte-load "target:code/pprint-loop")
44 45
(setq std-lisp-readtable (copy-readtable *readtable*))

46 47 48 49 50 51
;;; The pretty printer is part of the kernel core, but we don't turn it in
;;; until now.
;;;
(pp::pprint-init)


52 53 54
(maybe-byte-load "target:code/extensions")
(maybe-byte-load "target:code/defmacro")
(maybe-byte-load "target:code/sysmacs")
55

56
;;; Define a bunch of search lists relative to target:
ram's avatar
ram committed
57
;;;
58 59
(setf (ext:search-list "code:") '("target:code/"))
(setf (ext:search-list "c:") '("target:compiler/"))
60
(setf (ext:search-list "vm:")
hallgren's avatar
hallgren committed
61
      '(#+(or pmax sgi) "c:mips/"
62
        #+sparc "c:sparc/"
wlott's avatar
wlott committed
63
	#+rt "c:rt/"
wlott's avatar
wlott committed
64 65
	#+hppa "c:hppa/"
	#+x86 "c:x86/"
cwang's avatar
cwang committed
66
	#+amd64 "c:amd64/"
hallgren's avatar
hallgren committed
67
	#+alpha "c:alpha/"
68
	#+ppc "c:ppc/"
69 70
	"c:generic/"))
(setf (ext:search-list "assem:")
hallgren's avatar
hallgren committed
71
      '(#+(or pmax sgi) "target:assembly/mips/"
72 73 74 75
	#+sparc "target:assembly/sparc/"
	#+rt "target:assembly/rt/"
	#+hppa "target:assembly/hppa/"
	#+x86 "target:assembly/x86/"
cwang's avatar
cwang committed
76
	#+amd64 "target:assembly/amd64/"
hallgren's avatar
hallgren committed
77
	#+alpha "target:assembly/alpha/"
78
	#+ppc "target:assembly/ppc/"
79 80 81 82 83
	"target:assembly/"))
(setf (ext:search-list "hem:") '("target:hemlock/"))
(setf (ext:search-list "clx:") '("target:clx/"))
(setf (ext:search-list "pcl:") '("target:pcl/"))
(setf (ext:search-list "tools:") '("target:tools/"))
84 85

;;; Make sure the package structure is correct.
ram's avatar
ram committed
86
;;;
87
(maybe-byte-load "code:exports")
88 89

;;; Load random code sources.
90

91 92 93 94 95 96 97 98
(maybe-byte-load "code:format-time")
(maybe-byte-load "code:parse-time")
#-gengc (maybe-byte-load "code:purify")
(maybe-byte-load "code:commandline")
(maybe-byte-load "code:sort")
(maybe-byte-load "code:time")
(maybe-byte-load "code:tty-inspect")
(maybe-byte-load "code:describe")
99 100 101 102 103 104
#+random-mt19937
(maybe-byte-load "code:rand-mt19937")
#+random-xoroshiro
(maybe-byte-load "code:rand-xoroshiro")
#-(or random-mt19937 random-xoroshiro)
(maybe-byte-load "code:rand")
105
(maybe-byte-load "target:pcl/walk")
106
(maybe-byte-load "code:fwrappers")
107 108 109 110 111 112 113 114 115 116 117 118 119
(maybe-byte-load "code:ntrace")
#-runtime (maybe-byte-load "code:profile")
(maybe-byte-load "code:weak")
(maybe-byte-load "code:final")
(maybe-byte-load "code:sysmacs")
#-gengc (maybe-byte-load "code:run-program")
(maybe-byte-load "code:query")
#-runtime (maybe-byte-load "code:internet")
#-runtime (maybe-byte-load "code:wire")
#-runtime (maybe-byte-load "code:remote")
(maybe-byte-load "code:foreign")
(maybe-byte-load "code:setf-funs")
(maybe-byte-load "code:module")
120
(maybe-byte-load "code:loop")
121
(maybe-byte-load "code:dfixnum")
122
#-(or gengc runtime) (maybe-byte-load "code:room")
123
(maybe-byte-load "code:stream-vector-io")
124

125
(maybe-byte-load "code:extfmts")
126 127
(maybe-byte-load "code:env-access")

ram's avatar
ram committed
128
;;; Overwrite some cold-loaded stuff with byte-compiled versions, if any.
129
#-(or gengc cgc)	; x86/cgc has stuff in static space.
130 131 132 133
(progn
  (byte-load-over "target:code/debug")
  (byte-load-over "target:code/error")
  (maybe-byte-load "target:code/pprint" nil)
134
  (maybe-byte-load "target:code/pprint-loop" nil)
135 136 137 138 139
  (maybe-byte-load "target:code/format" nil)
  (maybe-byte-load "target:code/reader" nil)
  (maybe-byte-load "target:code/pathname" nil)
  (maybe-byte-load "target:code/filesys" nil)
  (maybe-byte-load "target:code/macros" nil))
ram's avatar
ram committed
140

141
(purify :root-structures
142 143
	`(lisp::%top-level extensions:save-lisp ,lisp::fop-codes)
	:environment-name "Kernel")
144

145
;;; Load the compiler.
146
#-(or no-compiler runtime)
147
(progn
148
  (maybe-byte-load "c:loadcom.lisp")
149 150
  (purify :root-structures '(compile-file)
	  :environment-name "Compiler")
151

152
  (maybe-byte-load "c:loadbackend.lisp")
153
  ;;
154
  ;; If we want a small core, blow away the meta-compile time VOP info.
155
  ;; Redundant clrhash to work around gc leakage.
156 157 158 159 160
  #+small
  (progn
    (clrhash (c::backend-parsed-vops c:*backend*))
    (setf (c::backend-parsed-vops c:*backend*)
	  (make-hash-table :test #'eq)))
161

162 163 164
  (purify :root-structures (list c:*backend*)
	  :environment-name (concatenate 'string (c:backend-name c:*backend*)
					 " backend")))
165

166 167 168 169 170
;; extfmts needs the compiler
;;#-(or no-compiler runtime unicode-bootstrap)
#+(and unicode (not (or unicode-bootstrap no-compiler runtime)))
(maybe-byte-load "code:fd-stream-extfmt")

171 172
(maybe-byte-load "code:fd-stream-comp")

173 174
(maybe-byte-load "target:code/intl")

175 176 177
#+alien-callback
(maybe-byte-load "target:code/alien-callback")

178

179 180 181 182
;;; PCL.
;;;
#-(or no-pcl runtime) (maybe-byte-load "pcl:pclload")

ram's avatar
ram committed
183 184
;;; CLX.
;;;
185 186
#-(or no-clx runtime)
(maybe-byte-load "clx:clx-library")
ram's avatar
ram committed
187 188 189

;;; Hemlock.
;;;
190 191
#-(or no-hemlock runtime)
(maybe-byte-load "target:hemlock/hemlock-library")
ram's avatar
ram committed
192

193 194
;;; CLM.
;;;
195 196
#-(or no-clm runtime)
(maybe-byte-load "target:interface/clm-library")
197

198 199
#+(or no-compiler runtime) (proclaim '(special *target-sl*))
#-(or no-compiler runtime) (defvar *target-sl*)
200
(setq *target-sl* (search-list "target:"))
201

202 203
#+(or no-compiler runtime) (proclaim '(special *target-core-name*))
#-(or no-compiler runtime) (defvar *target-core-name*)
204 205 206 207 208 209 210
(setq *target-core-name*
      (unix-namestring (if (c:backend-featurep :x86)
			   (if (c:backend-featurep :sse2)
			       "target:lisp/lisp-sse2.core"
			       "target:lisp/lisp-x87.core")
			   "target:lisp/lisp.core")
		       nil))
211

212
;;; Don't include the search lists used for loading in the resultant core.
ram's avatar
ram committed
213
;;;
214
(lisp::clear-all-search-lists)
215 216

;;; Set up a default for modules and target:
217 218
;;; 
(setf (search-list "modules:") '("./"))
219
(setf (search-list "target:") *target-sl*)
ram's avatar
ram committed
220

221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238
;;; Remove temporarily added OLD-XX nicknames
#+pmax
(rename-package "PMAX" "PMAX" '("VM"))
#+sparc
(rename-package "SPARC" "SPARC" '("VM"))
#+ibmrt
(rename-package "RT" "RT" '("VM"))
#+x86
(rename-package "X86" "X86" '("VM"))
#+hppa
(rename-package "HPPA" "HPPA" '("VM"))
#+alpha
(rename-package "ALPHA" "ALPHA" '("VM"))
#+sgi
(rename-package "SGI" "SGI" '("VM"))
#+ppc
(rename-package "PPC" "PPC" '("VM"))

ram's avatar
ram committed
239 240
;;; Okay, build the thing!
;;;
241
(progn
242
  ;; We want to be in the USER package when the command line switches run.
243
  (in-package "CL-USER")
244
  ;; Clean random top-level specials.
245 246 247 248 249 250 251 252 253 254
  (setq - nil)
  (setq + nil)
  (setq * nil)
  (setq / nil)
  (setq ++ nil)
  (setq ** nil)
  (setq // nil)
  (setq +++ nil)
  (setq *** nil)
  (setq /// nil)
255 256 257 258
  ;; 
  ;; Enable the garbage collector.  But first fake it into thinking that
  ;; we don't need to garbage collect.  The save-lisp is going to call purify
  ;; so any garbage will be collected then.
259 260
  #-gengc (setf *need-to-collect-garbage* nil)
  #-gengc (gc-on)
261 262
  (setf *gc-run-time* 0)

263 264 265 266 267 268 269 270
  ;; Disable the loading of native code top level forms into the
  ;; dynamic space under CGC as it is potentially dangerous if a
  ;; native code top level form is executed after being moved without
  ;; fixups.
  #+x86 (setf *load-x86-tlf-to-dynamic-space* nil)

  ;;; GENCGC can move native code so all code can be loaded into the
  ;;; dynamic space; overrides the above when enabled.
271
  #+gencgc (setf lisp::*enable-dynamic-space-code* t)
272
  ;;; Reset the counter of the number of native code fixups.
273 274
  #+x86 (setf x86::*num-fixups* 0)

275 276 277
  ;; Maybe enable ANSI defstruct :print-function/:print-object processing
  #-NO-PCL
  (setq ext:*ansi-defstruct-options-p* t)
278
  ;;
279
  ;; Save the lisp.  If RUNTIME, there is nothing new to purify, so don't.
280 281 282 283 284 285 286
  ;; the following features are only used to control the build
  ;; process, so we remove them from the generated image
  (setq *features*
	(nreverse
	 (set-difference
	  *features* 
	  '(:runtime :no-compiler :no-pcl :no-clx :no-clm :no-hemlock))))
287
  (save-lisp *target-core-name*
288 289 290 291
             :root-structures
             #-(or runtime no-hemlock) `(ed ,hi::*global-command-table*)
             #+(or runtime no-hemlock) ()
             :purify #+runtime nil #-runtime t))