;;; which might be tedious to maintain, instead we use a hack:
;;; anything whose name matches a magic character pattern is
;;; uninterned.
+;;;
+;;; FIXME: should also go through globaldb (and perhaps other tables)
+;;; blowing away associated entries
(defun !unintern-init-only-stuff ()
(do ((any-changes? nil nil))
(nil)
(unless any-changes?
(return))))
\f
+;;;; putting ourselves out of our misery when things become too much to bear
+
+(declaim (ftype (function (simple-string) nil) critically-unreachable))
+(defun !cold-lose (msg)
+ (%primitive print msg)
+ (%primitive print "too early in cold init to recover from errors")
+ (%halt))
+
+;;; last-ditch error reporting for things which should never happen
+;;; and which, if they do happen, are sufficiently likely to torpedo
+;;; the normal error-handling system that we want to bypass it
+(declaim (ftype (function (simple-string) nil) critically-unreachable))
+(defun critically-unreachable (where)
+ (%primitive print "internal error: Control should never reach here, i.e.")
+ (%primitive print where)
+ (%halt))
+\f
;;;; !COLD-INIT
;;; a list of toplevel things set by GENESIS
;;; 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))
-
(eval-when (:compile-toplevel :execute)
;; FIXME: Perhaps we should make SHOW-AND-CALL-AND-FMAKUNBOUND, too,
;; and use it for most of the cold-init functions. (Just be careful
(svref *!load-time-values* (third toplevel-thing)))))
#!+(and x86 gencgc)
(:load-time-code-fixup
- (sb!vm::!do-load-time-code-fixup (second toplevel-thing)
- (third toplevel-thing)
- (fourth toplevel-thing)
- (fifth toplevel-thing)))
+ (sb!vm::!envector-load-time-code-fixup (second toplevel-thing)
+ (third toplevel-thing)
+ (fourth toplevel-thing)
+ (fifth toplevel-thing)))
(t
(!cold-lose "bogus fixup code in *!REVERSED-COLD-TOPLEVELS*"))))
(t (!cold-lose "bogus function in *!REVERSED-COLD-TOPLEVELS*")))))
;; Barlow's Alpha patches suppress it for Alpha. Why the difference?
#!+alpha
(set-floating-point-modes :traps '(:overflow
- #!-x86 :underflow
+ #!+alpha :underflow
:invalid
:divide-by-zero))
(terpri)
(/show0 "going into toplevel loop")
(handling-end-of-the-world
- (toplevel-init)))
+ (toplevel-init)
+ (critically-unreachable "after TOPLEVEL-INIT")))
(defun quit (&key recklessly-p
(unix-code 0 unix-code-p)
instead (which is another name for the same thing)."))
(if recklessly-p
(sb!unix:unix-exit unix-status)
- (throw '%end-of-the-world unix-status)))
+ (throw '%end-of-the-world unix-status))
+ (critically-unreachable "after trying to die in QUIT"))
\f
;;;; initialization functions
;; disabled by default. Joe User can
;; explicitly enable them if
;; desired.
- #!-x86 :underflow))
+ #!+alpha :underflow))
;; Clear pseudo atomic in case this core wasn't compiled with
;; support.
;;
#!+sb-show
(defun hexstr (thing)
(/noshow0 "entering HEXSTR")
- (let ((addr (sb!kernel:get-lisp-obj-address thing))
+ (let ((addr (get-lisp-obj-address thing))
(str (make-string 10)))
(/noshow0 "ADDR and STR calculated")
(setf (char str 0) #\0