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 by dtc, Thu Aug 24 19:55:53 2000 UTC
# Line 146  Line 146 
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."
149      #+mp (mp::shutdown-multi-processing)
150    (when (fboundp 'eval:flush-interpreted-function-cache)    (when (fboundp 'eval:flush-interpreted-function-cache)
151      (eval:flush-interpreted-function-cache))      (eval:flush-interpreted-function-cache))
152    (when (fboundp 'cancel-finalization)    (when (fboundp 'cancel-finalization)
# Line 153  Line 154 
154    (if purify    (if purify
155        (purify :root-structures root-structures        (purify :root-structures root-structures
156                :environment-name environment-name)                :environment-name environment-name)
157        (gc))        #-gencgc (gc) #+gencgc (gc :full t))
158    (dolist (f *before-save-initializations*) (funcall f))    (dolist (f *before-save-initializations*) (funcall f))
159    (flet    (flet
160        ((restart-lisp ()        ((restart-lisp ()
161           (unix:unix-exit           (unix:unix-exit
162            (catch '%end-of-the-world            (catch '%end-of-the-world
163              (with-simple-restart (abort "Skip remaining initializations.")              (unwind-protect
164                (catch 'top-level-catcher                 (progn
165                  (reinit)                   (with-simple-restart (abort "Skip remaining initializations.")
166                  (dolist (f *after-save-initializations*) (funcall f))                     (catch 'top-level-catcher
167                  (environment-init)                       (reinit)
168                  (when process-command-line                       (environment-init)
169                    (ext::process-command-strings))                       (dolist (f *after-save-initializations*) (funcall f))
170                  (setf *editor-lisp-p* nil)                       (when process-command-line
171                  (macrolet ((find-switch (name)                         (ext::process-command-strings))
172                               `(find ,name *command-line-switches*                       (setf *editor-lisp-p* nil)
173                         (macrolet ((find-switch (name)
174                                      `(find ,name *command-line-switches*
175                                      :key #'cmd-switch-name                                      :key #'cmd-switch-name
176                                      :test #'(lambda (x y)                                      :test #'(lambda (x y)
177                                                (declare (simple-string x y))                                                (declare (simple-string x y))
178                                                (string-equal x y)))))                                                (string-equal x y)))))
179                    (when site-init                         (when site-init
180                      (load site-init :if-does-not-exist nil :verbose nil))                           (load site-init :if-does-not-exist nil :verbose nil))
181                    (when (and process-command-line (find-switch "edit"))                         (when (and process-command-line (find-switch "edit"))
182                      (setf *editor-lisp-p* t))                           (setf *editor-lisp-p* t))
183                    (when (and load-init-file                         (when (and load-init-file
184                               (not (and process-command-line                                    (not (and process-command-line
185                                         (find-switch "noinit"))))                                              (find-switch "noinit"))))
186                      (let* ((cl-switch (find-switch "init"))                           (let* ((cl-switch (find-switch "init"))
187                             (name (and cl-switch                                  (name (and cl-switch
188                                        (or (cmd-switch-value cl-switch)                                             (or (cmd-switch-value cl-switch)
189                                            (car (cmd-switch-words                                                 (car (cmd-switch-words
190                                                  cl-switch))))))                                                       cl-switch))))))
191                        (if name                             (if name
192                            (load (merge-pathnames name #p"home:")                                 (load (merge-pathnames name #p"home:")
193                                  :if-does-not-exist nil)                                       :if-does-not-exist nil)
194                            (or (load "home:init" :if-does-not-exist nil)                                 (or (load "home:init" :if-does-not-exist nil)
195                                (load "home:.cmucl-init"                                     (load "home:.cmucl-init"
196                                      :if-does-not-exist nil))))))                                           :if-does-not-exist nil))))))
197                  (when process-command-line                       (when process-command-line
198                    (ext::invoke-switch-demons *command-line-switches*                         (ext::invoke-switch-demons *command-line-switches*
199                                               *command-switch-demons*))                                                    *command-switch-demons*))
200                  (when print-herald                       (when print-herald
201                    (print-herald))))                         (print-herald))))
202              (funcall (if (and *batch-mode* (eq init-function #'%top-level))                   (funcall (if (and *batch-mode*
203                           #'%handled-top-level                                     (eq init-function #'%top-level))
204                           init-function))))))                                #'%handled-top-level
205                                  init-function)))
206                  (finish-standard-output-streams))))))
209      (let ((initial-function (get-lisp-obj-address #'restart-lisp)))      (let ((initial-function (get-lisp-obj-address #'restart-lisp)))
210        (without-gcing        (without-gcing
# Line 227  Line 233 
233          ,#'(lambda (stream) (write-string (machine-instance) stream))))          ,#'(lambda (stream) (write-string (machine-instance) stream))))
235  (setf (getf *herald-items* :bugs)  (setf (getf *herald-items* :bugs)
236        '("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."
237          terpri          terpri
238          "Loaded subsystems:"))          "Loaded subsystems:"))

Removed from v.1.31  
changed lines
  Added in v.

  ViewVC Help
Powered by ViewVC 1.1.5