worldload.lisp 5.86 KB
Newer Older
ram's avatar
ram committed
1
2
3
;;; -*- Mode: Lisp; Package: Lisp; Log: code.log -*-
;;;
;;; **********************************************************************
4
5
6
7
8
9
;;; 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.
;;;
(ext:file-comment
wlott's avatar
wlott committed
10
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldload.lisp,v 1.37 1991/12/07 00:54:19 wlott Exp $")
11
;;;
ram's avatar
ram committed
12
13
14
15
16
;;; **********************************************************************
;;;
;;; 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.
;;;
17
18
19
20
21
22
23
24
25
26
;;; ####### NOTE: HACK ALERT!!!!
;;; 
;;; This file must be loaded by:
;;;    (load (open "...worldload.lisp"))
;;;
;;; The OPEN call is needed to prevent the stream buffer from the previous
;;; incarnation (which is no longer valid) from being added to the stream
;;; buffer freelist.  If you don't do this, you will probably get a memory
;;; access violation when you first try to do file I/O in the new core.
;;;
ram's avatar
ram committed
27

28
;;; Define a bunch of search lists relative to lisp:
ram's avatar
ram committed
29
;;;
30
31
(setf (ext:search-list "code:") '("lisp:code/"))
(setf (ext:search-list "c:") '("lisp:compiler/"))
32
33
34
(setf (ext:search-list "vm:")
      '(#+pmax "c:mips/"
        #+sparc "c:sparc/"
wlott's avatar
wlott committed
35
	#+rt "c:rt/"
36
37
38
39
	"c:generic/"))
(setf (ext:search-list "assem:")
      '(#+pmax "lisp:assembly/mips/"
	#+sparc "lisp:assembly/sparc/"
wlott's avatar
wlott committed
40
	#+rt "lisp:assembly/rt/"
41
	"lisp:assembly/"))
42
(setf (ext:search-list "hem:") '("lisp:hemlock/"))
43
(setf (ext:search-list "clx:") '("lisp:clx/"))
44
(setf (ext:search-list "pcl:") '("lisp:pcl/"))
chiles's avatar
   
chiles committed
45
(setf (ext:search-list "tools:") '("lisp:tools/"))
46
47
48

;;; Make sure the core will start up in the user package.
(lisp::assert-user-package)
ram's avatar
ram committed
49

50
;;; We want to be in the LISP package for the rest of the file.
ram's avatar
ram committed
51
(in-package "LISP")
52
53

;;; Make sure the package structure is correct.
ram's avatar
ram committed
54
;;;
55
56
(load "code:exports")

ram's avatar
ram committed
57
58
59
;;; Get some data on this core.
;;;
(write-string "What is the current lisp-implementation-version? ")
60
(force-output)
ram's avatar
ram committed
61
62
63
64
65
(set '*lisp-implementation-version* (read-line))

;;; Keep us entertained...
(setq *load-verbose* t)

66
;;; Load random code sources.
67

ram's avatar
ram committed
68
69
(load "code:format-time")
(load "code:parse-time")
70
71
72
73
74
75
76
77
(load "code:purify")
(load "code:commandline")
(load "code:sort")
(load "code:time")
(load "code:tty-inspect")
(load "code:describe")
(load "code:rand")
(load "code:trace")
chiles's avatar
   
chiles committed
78
(load "code:ntrace")
ram's avatar
ram committed
79
(load "code:profile")
80
(load "code:weak")
wlott's avatar
wlott committed
81
(load "code:final")
82
83
(load "code:sysmacs")
(load "code:run-program")
84
(load "code:query")
wlott's avatar
wlott committed
85
(load "code:loop")
86
87
(load "code:syscall") ; syscall gets cold-loaded, but we need to re-run some
		      ; of the exports.
wlott's avatar
wlott committed
88
89
90
(load "code:internet")
(load "code:wire")
(load "code:remote")
91
(load "code:foreign")
92
(load "code:setf-funs")
ram's avatar
ram committed
93

94
;;; Load the compiler.
ram's avatar
ram committed
95
#-no-compiler
ram's avatar
ram committed
96
(load "c:loadcom.lisp")
97
98
99
#-no-compiler
;;; Depends on backend definition for object format info...
(load "code:room")
100
101
102
103
#-no-compiler
(set 'compiler-version
     (concatenate 'string compiler-version
		  "(" *lisp-implementation-version* ")"))
ram's avatar
ram committed
104

105
106
;;; Load the pretty printer after the compiler, 'cause it compiles stuff
;;; at load time.
wlott's avatar
wlott committed
107
108
109
110
#-no-pp
(load "code:pprint")
#-no-pp
(pp::pprint-init)
111

ram's avatar
ram committed
112
113
;;; CLX.
;;;
114
#-no-clx
ram's avatar
ram committed
115
(load "clx:defsystem")
116
117
118
119
#-no-clx
(xlib:load-clx (pathname "clx:"))
#-no-clx
(load "code:clx-ext")
ram's avatar
ram committed
120
121
#-no-clx
(load "code:inspect")
ram's avatar
ram committed
122
123
124

;;; Hemlock.
;;;
125
#-no-hemlock
chiles's avatar
   
chiles committed
126
(load "tools:hemload.lisp")
127
#-no-hemlock
128
(load "hem:rompsite") ;Contains site-init stuff called at load time.
129
#-no-hemlock
ram's avatar
ram committed
130
(hi::build-hemlock)
131
132
#-no-hemlock
(set '*hemlock-version*
chiles's avatar
   
chiles committed
133
     (concatenate 'string *hemlock-version* " "
134
		  "(" *lisp-implementation-version* ")"))
ram's avatar
ram committed
135

136
#|
137
138
Don't install any dir translations, 'cause we want the real things.

ram's avatar
ram committed
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
;;; Setup definition editing defaults to look in the stable AFS directory.
;;; The first translation says what we want most clearly, but we require
;;; the others due to symbol links.
;;;
(ed::add-definition-dir-translation "/afs/cs/project/clisp/systems-work/"
				    "/afs/cs/project/clisp/systems/")
(ed::add-definition-dir-translation "/afs/cs/project/clisp-1/systems-work/"
				    "/afs/cs/project/clisp/systems/")
(ed::add-definition-dir-translation
 "/afs/cs.cmu.edu/project/clisp-1/systems-work/"
 "/afs/cs/project/clisp/systems/")
(ed::add-definition-dir-translation
 "/afs/cs.cmu.edu/project/clisp/systems-work/"
 "/afs/cs/project/clisp/systems/")

;;; For some interim time, translate old compilation directories to the new
;;; working directories.  Do it for symbolic links and actual paths.
;;;
(ed::add-definition-dir-translation "/usr/lisp/"
				    "/afs/cs/project/clisp/systems/")
(ed::add-definition-dir-translation "/usr1/lisp/"
				    "/afs/cs/project/clisp/systems/")
(ed::add-definition-dir-translation "/usr2/lisp/"
				    "/afs/cs/project/clisp/systems/")

164
165
|#

ram's avatar
ram committed
166
167
168

;;; PCL.
;;;
169
#-no-pcl (load "pcl:pclload")
ram's avatar
ram committed
170
171
172
173
174


;;; Load these after PCL.
;;;
;(load "code:inspect")
175
;(load "code:tty-inspect")
ram's avatar
ram committed
176
177
178
179
180
181
182
183


;;; There should be no search lists defined in a full core.
;;;
(clrhash lisp::*search-list-table*)

;;; Okay, build the thing!
;;;
184
(progn
185
186
  ;; We want to be in the USER package when the command line switches run.
  (in-package "USER")
187
188
189
190
191
192
193
194
195
196
  (setq - nil)
  (setq + nil)
  (setq * nil)
  (setq / nil)
  (setq ++ nil)
  (setq ** nil)
  (setq // nil)
  (setq +++ nil)
  (setq *** nil)
  (setq /// nil)
ram's avatar
ram committed
197
198
199
200
201
202
  (setq *load-verbose* nil)
  (setq *info-environment*
	(list (make-info-environment :name "Working")
	      (compact-info-environment (car *info-environment*))))
  (save-lisp (namestring (merge-pathnames "lisp.core" (default-directory)))
	     :purify t
203
	     :init-function #'initial-init-function
ram's avatar
ram committed
204
	     :root-structures `(ed
205
				#-no-hemlock ,hi::*global-command-table*
ram's avatar
ram committed
206
207
208
				lisp::%top-level
				extensions:save-lisp
				,lisp::fop-codes
209
				compile-file)
210
211
	     #| :constants (cadr *info-environment*) |#
	     ))