+(defun stream-output-stream (stream)
+ (typecase stream
+ (fd-stream
+ stream)
+ (synonym-stream
+ (stream-output-stream
+ (symbol-value (synonym-stream-symbol stream))))
+ (two-way-stream
+ (stream-output-stream
+ (two-way-stream-output-stream stream)))
+ (t
+ stream)))
+
+(defun process-init-file (specified-pathname kind)
+ (multiple-value-bind (context default-function)
+ (ecase kind
+ (:system
+ (values "sysinit" *sysinit-pathname-function*))
+ (:user
+ (values "userinit" *userinit-pathname-function*)))
+ (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")
+ (flet ((process-1 (cons)
+ (destructuring-bind (opt . value) cons
+ (ecase opt
+ (:eval
+ (with-simple-restart (continue "Ignore runtime option --eval ~S."
+ value)
+ (multiple-value-bind (expr pos) (read-from-string value)
+ (if (eq value (read-from-string value nil value :start pos))
+ (eval expr)
+ (error "Multiple expressions in --eval option: ~S"
+ value)))))
+ (:load
+ (with-simple-restart (continue "Ignore runtime option --load ~S."
+ value)
+ (load (native-pathname value))))
+ (:quit
+ (exit))))
+ (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)
+ (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*))
+ (exit)))))
+ ;; 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
+ (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 EXIT,
+;; 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.
+(defun startup-error (control-string &rest args)
+ (format *error-output*
+ "fatal error before reaching READ-EVAL-PRINT loop: ~% ~?~%"
+ control-string
+ args)
+ (exit :code 1))
+
+;;; the default system top level function
+(defun toplevel-init ()
+ (/show0 "entering TOPLEVEL-INIT")
+ (let ( ;; value of --sysinit option
+ (sysinit nil)
+ ;; t if --no-sysinit option given
+ (no-sysinit nil)
+ ;; value of --userinit option
+ (userinit nil)
+ ;; t if --no-userinit option given
+ (no-userinit nil)
+ ;; t if --disable-debugger option given
+ (disable-debugger nil)
+ ;; list of (<kind> . <string>) conses representing --eval and --load
+ ;; options. options. --eval options are stored as strings, so that
+ ;; they can be passed to READ only after their predecessors have been
+ ;; EVALed, so that things work when e.g. REQUIRE in one EVAL form
+ ;; creates a package referred to in the next EVAL form. Storing the
+ ;; original string also makes for easier debugging.
+ (reversed-options nil)
+ ;; Has a --noprint option been seen?
+ (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*)))
+
+ (declare (type list options))
+
+ (/show0 "done with outer LET in TOPLEVEL-INIT")
+
+ ;; FIXME: There are lots of ways for errors to happen around here
+ ;; (e.g. bad command line syntax, or READ-ERROR while trying to
+ ;; READ an --eval string). Make sure that they're handled
+ ;; reasonably.
+
+ ;; Process command line options.