X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcode%2Ftoplevel.lisp;h=381a2b2d0bc0b88ec5b25088e2094e688101c294;hb=86210c4e406c1b2ff10cc3bac0e71435867db48b;hp=8c36aad186f8c3aa3880352015ee5c5dce21c851;hpb=6395ade4d85003101ed3391ab3b2df06c6255289;p=sbcl.git diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index 8c36aad..381a2b2 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -13,14 +13,6 @@ (in-package "SB!IMPL") -(defconstant most-positive-fixnum #.sb!vm:*target-most-positive-fixnum* - #!+sb-doc - "the fixnum closest in value to positive infinity") - -(defconstant most-negative-fixnum #.sb!vm:*target-most-negative-fixnum* - #!+sb-doc - "the fixnum closest in value to negative infinity") - ;;;; magic specials initialized by GENESIS ;;; FIXME: The DEFVAR here is redundant with the (DECLAIM (SPECIAL ..)) @@ -140,15 +132,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) @@ -169,7 +163,7 @@ (declare (optimize (speed 3) (safety 0)) (values (unsigned-byte 20))) ; FIXME: DECLARE VALUES? - #!-x86 ; machines where stack grows upwards (I guess) -- WHN 19990906 + #!-stack-grows-downward-not-upward (labels ((scrub (ptr offset count) (declare (type system-area-pointer ptr) @@ -199,7 +193,7 @@ (* (floor initial-offset sb!vm:n-word-bytes) sb!vm:n-word-bytes) 0))) - #!+x86 ;; (Stack grows downwards.) + #!+stack-grows-downward-not-upward (labels ((scrub (ptr offset count) (declare (type system-area-pointer ptr) @@ -288,9 +282,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") @@ -300,7 +295,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 @@ -335,6 +332,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)) @@ -373,9 +373,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, @@ -390,10 +387,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"))) @@ -401,10 +397,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. @@ -414,17 +409,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") @@ -480,7 +477,7 @@ (abort "Reduce debugger level (leaving debugger, returning to toplevel).") (catch 'toplevel-catcher - (sb!unix:unix-sigsetmask 0) ; FIXME: What is this for? + #!-sunos (sb!unix:unix-sigsetmask 0) ; FIXME: What is this for? (repl noprint) (critically-unreachable "after REPL")))))))