- (flet (;; Errors while processing the command line cause the system
- ;; to QUIT, instead of trying to go into the Lisp debugger,
- ;; because trying to go into the Lisp debugger would get
- ;; into various annoying issues of where we should go after
- ;; the user tries to return from the debugger.
- (startup-error (control-string &rest args)
- (format
- *error-output*
- "fatal error before reaching READ-EVAL-PRINT loop: ~% ~?~%"
- control-string
- args)
- (quit :unix-status 1)))
- (loop while options do
- (/show0 "at head of LOOP WHILE OPTIONS DO in TOPLEVEL-INIT")
- (let ((option (first options)))
- (flet ((pop-option ()
- (if options
- (pop options)
- (startup-error
- "unexpected end of command line options"))))
- (cond ((string= option "--sysinit")
- (pop-option)
- (if sysinit
- (startup-error "multiple --sysinit options")
- (setf sysinit (pop-option))))
- ((string= option "--userinit")
- (pop-option)
- (if userinit
- (startup-error "multiple --userinit options")
- (setf userinit (pop-option))))
- ((string= option "--eval")
- (pop-option)
- (push (pop-option) reversed-evals))
- ((string= option "--load")
- (pop-option)
- (push
- ;; FIXME: see BUG 296
- (concatenate 'string "(|LOAD| \"" (pop-option) "\")")
- reversed-evals))
- ((string= option "--noprint")
- (pop-option)
- (setf noprint t))
- ((string= option "--disable-debugger")
- (pop-option)
- (push "(|DISABLE-DEBUGGER|)" reversed-evals))
- ((string= option "--end-toplevel-options")
- (pop-option)
- (return))
- (t
- ;; Anything we don't recognize as a toplevel
- ;; option must be the start of user-level
- ;; options.. except that if we encounter
- ;; "--end-toplevel-options" after we gave up
- ;; because we didn't recognize an option as a
- ;; toplevel option, then the option we gave up on
- ;; must have been an error. (E.g. in
- ;; "sbcl --eval '(a)' --eval'(b)' --end-toplevel-options"
- ;; this test will let us detect that the string
- ;; "--eval(b)" is an error.)
- (if (find "--end-toplevel-options" options
- :test #'string=)
- (startup-error "bad toplevel option: ~S"
- (first options))
- (return)))))))
- (/show0 "done with LOOP WHILE OPTIONS DO in TOPLEVEL-INIT")
-
- ;; Delete all the options that we processed, so that only
- ;; user-level options are left visible to user code.
- (setf (rest *posix-argv*) options)
-
- ;; Handle initialization files.
- (/show0 "handling initialization files in TOPLEVEL-INIT")
- (flet (;; shared idiom for searching for SYSINITish and
- ;; USERINITish files
- (probe-init-files (explicitly-specified-init-file-name
- &rest default-init-file-names)
- (declare (type list default-init-file-names))
- (if explicitly-specified-init-file-name
- (or (probe-file explicitly-specified-init-file-name)
- (startup-error "The file ~S was not found."
- explicitly-specified-init-file-name))
- (find-if (lambda (x)
- (and (stringp x) (probe-file x)))
- default-init-file-names)))
- ;; shared idiom for creating default names for
- ;; SYSINITish and USERINITish files
- (init-file-name (maybe-dir-name basename)
- (and maybe-dir-name
- (concatenate 'string maybe-dir-name "/" basename))))
- (let ((sysinit-truename
- (probe-init-files sysinit
- (init-file-name (posix-getenv "SBCL_HOME")
- "sbclrc")
- "/etc/sbclrc"))
- (userinit-truename
- (probe-init-files userinit
- (init-file-name (posix-getenv "HOME")
- ".sbclrc"))))
-
- ;; This CATCH is needed for the debugger command TOPLEVEL to
- ;; work.
- (catch 'toplevel-catcher
- ;; We wrap all the pre-REPL user/system customized startup
- ;; code in a restart.
- ;;
- ;; (Why not wrap everything, even the stuff above, in this
- ;; restart? Errors above here are basically command line
- ;; or Unix environment errors, e.g. a missing file or a
- ;; typo on the Unix command line, and you don't need to
- ;; get into Lisp to debug them, you should just start over
- ;; and do it right at the Unix level. Errors below here
- ;; are generally errors in user Lisp code, and it might be
- ;; helpful to let the user reach the REPL in order to help
- ;; figure out what's going on.)
- (restart-case
- (progn
- (process-init-file sysinit-truename)
- (process-init-file userinit-truename)
- (process-eval-options (reverse reversed-evals)))
- (abort ()
- :report "Skip to toplevel READ/EVAL/PRINT loop."
- (/show0 "CONTINUEing from pre-REPL RESTART-CASE")
- (values)) ; (no-op, just fall through)
- (quit ()
- :report "Quit SBCL (calling #'QUIT, killing the process)."
- (/show0 "falling through to QUIT from pre-REPL RESTART-CASE")
- (quit)))))
-
- ;; one more time for good measure, in case we fell out of the
- ;; RESTART-CASE above before one of the flushes in the ordinary
- ;; flow of control had a chance to operate
- (flush-standard-output-streams)
-
- (/show0 "falling into TOPLEVEL-REPL from TOPLEVEL-INIT")
- (toplevel-repl noprint)
- ;; (classic CMU CL error message: "You're certainly a clever child.":-)
- (critically-unreachable "after TOPLEVEL-REPL")))))
+ (loop while options do
+ (/show0 "at head of LOOP WHILE OPTIONS DO in TOPLEVEL-INIT")
+ (let ((option (first options)))
+ (flet ((pop-option ()
+ (if options
+ (pop options)
+ (startup-error
+ "unexpected end of command line options"))))
+ (cond ((string= option "--script")
+ (pop-option)
+ (setf disable-debugger t
+ no-userinit t
+ no-sysinit t
+ script (if options (pop-option) t))
+ (return))
+ ((string= option "--sysinit")
+ (pop-option)
+ (if sysinit
+ (startup-error "multiple --sysinit options")
+ (setf sysinit (pop-option))))
+ ((string= option "--no-sysinit")
+ (pop-option)
+ (setf no-sysinit t))
+ ((string= option "--userinit")
+ (pop-option)
+ (if userinit
+ (startup-error "multiple --userinit options")
+ (setf userinit (pop-option))))
+ ((string= option "--no-userinit")
+ (pop-option)
+ (setf no-userinit t))
+ ((string= option "--eval")
+ (pop-option)
+ (push (cons :eval (pop-option)) reversed-options))
+ ((string= option "--load")
+ (pop-option)
+ (push (cons :load (pop-option)) reversed-options))
+ ((string= option "--noprint")
+ (pop-option)
+ (setf noprint t))
+ ((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))
+ (t
+ ;; Anything we don't recognize as a toplevel
+ ;; option must be the start of user-level
+ ;; options.. except that if we encounter
+ ;; "--end-toplevel-options" after we gave up
+ ;; because we didn't recognize an option as a
+ ;; toplevel option, then the option we gave up on
+ ;; must have been an error. (E.g. in
+ ;; "sbcl --eval '(a)' --eval'(b)' --end-toplevel-options"
+ ;; this test will let us detect that the string
+ ;; "--eval(b)" is an error.)
+ (if (find "--end-toplevel-options" options
+ :test #'string=)
+ (startup-error "bad toplevel option: ~S"
+ (first options))
+ (return)))))))
+ (/show0 "done with LOOP WHILE OPTIONS DO in TOPLEVEL-INIT")
+
+ ;; Delete all the options that we processed, so that only
+ ;; user-level options are left visible to user code.
+ (when *posix-argv*
+ (setf (rest *posix-argv*) options))
+
+ ;; Disable debugger before processing initialization files & co.
+ (when disable-debugger
+ (sb!ext:disable-debugger))
+
+ ;; Handle initialization files.
+ (/show0 "handling initialization files in TOPLEVEL-INIT")
+ ;; This CATCH is needed for the debugger command TOPLEVEL to
+ ;; work.
+ (catch 'toplevel-catcher
+ ;; We wrap all the pre-REPL user/system customized startup
+ ;; code in a restart.
+ ;;
+ ;; (Why not wrap everything, even the stuff above, in this
+ ;; restart? Errors above here are basically command line
+ ;; or Unix environment errors, e.g. a missing file or a
+ ;; typo on the Unix command line, and you don't need to
+ ;; get into Lisp to debug them, you should just start over
+ ;; and do it right at the Unix level. Errors below here
+ ;; are generally errors in user Lisp code, and it might be
+ ;; helpful to let the user reach the REPL in order to help
+ ;; figure out what's going on.)
+ (restart-case
+ (progn
+ (unless no-sysinit
+ (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)
+ (bug "PROCESS-SCRIPT returned")))
+ (abort ()
+ :report (lambda (s)
+ (write-string
+ (if script
+ ;; In case script calls (enable-debugger)!
+ "Abort script, exiting lisp."
+ "Skip to toplevel READ/EVAL/PRINT loop.")
+ s))
+ (/show0 "CONTINUEing from pre-REPL RESTART-CASE")
+ (values)) ; (no-op, just fall through)
+ (exit ()
+ :report "Exit SBCL (calling #'EXIT, killing the process)."
+ :test (lambda (c) (declare (ignore c)) (not script))
+ (/show0 "falling through to EXIT from pre-REPL RESTART-CASE")
+ (exit :code 1))))
+
+ ;; one more time for good measure, in case we fell out of the
+ ;; RESTART-CASE above before one of the flushes in the ordinary
+ ;; flow of control had a chance to operate
+ (flush-standard-output-streams)
+
+ (/show0 "falling into TOPLEVEL-REPL from TOPLEVEL-INIT")
+ (toplevel-repl noprint)
+ ;; (classic CMU CL error message: "You're certainly a clever child.":-)
+ (critically-unreachable "after TOPLEVEL-REPL")))