/[cmucl]/src/code/save.lisp
ViewVC logotype

Diff of /src/code/save.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.31 by dtc, Sat Mar 15 16:58:59 1997 UTC revision 1.31.2.6 by pw, Sat Mar 23 18:50:10 2002 UTC
# Line 91  Line 91 
91    
92    (setf (search-list "library:")    (setf (search-list "library:")
93          (or (parse-unix-search-list :cmucllib)          (or (parse-unix-search-list :cmucllib)
94              '(#+mach  "/usr/misc/.cmucl/lib/"              '("/usr/local/lib/cmucl/lib/")))
95                #+linux "/usr/lib/cmucl/"    (setf (search-list "modules:") (ext:unix-namestring "library:subsystems/")))
               #-(or mach linux) "/usr/local/lib/cmucl/lib/"))))  
96    
97    
98    
# Line 111  Line 110 
110                                   (load-init-file t)                                   (load-init-file t)
111                                   (site-init "library:site-init")                                   (site-init "library:site-init")
112                                   (print-herald t)                                   (print-herald t)
113                                   (process-command-line t))                                   (process-command-line t)
114                                     (batch-mode nil))
115    "Saves a CMU Common Lisp core image in the file of the specified name.  The    "Saves a CMU Common Lisp core image in the file of the specified name.  The
116    following keywords are defined:    following keywords are defined:
117    
# Line 144  Line 144 
144        library:site-init.  No error if this does not exist.        library:site-init.  No error if this does not exist.
145    
146    :print-herald    :print-herald
147        If true (the default), print out the lisp system herald when starting."        If true (the default), print out the lisp system herald when starting.
148    
149      :process-command-line
150          If true (the default), process command-line switches via the normal
151      mechanisms, otherwise ignore all switches (except those processed by the
152      C startup code).
153    
154      :batch-mode
155          If nil (the default), then the presence of the -batch command-line
156      switch will invoke batch-mode processing.  If true, the produced core
157      will always be in batch-mode, regardless of any command-line switches."
158    
159      #+mp (mp::shutdown-multi-processing)
160    (when (fboundp 'eval:flush-interpreted-function-cache)    (when (fboundp 'eval:flush-interpreted-function-cache)
161      (eval:flush-interpreted-function-cache))      (eval:flush-interpreted-function-cache))
162    (when (fboundp 'cancel-finalization)    (when (fboundp 'cancel-finalization)
# Line 153  Line 164 
164    (if purify    (if purify
165        (purify :root-structures root-structures        (purify :root-structures root-structures
166                :environment-name environment-name)                :environment-name environment-name)
167        (gc))        #-gencgc (gc) #+gencgc (gc :full t))
168    (dolist (f *before-save-initializations*) (funcall f))    (dolist (f *before-save-initializations*) (funcall f))
169    (flet    (setq ext:*batch-mode* (if batch-mode t nil))
170        ((restart-lisp ()    (labels
171          ((%restart-lisp ()
172             (with-simple-restart (abort "Skip remaining initializations.")
173               (catch 'top-level-catcher
174                 (reinit)
175                 (environment-init)
176                 (dolist (f *after-save-initializations*) (funcall f))
177                 (when process-command-line
178                   (ext::process-command-strings))
179                 (setf *editor-lisp-p* nil)
180                 (macrolet ((find-switch (name)
181                              `(find ,name *command-line-switches*
182                                     :key #'cmd-switch-name
183                                     :test #'(lambda (x y)
184                                               (declare (simple-string x y))
185                                               (string-equal x y)))))
186                   (when (and site-init
187                              (not (and process-command-line
188                                        (find-switch "nositeinit"))))
189                     (load site-init :if-does-not-exist nil :verbose nil))
190                   (when (and process-command-line (find-switch "edit"))
191                     (setf *editor-lisp-p* t))
192                   (when (and load-init-file
193                              (not (and process-command-line
194                                        (find-switch "noinit"))))
195                     (let* ((cl-switch (find-switch "init"))
196                            (name (and cl-switch
197                                       (or (cmd-switch-value cl-switch)
198                                           (car (cmd-switch-words cl-switch))))))
199                       (if name
200                           (load (merge-pathnames name #p"home:")
201                                 :if-does-not-exist nil)
202                           (or (load "home:init" :if-does-not-exist nil)
203                               (load "home:.cmucl-init"
204                                     :if-does-not-exist nil))))))
205                 (when process-command-line
206                   (ext::invoke-switch-demons *command-line-switches*
207                                              *command-switch-demons*))
208                 (when print-herald
209                   (print-herald))))
210             (funcall init-function))
211           (restart-lisp ()
212           (unix:unix-exit           (unix:unix-exit
213            (catch '%end-of-the-world            (catch '%end-of-the-world
214              (with-simple-restart (abort "Skip remaining initializations.")              (unwind-protect
215                (catch 'top-level-catcher                  (if *batch-mode*
216                  (reinit)                      (handler-case
217                  (dolist (f *after-save-initializations*) (funcall f))                          (%restart-lisp)
218                  (environment-init)                        (error (cond)
219                  (when process-command-line                          (format *error-output* "Error in batch processing:~%~A~%"
220                    (ext::process-command-strings))                                  cond)
221                  (setf *editor-lisp-p* nil)                          (throw '%end-of-the-world 1)))
222                  (macrolet ((find-switch (name)                      (%restart-lisp))
223                               `(find ,name *command-line-switches*                (finish-standard-output-streams))))))
                                     :key #'cmd-switch-name  
                                     :test #'(lambda (x y)  
                                               (declare (simple-string x y))  
                                               (string-equal x y)))))  
                   (when site-init  
                     (load site-init :if-does-not-exist nil :verbose nil))  
                   (when (and process-command-line (find-switch "edit"))  
                     (setf *editor-lisp-p* t))  
                   (when (and load-init-file  
                              (not (and process-command-line  
                                        (find-switch "noinit"))))  
                     (let* ((cl-switch (find-switch "init"))  
                            (name (and cl-switch  
                                       (or (cmd-switch-value cl-switch)  
                                           (car (cmd-switch-words  
                                                 cl-switch))))))  
                       (if name  
                           (load (merge-pathnames name #p"home:")  
                                 :if-does-not-exist nil)  
                           (or (load "home:init" :if-does-not-exist nil)  
                               (load "home:.cmucl-init"  
                                     :if-does-not-exist nil))))))  
                 (when process-command-line  
                   (ext::invoke-switch-demons *command-line-switches*  
                                              *command-switch-demons*))  
                 (when print-herald  
                   (print-herald))))  
             (funcall (if (and *batch-mode* (eq init-function #'%top-level))  
                          #'%handled-top-level  
                          init-function))))))  
224    
225      (let ((initial-function (get-lisp-obj-address #'restart-lisp)))      (let ((initial-function (get-lisp-obj-address #'restart-lisp)))
226        (without-gcing        (without-gcing
# Line 227  Line 249 
249          ,#'(lambda (stream) (write-string (machine-instance) stream))))          ,#'(lambda (stream) (write-string (machine-instance) stream))))
250    
251  (setf (getf *herald-items* :bugs)  (setf (getf *herald-items* :bugs)
252        '("Send bug reports and questions to cmucl-bugs@cs.cmu.edu."        '("Send questions to cmucl-help@cons.org. and bug reports to cmucl-imp@cons.org."
253          terpri          terpri
254          "Loaded subsystems:"))          "Loaded subsystems:"))
255    

Legend:
Removed from v.1.31  
changed lines
  Added in v.1.31.2.6

  ViewVC Help
Powered by ViewVC 1.1.5