(and (>= (length name) 2)
(string= name "*!" :end1 2 :end2 2)))
(/show0 "uninterning cold-init-only symbol..")
- #!+sb-show (%primitive print name)
+ (/primitive-print name)
(unintern symbol package)
(setf any-changes? t)))))
(unless any-changes?
;;; a list of toplevel things set by GENESIS
(defvar *!reversed-cold-toplevels*)
-;;; a SIMPLE-VECTOR set by genesis
+;;; a SIMPLE-VECTOR set by GENESIS
(defvar *!load-time-values*)
(defun !cold-lose (msg)
(%halt))
#!+gengc
-(defun do-load-time-value-fixup (object offset index)
+(defun !do-load-time-value-fixup (object offset index)
(declare (type index offset))
(let ((value (svref *!load-time-values* index)))
(typecase object
;; not to use it for the COLD-INIT-OR-REINIT functions.)
(sb!xc:defmacro show-and-call (name)
`(progn
- #!+sb-show (%primitive print ,(symbol-name name))
+ (/primitive-print ,(symbol-name name))
(,name))))
;;; called when a cold system starts up
;; !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-verbose* nil)
(setf *gc-notify-stream* nil)
(setf *before-gc-hooks* nil)
(setf *after-gc-hooks* nil)
;; this to be initialized, so we initialize it right away.
(show-and-call !random-cold-init)
+ (show-and-call !package-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)
;; functions are called in the same relative order as the toplevel
;; forms of the corresponding source files.
- (show-and-call !package-cold-init)
+ ;;(show-and-call !package-cold-init)
(show-and-call !policy-cold-init-or-resanify)
(/show0 "back from !POLICY-COLD-INIT-OR-RESANIFY")
;; fixups be done separately? Wouldn't that be clearer and better?
;; -- WHN 19991204
(/show0 "doing cold toplevel forms and fixups")
+ (/show0 "(LISTP *!REVERSED-COLD-TOPLEVELS*)=..")
+ (/hexstr (if (listp *!reversed-cold-toplevels*) "true" "NIL"))
+ (/show0 "about to calculate (LENGTH *!REVERSED-COLD-TOPLEVELS*)")
(/show0 "(LENGTH *!REVERSED-COLD-TOPLEVELS*)=..")
- #!+sb-show (%primitive print
- (sb!impl::hexstr (length *!reversed-cold-toplevels*)))
- (let (#!+sb-show (index-in-cold-toplevels 0)
- #!+sb-show (filename-in-cold-toplevels nil))
+ #!+sb-show (let ((r-c-tl-length (length *!reversed-cold-toplevels*)))
+ (/show0 "(length calculated..)")
+ (let ((hexstr (hexstr r-c-tl-length)))
+ (/show0 "(hexstr calculated..)")
+ (/primitive-print hexstr)))
+ (let (#!+sb-show (index-in-cold-toplevels 0))
#!+sb-show (declare (type fixnum index-in-cold-toplevels))
(dolist (toplevel-thing (prog1
(nreverse *!reversed-cold-toplevels*)
#!+sb-show
(when (zerop (mod index-in-cold-toplevels 1024))
(/show0 "INDEX-IN-COLD-TOPLEVELS=..")
- (%primitive print (sb!impl::hexstr index-in-cold-toplevels)))
+ (/hexstr index-in-cold-toplevels))
#!+sb-show
(setf index-in-cold-toplevels
(the fixnum (1+ index-in-cold-toplevels)))
(get-lisp-obj-address
(svref *!load-time-values* (third toplevel-thing))))
#!+gengc
- (do-load-time-value-fixup (second toplevel-thing)
- (third toplevel-thing)
- (fourth toplevel-thing)))
+ (!do-load-time-value-fixup (second toplevel-thing)
+ (third toplevel-thing)
+ (fourth 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::!do-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*")))))
(/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/PROCLAIM.
+ ;; Set sane values again, so that the user sees sane values instead
+ ;; of whatever is left over from the last DECLAIM/PROCLAIM.
(show-and-call !policy-cold-init-or-resanify)
;; Only do this after toplevel forms have run, 'cause that's where
;; FIXME: This list of modes should be defined in one place and
;; explicitly shared between here and REINIT.
+ ;;
+ ;; FIXME: In CMU CL, this is done "here" (i.e. in the analogous
+ ;; lispinit.lisp code) for every processor architecture. But Daniel
+ ;; Barlow's Alpha patches suppress it for Alpha. Why the difference?
+ #!+alpha
(set-floating-point-modes :traps '(:overflow
#!-x86 :underflow
:invalid
(gc-cold-init-or-reinit)
(setf (sb!alien:extern-alien "internal_errors_enabled" boolean) t)
(set-floating-point-modes :traps
- ;; PRINT seems to not like x86 NPX denormal
- ;; floats like LEAST-NEGATIVE-SINGLE-FLOAT, so
- ;; the :UNDERFLOW exceptions are disabled by
- ;; default. Joe User can explicitly enable them
- ;; if desired.
- '(:overflow #!-x86 :underflow :invalid
- :divide-by-zero))
+ '(:overflow
+ :invalid
+ :divide-by-zero
+ ;; PRINT seems not to like x86 NPX
+ ;; denormal floats like
+ ;; LEAST-NEGATIVE-SINGLE-FLOAT, so
+ ;; the :UNDERFLOW exceptions are
+ ;; disabled by default. Joe User can
+ ;; explicitly enable them if
+ ;; desired.
+ #!-x86 :underflow))
;; Clear pseudo atomic in case this core wasn't compiled with
;; support.
;;
;;;; some support for any hapless wretches who end up debugging cold
;;;; init code
-;;; Decode THING into hex using only machinery available early in cold
-;;; init.
+;;; Decode THING into hexadecimal notation using only machinery
+;;; available early in cold init.
#!+sb-show
(defun hexstr (thing)
+ (/noshow0 "entering HEXSTR")
(let ((addr (sb!kernel:get-lisp-obj-address thing))
(str (make-string 10)))
+ (/noshow0 "ADDR and STR calculated")
(setf (char str 0) #\0
(char str 1) #\x)
+ (/noshow0 "CHARs 0 and 1 set")
(dotimes (i 8)
+ (/noshow0 "at head of DOTIMES loop")
(let* ((nibble (ldb (byte 4 0) addr))
(chr (char "0123456789abcdef" nibble)))
(declare (type (unsigned-byte 4) nibble)
(base-char chr))
+ (/noshow0 "NIBBLE and CHR calculated")
(setf (char str (- 9 i)) chr
addr (ash addr -4))))
str))