Skip to content
Snippets Groups Projects
Commit c260719d authored by ram's avatar ram
Browse files

Fixed batch-mode stuff to have a chance of working.

parent a3825f9d
No related branches found
No related tags found
No related merge requests found
...@@ -5,7 +5,7 @@ ...@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain. ;;; Carnegie Mellon University, and has been placed in the public domain.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.27 1995/07/26 15:02:21 phg Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/save.lisp,v 1.28 1996/05/08 02:02:37 ram Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -106,9 +106,7 @@ ...@@ -106,9 +106,7 @@
(purify t) (purify t)
(root-structures ()) (root-structures ())
(environment-name "Auxiliary") (environment-name "Auxiliary")
(init-function (if *batch-mode* (init-function #'%top-level)
#'%top-level
#'%handled-top-level))
(load-init-file t) (load-init-file t)
(site-init "library:site-init") (site-init "library:site-init")
(print-herald t) (print-herald t)
...@@ -156,46 +154,49 @@ ...@@ -156,46 +154,49 @@
(dolist (f *before-save-initializations*) (funcall f)) (dolist (f *before-save-initializations*) (funcall f))
(flet (flet
((restart-lisp () ((restart-lisp ()
(catch '%end-of-the-world (unix:unix-exit
(with-simple-restart (abort "Skip remaining initializations.") (catch '%end-of-the-world
(catch 'top-level-catcher (with-simple-restart (abort "Skip remaining initializations.")
(reinit) (catch 'top-level-catcher
(dolist (f *after-save-initializations*) (funcall f)) (reinit)
(environment-init) (dolist (f *after-save-initializations*) (funcall f))
(when site-init (environment-init)
(load site-init :if-does-not-exist nil :verbose nil)) (when site-init
(when process-command-line (load site-init :if-does-not-exist nil :verbose nil))
(ext::process-command-strings)) (when process-command-line
(setf *editor-lisp-p* nil) (ext::process-command-strings))
(macrolet ((find-switch (name) (setf *editor-lisp-p* nil)
`(find ,name *command-line-switches* (macrolet ((find-switch (name)
:key #'cmd-switch-name `(find ,name *command-line-switches*
:test #'(lambda (x y) :key #'cmd-switch-name
(declare (simple-string x y)) :test #'(lambda (x y)
(string-equal x y))))) (declare (simple-string x y))
(when (and process-command-line (find-switch "edit")) (string-equal x y)))))
(setf *editor-lisp-p* t)) (when (and process-command-line (find-switch "edit"))
(when (and load-init-file (setf *editor-lisp-p* t))
(not (and process-command-line (when (and load-init-file
(find-switch "noinit")))) (not (and process-command-line
(let* ((cl-switch (find-switch "init")) (find-switch "noinit"))))
(name (and cl-switch (let* ((cl-switch (find-switch "init"))
(or (cmd-switch-value cl-switch) (name (and cl-switch
(car (cmd-switch-words (or (cmd-switch-value cl-switch)
cl-switch)))))) (car (cmd-switch-words
(if name cl-switch))))))
(load (merge-pathnames name #p"home:") (if name
:if-does-not-exist nil) (load (merge-pathnames name #p"home:")
(or (load "home:init" :if-does-not-exist nil) :if-does-not-exist nil)
(load "home:.cmucl-init" (or (load "home:init" :if-does-not-exist nil)
:if-does-not-exist nil)))))) (load "home:.cmucl-init"
(when process-command-line :if-does-not-exist nil))))))
(ext::invoke-switch-demons *command-line-switches* (when process-command-line
*command-switch-demons*)) (ext::invoke-switch-demons *command-line-switches*
(when print-herald *command-switch-demons*))
(print-herald)))) (when print-herald
(funcall init-function)) (print-herald))))
(unix:unix-exit 0))) (funcall (if (and *batch-mode* (eq init-function #'%top-level))
#'%handled-top-level
init-function))))))
(let ((initial-function (get-lisp-obj-address #'restart-lisp))) (let ((initial-function (get-lisp-obj-address #'restart-lisp)))
(without-gcing (without-gcing
(save (unix-namestring core-file-name nil) initial-function)))) (save (unix-namestring core-file-name nil) initial-function))))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment