X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftoplevel.lisp;h=02504a2286a439796f178ff0977efb61442dc3b6;hb=5108495b13b99452d5a85c4600f68432ff8894b2;hp=cd1c923d4ca07ca91585423f3209dd3782d6cc75;hpb=2d0b882f9eabffe5e2d32c0e2e7ab06c96f4fea3;p=sbcl.git diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index cd1c923..02504a2 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -233,6 +233,8 @@ ;;;; the default toplevel function +;;; FIXME: Most stuff below here can probably be byte-compiled. + (defvar / nil #!+sb-doc "a list of all the values returned by the most recent top-level EVAL") @@ -289,19 +291,22 @@ (/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") - ;; 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. - + ;; 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. Also, perhaps all errors while parsing the command + ;; line should cause the system to QUIT, instead of trying to go + ;; into the Lisp debugger. + ;; Parse command line options. (loop while options do (/show0 "at head of LOOP WHILE OPTIONS DO in TOPLEVEL-INIT") @@ -334,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)) @@ -352,19 +357,27 @@ ;; 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)' --evl '(b)' --end-toplevel-options - ;; this test will let us detect that "--evl" is - ;; an error.) + ;; "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=) (error "bad toplevel option: ~S" (first options)) (return))))))) (/show0 "done with LOOP WHILE OPTIONS DO in TOPLEVEL-INIT") - ;; Excise all the options that we processed, so that only user-level - ;; options are left visible to user code. + ;; Excise all the options that we processed, so that only + ;; user-level options are left visible to user code. (setf (rest *posix-argv*) options) + ;; Handle --noprogrammer option. We intentionally do this + ;; early so that it will affect the handling of initialization + ;; files and --eval options. + (/show0 "handling --noprogrammer option in TOPLEVEL-INIT") + (when noprogrammer + (setf *debugger-hook* 'noprogrammer-debugger-hook-fun + *debug-io* *error-output*)) + ;; FIXME: Verify that errors in init files and/or --eval operations ;; lead to reasonable behavior. @@ -398,32 +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)) - - ;; Handle stream binding controlled by --noprogrammer option. - ;; - ;; FIXME: When we do actually implement this, shouldn't it go - ;; earlier in the sequence, so that its stream bindings will - ;; affect the behavior of init files and --eval options? - (/show0 "handling --noprogrammer option in TOPLEVEL-INIT") - (when noprogrammer - (warn "stub: --noprogrammer option unimplemented")) ; FIXME + + + ;; 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)))) @@ -474,6 +500,53 @@ (dolist (result results) (fresh-line) (prin1 result))))))))))))) + +(defun noprogrammer-debugger-hook-fun (condition old-debugger-hook) + (declare (ignore old-debugger-hook)) + (flet ((failure-quit (&key recklessly-p) + (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 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%" + (type-of condition) + condition) + ;; Flush *ERROR-OUTPUT* even before the BACKTRACE, so that + ;; even if we hit an error within BACKTRACE we'll at least + ;; have the CONDITION printed out before we die. + (finish-output *error-output*) + ;; (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*) + (format *error-output* + "~%unhandled condition in --noprogrammer mode, quitting~%") + (finish-output *error-output*) + (failure-quit)) + (condition () + ;; 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 (defun %halt ()