X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftoplevel.lisp;h=53889d8959e88019e657655c4c661d4254887a14;hb=816248ab4fe04775879a7e5a5ce1b4c613afe9d5;hp=5a40e8fd0383cb17b49fa5121cdf1c5c0ec62550;hpb=5277a0cbf1a72243cad6808883a4847acefc8e6b;p=sbcl.git diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index 5a40e8f..53889d8 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -140,15 +140,17 @@ be any non-negative, non-complex number." (when (or (not (realp n)) (minusp n)) - (error "Invalid argument to SLEEP: ~S.~%~ - Must be a non-negative, non-complex number." - n)) + (error 'simple-type-error + :format-control "invalid argument to SLEEP: ~S" + :format-arguments (list n) + :datum n + :expected-type '(real 0))) (multiple-value-bind (sec usec) (if (integerp n) (values n 0) (multiple-value-bind (sec frac) (truncate n) - (values sec(truncate frac 1e-6)))) + (values sec (truncate frac 1e-6)))) (sb!unix:unix-select 0 0 0 0 sec usec)) nil) @@ -247,10 +249,6 @@ (defvar +++ nil #!+sb-doc "the previous value of ++") (defvar - nil #!+sb-doc "the form currently being evaluated") -;;; the top level prompt string, or a function of no arguments that -;;; returns a simple-string -(defvar *prompt* "* ") - (defun interactive-eval (form) "Evaluate FORM, returning whatever it returns and adjusting ***, **, *, +++, ++, +, ///, //, /, and -." @@ -292,9 +290,10 @@ (let ((sysinit nil) ; value of --sysinit option (userinit nil) ; value of --userinit option - (reversed-evals nil) ; values of --eval options, in reverse order + (reversed-evals nil) ; values of --eval options, in reverse order; and + ; also --load options, translated into --eval (noprint nil) ; Has a --noprint option been seen? - (noprogrammer nil) ; Has a --noprogammer option been seen? + (noprogrammer nil) ; Has a --noprogrammer option been seen? (options (rest *posix-argv*))) ; skipping program name (/show0 "done with outer LET in TOPLEVEL-INIT") @@ -304,7 +303,9 @@ ;; 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. + ;; into the Lisp debugger, since trying to go into the debugger + ;; gets into various annoying issues of where we should go after + ;; the user tries to return from the debugger. ;; Parse command line options. (loop while options do @@ -339,6 +340,9 @@ eval-as-string)) (t (push eval reversed-evals))))))) + ((string= option "--load") + (pop-option) + (push `(load ,(pop-option)) reversed-evals)) ((string= option "--noprint") (pop-option) (setf noprint t)) @@ -377,9 +381,6 @@ (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. - ;; Handle initialization files. (/show0 "handling initialization files in TOPLEVEL-INIT") (flet (;; If any of POSSIBLE-INIT-FILE-NAMES names a real file, @@ -394,10 +395,9 @@ (let* ((sbcl-home (posix-getenv "SBCL_HOME")) (sysinit-truename (if sbcl-home (probe-init-files sysinit - (concatenate - 'string - sbcl-home - "/sbclrc")) + (concatenate 'string + sbcl-home + "/sbclrc")) (probe-init-files sysinit "/etc/sbclrc" "/usr/local/etc/sbclrc"))) @@ -405,10 +405,9 @@ (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")))) + (concatenate 'string + user-home + "/.sbclrc")))) ;; We wrap all the pre-REPL user/system customized startup code ;; in a restart. @@ -418,17 +417,19 @@ ;; 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.) + ;; 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 - (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) + (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") @@ -495,14 +496,11 @@ ;; FIXME: It seems bad to have GC behavior depend on scrubbing the ;; control stack before each interactive command. Isn't there some ;; way we can convince the GC to just ignore dead areas of the - ;; control stack, so that we don't need to rely on this - ;; half-measure? + ;; control stack, so that we don't need to rely on this half-measure? (scrub-control-stack) (unless noprint (fresh-line) - (princ (if (functionp *prompt*) - (funcall *prompt*) - *prompt*)) + (write-string "* ") ; arbitrary but customary REPL prompt (flush-standard-output-streams)) (let ((form (read *standard-input* nil eof-marker))) (cond ((eq form eof-marker)