X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftoplevel.lisp;h=02504a2286a439796f178ff0977efb61442dc3b6;hb=5108495b13b99452d5a85c4600f68432ff8894b2;hp=47a1efe5d1a85ca9fc608f3d90d4c2dca1af6c83;hpb=f0338f6fa732b21daa4405e19465bd460e0526d9;p=sbcl.git diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index 47a1efe..02504a2 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -291,11 +291,11 @@ (/show0 "entering TOPLEVEL-INIT") - (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? + (let ((sysinit nil) ; value of --sysinit option + (userinit nil) ; value of --userinit option + (reversed-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-INIT") @@ -339,7 +339,7 @@ (error "more than one expression in ~S" eval-as-string)) (t - (push eval evals))))))) + (push eval reversed-evals))))))) ((string= option "--noprint") (pop-option) (setf noprint t)) @@ -411,23 +411,45 @@ user-home "/.sbclrc")))) (/show0 "assigned SYSINIT-TRUENAME and USERINIT-TRUENAME") - (when sysinit-truename - (unless (load sysinit-truename) - (error "~S was not successfully loaded." sysinit-truename)) - (flush-standard-output-streams)) - (/show0 "loaded SYSINIT-TRUENAME") - (when userinit-truename - (unless (load userinit-truename) - (error "~S was not successfully loaded." userinit-truename)) - (flush-standard-output-streams)) - (/show0 "loaded USERINIT-TRUENAME")) - - ;; Handle --eval options. - (/show0 "handling --eval options in TOPLEVEL-INIT") - (dolist (eval (reverse evals)) - (/show0 "handling one --eval option in TOPLEVEL-INIT") - (eval eval) - (flush-standard-output-streams)) + + + ;; 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 usually 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 + (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 (eval (reverse reversed-evals)) + (/show0 "handling one --eval option in TOPLEVEL-INIT") + (eval eval) + (flush-standard-output-streams))) + (continue () + :report "Continue anyway (skipping to toplevel read/eval/print loop)." + (values)) ; (no-op, just fall through) + (quit () + :report "Quit SBCL (calling #'QUIT, killing the process)." + (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)))) @@ -485,13 +507,13 @@ (quit :unix-status 1 :recklessly-p recklessly-p))) ;; This HANDLER-CASE is here mostly to stop output immediately ;; (and fall through to QUIT) when there's an I/O error. Thus, - ;; when we're run under a Perl script or something, we can die + ;; when we're run under a shell script or something, we can die ;; cleanly when the script dies (and our pipes are cut), instead ;; of falling into ldb or something messy like that. (handler-case (progn (format *error-output* - "~@~2%" + "~@~2%" (type-of condition) condition) ;; Flush *ERROR-OUTPUT* even before the BACKTRACE, so that @@ -501,12 +523,29 @@ ;; (Where to truncate the BACKTRACE is of course arbitrary, but ;; it seems as though we should at least truncate it somewhere.) (sb!debug:backtrace 128 *error-output*) - (finish-output *error-output*) (format *error-output* - "~%unhandled CONDITION in --noprogrammer mode, quitting~%") + "~%unhandled condition in --noprogrammer mode, quitting~%") + (finish-output *error-output*) (failure-quit)) (condition () - (%primitive print "Argh! error within --noprogrammer error handling") + ;; We IGNORE-ERRORS here because even %PRIMITIVE PRINT can + ;; fail when our output streams are blown away, as e.g. when + ;; we're running under a Unix shell script and it dies somehow + ;; (e.g. because of a SIGINT). In that case, we might as well + ;; just give it up for a bad job, and stop trying to notify + ;; the user of anything. + ;; + ;; Actually, the only way I've run across to exercise the + ;; problem is to have more than one layer of shell script. + ;; I have a shell script which does + ;; time nice -10 sh make.sh "$1" 2>&1 | tee make.tmp + ;; and the problem occurs when I interrupt this with Ctrl-C + ;; under Linux 2.2.14-5.0 and GNU bash, version 1.14.7(1). + ;; I haven't figured out whether it's bash, time, tee, Linux, or + ;; what that is responsible, but that it's possible at all + ;; means that we should IGNORE-ERRORS here. -- WHN 2001-04-24 + (ignore-errors + (%primitive print "Argh! error within --noprogrammer error handling")) (failure-quit :recklessly-p t))))) ;;; a convenient way to get into the assembly-level debugger