X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcold-init.lisp;h=d3417f236732616f09143af8454589d704f02d5e;hb=b8f63d9b4e978bec3bfc1f4fc471e5ed946781fd;hp=ede85fd3af5690f66073d13a90d4198ce8610ea5;hpb=64bf93a97814ea1caf62bbdcc7ef43e2fbfc8f73;p=sbcl.git

diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index ede85fd..d3417f2 100644
--- a/src/code/cold-init.lisp
+++ b/src/code/cold-init.lisp
@@ -135,19 +135,24 @@
   ;; forms of the corresponding source files.
 
   (show-and-call !package-cold-init)
-
-  ;; Set sane values for our toplevel forms.
-  (show-and-call !set-sane-policy-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?
   ;; -- WHN 19991204
   (/show0 "doing cold toplevel forms and fixups")
-  (/show0 "(LENGTH *!REVERSED-COLD-TOPLEVELS*)=..")
+  (/show0 "(LISTP *!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))
+			 (if (listp *!reversed-cold-toplevels*) "true" "NIL"))
+  (/show0 "about to calculate (LENGTH *!REVERSED-COLD-TOPLEVELS*)")
+  (/show0 "(LENGTH *!REVERSED-COLD-TOPLEVELS*)=..")
+  #!+sb-show (let ((r-c-tl-length (length *!reversed-cold-toplevels*)))
+	       (/show0 "(length calculated..)")
+	       (let ((hexstr (sb!impl::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*)
@@ -190,11 +195,11 @@
 	(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-policy-defaults)
+  ;; 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 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)
 
@@ -215,8 +220,8 @@
   (show-and-call !class-finalize)
 
   ;; The reader and printer are initialized very late, so that they
-  ;; can even do hairy things like invoking the compiler as part of
-  ;; their initialization.
+  ;; can do hairy things like invoking the compiler as part of their
+  ;; initialization.
   (show-and-call !reader-cold-init)
   (let ((*readtable* *standard-readtable*))
     (show-and-call !sharpm-cold-init)
@@ -238,10 +243,6 @@
   (/show0 "done initializing")
   (setf *cold-init-complete-p* t)
 
-  ;; Unintern no-longer-needed stuff before we GC.
-  #!-sb-fluid
-  (!unintern-init-only-stuff)
-
   ;; The system is finally ready for GC.
   #!-gengc (setf *already-maybe-gcing* nil)
   (/show0 "enabling GC")
@@ -285,13 +286,17 @@ instead (which is another name for the same thing)."))
       (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.
       ;;
@@ -306,19 +311,24 @@ instead (which is another name for the same thing)."))
 ;;;; 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)
+  (/show0 "entering HEXSTR")
   (let ((addr (sb!kernel:get-lisp-obj-address thing))
 	(str (make-string 10)))
+    (/show0 "ADDR and STR calculated")
     (setf (char str 0) #\0
 	  (char str 1) #\x)
+    (/show0 "CHARs 0 and 1 set")
     (dotimes (i 8)
+      (/show0 "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))
+	(/show0 "NIBBLE and CHR calculated")
 	(setf (char str (- 9 i)) chr
 	      addr (ash addr -4))))
     str))