- (flet (;; If any of POSSIBLE-INIT-FILE-NAMES names a real file,
- ;; return its truename.
- (probe-init-files (&rest possible-init-file-names)
- (declare (type list possible-init-file-names))
- (/show0 "entering PROBE-INIT-FILES")
- (prog1
- (find-if (lambda (x)
- (and (stringp x) (probe-file x)))
- possible-init-file-names)
- (/show0 "leaving PROBE-INIT-FILES"))))
- (let* ((sbcl-home (posix-getenv "SBCL_HOME"))
- (sysinit-truename
- (probe-init-files sysinit
- (concatenate 'string sbcl-home "/sbclrc")
- "/etc/sbclrc"))
- (user-home (or (posix-getenv "HOME")
- (error "The HOME environment variable is unbound, ~
- so user init file can't be found.")))
- (userinit-truename (probe-init-files userinit
- (concatenate 'string
- user-home
- "/.sbclrc"))))
-
- ;; 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
- (flet ((process-init-file (truename)
- (when truename
- (unless (load truename)
- (error "~S was not successfully loaded." truename))
- (flush-standard-output-streams))))
- (process-init-file sysinit-truename)
- (process-init-file userinit-truename))
-
- ;; Process --eval options.
- (/show0 "handling --eval options in TOPLEVEL-INIT")
- (dolist (expr-as-string (reverse reversed-evals))
- (/show0 "handling one --eval option in TOPLEVEL-INIT")
- (let ((expr (with-input-from-string (eval-stream
- expr-as-string)
- (let* ((eof-marker (cons :eof :eof))
- (result (read eval-stream nil eof-marker))
- (eof (read eval-stream nil eof-marker)))
- (cond ((eq result eof-marker)
- (error "unable to parse ~S"
- expr-as-string))
- ((not (eq eof eof-marker))
- (error "more than one expression in ~S"
- expr-as-string))
- (t
- result))))))
- (eval expr)
- (flush-standard-output-streams))))
- (continue ()
- :report
- "Continue anyway (skipping 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"))))
+ ;; 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))
+ (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)
+ (quit ()
+ :report "Quit SBCL (calling #'QUIT, killing the process)."
+ :test (lambda (c) (declare (ignore c)) (not script))
+ (/show0 "falling through to QUIT from pre-REPL RESTART-CASE")
+ (quit :unix-status 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")))
+
+;;; hooks to support customized toplevels like ACL-style toplevel from
+;;; KMR on sbcl-devel 2002-12-21. Altered by CSR 2003-11-16 for
+;;; threaded operation: altered *REPL-FUN* to *REPL-FUN-GENERATOR*.
+(defvar *repl-read-form-fun* #'repl-read-form-fun
+ #!+sb-doc
+ "A function of two stream arguments IN and OUT for the toplevel REPL to
+call: Return the next Lisp form to evaluate (possibly handling other magic --
+like ACL-style keyword commands -- which precede the next Lisp form). The OUT
+stream is there to support magic which requires issuing new prompts.")
+(defvar *repl-prompt-fun* #'repl-prompt-fun
+ #!+sb-doc
+ "A function of one argument STREAM for the toplevel REPL to call: Prompt
+the user for input.")
+(defvar *repl-fun-generator* (constantly #'repl-fun)
+ #!+sb-doc
+ "A function of no arguments returning a function of one argument NOPRINT
+that provides the REPL for the system. Assumes that *STANDARD-INPUT* and
+*STANDARD-OUTPUT* are set up.")