-;;; the default system top-level function
-(defun toplevel ()
-
- (/show0 "entering TOPLEVEL")
-
- (let ((sysinit nil) ; value of --sysinit option
- (userinit nil) ; value of --userinit option
- (evals nil) ; values of --eval options (in reverse order)
- (noprint nil) ; Has a --noprint option been seen?
- (noprogrammer nil) ; Has a --noprogammer option been seen?
- (options (rest *posix-argv*))) ; skipping program name
-
- (/show0 "done with outer LET in TOPLEVEL")
-
- ;; 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.
-
- ;; Parse command line options.
+(defun process-init-file (specified-pathname default-function)
+ (restart-case
+ (let ((cookie (list)))
+ (flet ((process-stream (stream &optional pathname)
+ (loop
+ (restart-case
+ (handler-bind
+ ((error (lambda (e)
+ (error "Error during processing of ~
+ initialization file ~A:~%~% ~A"
+ (or pathname stream) e))))
+ (let ((form (read stream nil cookie)))
+ (if (eq cookie form)
+ (return-from process-init-file nil)
+ (eval form))))
+ (continue ()
+ :report "Ignore and continue processing.")))))
+ (if specified-pathname
+ (with-open-file (stream (parse-native-namestring specified-pathname)
+ :if-does-not-exist nil)
+ (if stream
+ (process-stream stream (pathname stream))
+ (error "The specified init file ~S was not found."
+ 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)))))))))
+ (abort ()
+ :report "Skip this initialization file.")))
+
+(defun process-eval-options (eval-strings-or-forms)
+ (/show0 "handling --eval options")
+ (flet ((process-1 (string-or-form)
+ (etypecase string-or-form
+ (string
+ (multiple-value-bind (expr pos) (read-from-string string-or-form)
+ (unless (eq string-or-form
+ (read-from-string string-or-form nil string-or-form
+ :start pos))
+ (error "More than one expression in ~S" string-or-form))
+ (eval expr)
+ (flush-standard-output-streams)))
+ (cons (eval string-or-form) (flush-standard-output-streams)))))
+ (restart-case
+ (dolist (expr-as-string-or-form eval-strings-or-forms)
+ (/show0 "handling one --eval option")
+ (restart-case
+ (handler-bind
+ ((error (lambda (e)
+ (error "Error during processing of --eval ~
+ option ~S:~%~% ~A"
+ expr-as-string-or-form e))))
+ (process-1 expr-as-string-or-form))
+ (continue ()
+ :report "Ignore and continue with next --eval option.")))
+ (abort ()
+ :report "Skip rest of --eval options."))))
+
+;; 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.
+(defun startup-error (control-string &rest args)
+ (format *error-output*
+ "fatal error before reaching READ-EVAL-PRINT loop: ~% ~?~%"
+ control-string
+ args)
+ (quit :unix-status 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)
+ ;; values of --eval options, in reverse order; and also any
+ ;; other options (like --load) which're translated into --eval
+ ;;
+ ;; The values 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,
+ ;; except for forms transformed from syntactically-sugary
+ ;; switches like --load and --disable-debugger.
+ (reversed-evals nil)
+ ;; Has a --noprint option been seen?
+ (noprint 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.