;;;; files for more information.
(in-package "SB!IMPL")
-
-(file-comment
- "$Header$")
\f
;;;; burning our ships behind us
;;; a SIMPLE-VECTOR set by genesis
(defvar *!load-time-values*)
+(defun !cold-lose (msg)
+ (%primitive print msg)
+ (%primitive print "too early in cold init to recover from errors")
+ (%halt))
+
#!+gengc
(defun do-load-time-value-fixup (object offset index)
(declare (type index offset))
- (macrolet ((lose (msg)
- `(progn
- (%primitive print ,msg)
- (%halt))))
- (let ((value (svref *!load-time-values* index)))
- (typecase object
- (list
- (case offset
- (0 (setf (car object) value))
- (1 (setf (cdr object) value))
- (t (lose "bogus offset in cons cell"))))
- (instance
- (setf (%instance-ref object (- offset sb!vm:instance-slots-offset))
- value))
- (code-component
- (setf (code-header-ref object offset) value))
- (simple-vector
- (setf (svref object (- offset sb!vm:vector-data-offset)) value))
- (t
- (lose "unknown kind of object for load-time-value fixup"))))))
+ (let ((value (svref *!load-time-values* index)))
+ (typecase object
+ (list
+ (case offset
+ (0 (setf (car object) value))
+ (1 (setf (cdr object) value))
+ (t (!cold-lose "bogus offset in cons cell"))))
+ (instance
+ (setf (%instance-ref object (- offset sb!vm:instance-slots-offset))
+ value))
+ (code-component
+ (setf (code-header-ref object offset) value))
+ (simple-vector
+ (setf (svref object (- offset sb!vm:vector-data-offset)) value))
+ (t
+ (!cold-lose "unknown kind of object for load-time-value fixup")))))
(eval-when (:compile-toplevel :execute)
;; FIXME: Perhaps we should make SHOW-AND-CALL-AND-FMAKUNBOUND, too,
(/show0 "entering !COLD-INIT")
;; FIXME: It'd probably be cleaner to have most of the stuff here
- ;; handled by calls a la !GC-COLD-INIT, !ERROR-COLD-INIT, and
+ ;; handled by calls like !GC-COLD-INIT, !ERROR-COLD-INIT, and
;; !UNIX-COLD-INIT. And *TYPE-SYSTEM-INITIALIZED* could be changed to
;; *TYPE-SYSTEM-INITIALIZED-WHEN-BOUND* so that it doesn't need to
;; be explicitly set in order to be meaningful.
(setf *gc-notify-stream* nil)
(setf *before-gc-hooks* nil)
(setf *after-gc-hooks* nil)
- #!+gengc (setf sb!conditions::*handler-clusters* nil)
+ #!+gengc (setf *handler-clusters* nil)
#!-gengc (setf *already-maybe-gcing* t
*gc-inhibit* t
*need-to-collect-garbage* nil
(show-and-call !random-cold-init)
;; All sorts of things need INFO and/or (SETF INFO).
+ (/show0 "about to SHOW-AND-CALL !GLOBALDB-COLD-INIT")
(show-and-call !globaldb-cold-init)
;; This needs to be done early, but needs to be after INFO is
;; forms of the corresponding source files.
(show-and-call !package-cold-init)
-
- ;; Set sane values for our toplevel forms.
- (show-and-call !set-sane-cookie-defaults)
+ (show-and-call !policy-cold-init-or-resanify)
+ (/show0 "back from !POLICY-COLD-INIT-OR-RESANIFY")
;; KLUDGE: Why are fixups mixed up with toplevel forms? Couldn't
;; fixups be done separately? Wouldn't that be clearer and better?
(fourth toplevel-thing)
(fifth toplevel-thing)))
(t
- (%primitive print
- "bogus fixup code in *!REVERSED-COLD-TOPLEVELS*")
- (%halt))))
- (t
- (%primitive print "bogus function in *!REVERSED-COLD-TOPLEVELS*")
- (%halt)))))
+ (!cold-lose "bogus fixup code in *!REVERSED-COLD-TOPLEVELS*"))))
+ (t (!cold-lose "bogus function in *!REVERSED-COLD-TOPLEVELS*")))))
(/show0 "done with loop over cold toplevel forms and fixups")
;; Set sane values again, so that the user sees sane values instead of
- ;; whatever is left over from the last DECLAIM.
- (show-and-call !set-sane-cookie-defaults)
+ ;; whatever is left over from the last DECLAIM/PROCLAIM.
+ (show-and-call !policy-cold-init-or-resanify)
- ;; Only do this after top level forms have run, 'cause that's where
+ ;; Only do this after toplevel forms have run, 'cause that's where
;; DEFTYPEs are.
(setf *type-system-initialized* t)
(show-and-call os-cold-init-or-reinit)
- (show-and-call !filesys-cold-init)
(show-and-call stream-cold-init-or-reset)
(show-and-call !loader-cold-init)
;; The show is on.
(terpri)
(/show0 "going into toplevel loop")
- (let ((wot (catch '%end-of-the-world
- (/show0 "inside CATCH '%END-OF-THE-WORLD")
- (toplevel))))
- (flush-standard-output-streams)
- (sb!unix:unix-exit wot)))
+ (handling-end-of-the-world
+ (toplevel-init)))
-(defun quit (&key recklessly-p (unix-code 0))
+(defun quit (&key recklessly-p
+ (unix-code 0 unix-code-p)
+ (unix-status unix-code))
#!+sb-doc
"Terminate the current Lisp. Things are cleaned up (with UNWIND-PROTECT
and so forth) unless RECKLESSLY-P is non-NIL. On UNIX-like systems,
- UNIX-CODE is used as the status code."
+ UNIX-STATUS is used as the status code."
(declare (type (signed-byte 32) unix-code))
+ ;; FIXME: UNIX-CODE was deprecated in sbcl-0.6.8, after having been
+ ;; around for less than a year. It should be safe to remove it after
+ ;; a year.
+ (when unix-code-p
+ (warn "The UNIX-CODE argument is deprecated. Use the UNIX-STATUS argument
+instead (which is another name for the same thing)."))
(if recklessly-p
- (sb!unix:unix-exit unix-code)
- (throw '%end-of-the-world unix-code)))
+ (sb!unix:unix-exit unix-status)
+ (throw '%end-of-the-world unix-status)))
\f
;;;; initialization functions
projects / sbcl.git / blobdiff