\f
(defconstant most-positive-fixnum #.sb!vm:*target-most-positive-fixnum*
#!+sb-doc
- "The fixnum closest in value to positive infinity.")
+ "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.")
+ "the fixnum closest in value to negative infinity")
\f
;;;; magic specials initialized by genesis
+;;; FIXME: The DEFVAR here is redundant with the (DECLAIM (SPECIAL ..))
+;;; of all static symbols in early-impl.lisp.
#!-gengc
(progn
(defvar *current-catch-block*)
(defconstant bytes-per-scrub-unit 2048)
+;;; Zero the unused portion of the control stack so that old objects are not
+;;; kept alive because of uninitialized stack variables.
+;;;
+;;; FIXME: Why do we need to do this instead of just letting GC read
+;;; the stack pointer and avoid messing with the unused portion of
+;;; the control stack? (Is this a multithreading thing where there's
+;;; one control stack and stack pointer per thread, and it might not
+;;; be easy to tell what a thread's stack pointer value is when
+;;; looking in from another thread?)
(defun scrub-control-stack ()
- #!+sb-doc
- "Zero the unused portion of the control stack so that old objects are not
- kept alive because of uninitialized stack variables."
- ;; FIXME: Why do we need to do this instead of just letting GC read
- ;; the stack pointer and avoid messing with the unused portion of
- ;; the control stack? (Is this a multithreading thing where there's
- ;; one control stack and stack pointer per thread, and it might not
- ;; be easy to tell what a thread's stack pointer value is when
- ;; looking in from another thread?)
(declare (optimize (speed 3) (safety 0))
(values (unsigned-byte 20))) ; FIXME: DECLARE VALUES?
(/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")
(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))
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))))
projects / sbcl.git / blobdiff