(defvar *sysinit-pathname-function* #'sysinit-pathname
#!+sb-doc
- "Designator for a function of zero arguments called to obtain a pathname
-designator for the default sysinit file, or NIL. If the function returns NIL,
-no sysinit file is used unless one has been specified on the command-line.")
+ "Designator for a function of zero arguments called to obtain a
+pathname designator for the default sysinit file, or NIL. If the
+function returns NIL, no sysinit file is used unless one has been
+specified on the command-line.")
(defvar *userinit-pathname-function* #'userinit-pathname
#!+sb-doc
- "Designator for a function of zero arguments called to obtain a pathname
-designator or a stream for the default userinit file, or NIL. If the function
-returns NIL, no userinit file is used unless one has been specified on the
-command-line.")
+ "Designator for a function of zero arguments called to obtain a
+pathname designator or a stream for the default userinit file, or NIL.
+If the function returns NIL, no userinit file is used unless one has
+been specified on the command-line.")
\f
;;;; miscellaneous utilities for working with with TOPLEVEL
;;; handled appropriately.
(defmacro handling-end-of-the-world (&body body)
(with-unique-names (caught)
- `(let ((,caught (catch '%end-of-the-world
- (/show0 "inside CATCH '%END-OF-THE-WORLD")
- (unwind-protect
- (progn ,@body)
- (call-hooks "exit" *exit-hooks*)))))
- (/show0 "back from CATCH '%END-OF-THE-WORLD, flushing output")
- (flush-standard-output-streams)
- (sb!thread::terminate-session)
- (/show0 "calling UNIX-EXIT")
- (sb!unix:unix-exit ,caught))))
+ `(without-interrupts
+ (let ((,caught
+ (catch '%end-of-the-world
+ (unwind-protect
+ (with-local-interrupts ,@body (quit))
+ (handler-case
+ (with-local-interrupts
+ (call-hooks "exit" *exit-hooks* :on-error :warn))
+ (serious-condition ()
+ 1))))))
+ ;; If user called QUIT and exit hooks were OK, the status is what it
+ ;; is -- even eg. streams cannot be flushed anymore. Even if
+ ;; something goes wrong now, we still report what was asked. We still
+ ;; want to have %END-OF-THE-WORLD visible, though.
+ (catch '%end-of-the-world
+ (handler-case
+ (unwind-protect
+ (progn
+ (flush-standard-output-streams)
+ (sb!thread::terminate-session))
+ (sb!unix:unix-exit ,caught))
+ (serious-condition ())))))))
\f
;;;; working with *CURRENT-ERROR-DEPTH* and *MAXIMUM-ERROR-DEPTH*
(values "sysinit" *sysinit-pathname-function*))
(:user
(values "userinit" *userinit-pathname-function*)))
- (flet ((process-stream (stream pathname)
- (with-simple-restart (abort "Skip rest of ~A file ~S."
- context (native-namestring pathname))
- (loop
- (with-simple-restart
- (continue "Ignore error and continue processing ~A file ~S."
- context (native-namestring pathname))
- (let ((form (read stream nil stream)))
- (if (eq stream form)
- (return-from process-init-file nil)
- (eval form))))))))
- (if specified-pathname
- (with-open-file (stream (parse-native-namestring specified-pathname)
- :if-does-not-exist nil)
- (if stream
- (process-stream stream (pathname stream))
- (cerror "Ignore missing init file"
- "The specified ~A file ~A was not found."
- context specified-pathname)))
- (let ((default (funcall default-function)))
- (when default
- (with-open-file (stream (pathname default) :if-does-not-exist nil)
- (when stream
- (process-stream stream (pathname stream))))))))))
+ (if specified-pathname
+ (with-open-file (stream (parse-native-namestring specified-pathname)
+ :if-does-not-exist nil)
+ (if stream
+ (load-as-source stream :context context)
+ (cerror "Ignore missing init file"
+ "The specified ~A file ~A was not found."
+ context specified-pathname)))
+ (let ((default (funcall default-function)))
+ (when default
+ (with-open-file (stream (pathname default) :if-does-not-exist nil)
+ (when stream
+ (load-as-source stream :context context))))))))
(defun process-eval/load-options (options)
(/show0 "handling --eval and --load options")
(:load
(with-simple-restart (continue "Ignore runtime option --load ~S."
value)
- (load (native-pathname value))))))
+ (load (native-pathname value))))
+ (:quit
+ (quit))))
(flush-standard-output-streams)))
(with-simple-restart (abort "Skip rest of --eval and --load options.")
(dolist (option options)
(process-1 option)))))
(defun process-script (script)
- (let ((pathname (native-pathname script)))
+ (flet ((load-script (stream)
+ ;; Scripts don't need to be stylish or fast, but silence is usually a
+ ;; desirable quality...
+ (handler-bind (((or style-warning compiler-note) #'muffle-warning)
+ (stream-error (lambda (e)
+ ;; Shell-style.
+ (when (member (stream-error-stream e)
+ (list *stdout* *stdin* *stderr*))
+ (quit)))))
+ ;; Let's not use the *TTY* for scripts, ok? Also, normally we use
+ ;; synonym streams, but in order to have the broken pipe/eof error
+ ;; handling right we want to bind them for scripts.
+ (let ((*terminal-io* (make-two-way-stream *stdin* *stdout*))
+ (*debug-io* (make-two-way-stream *stdin* *stderr*))
+ (*standard-input* *stdin*)
+ (*standard-output* *stdout*)
+ (*error-output* *stderr*))
+ (load stream :verbose nil :print nil)))))
(handling-end-of-the-world
- (with-open-file (f pathname :element-type :default)
- (sb!fasl::maybe-skip-shebang-line f)
- (load f :verbose nil :print nil)
- (quit)))))
+ (if (eq t script)
+ (load-script *stdin*)
+ (with-open-file (f (native-pathname script) :element-type :default)
+ (sb!fasl::maybe-skip-shebang-line f)
+ (load-script f))))))
;; Errors while processing the command line cause the system to QUIT,
;; instead of trying to go into the Lisp debugger, because trying to
(noprint nil)
;; Has a --script option been seen?
(script nil)
+ ;; Quit after processing other options?
+ (finally-quit nil)
;; everything in *POSIX-ARGV* except for argv[0]=programname
(options (rest *posix-argv*)))
(setf disable-debugger t
no-userinit t
no-sysinit t
- script (pop-option))
+ script (if options (pop-option) t))
(return))
((string= option "--sysinit")
(pop-option)
((string= option "--disable-debugger")
(pop-option)
(setf disable-debugger t))
+ ((string= option "--quit")
+ (pop-option)
+ (setf finally-quit t))
+ ((string= option "--non-interactive")
+ ;; This option is short for --quit and --disable-debugger,
+ ;; which are needed in combination for reliable non-
+ ;; interactive startup.
+ (pop-option)
+ (setf finally-quit t)
+ (setf disable-debugger t))
((string= option "--end-toplevel-options")
(pop-option)
(return))
(process-init-file sysinit :system))
(unless no-userinit
(process-init-file userinit :user))
+ (when finally-quit
+ (push (list :quit) reversed-options))
(process-eval/load-options (nreverse reversed-options))
(when script
(process-script script)
projects / sbcl.git / blobdiff