X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcold-init.lisp;h=382d02d2353a4fcf91803a6333f858bad2978a4f;hb=4cf50b1896b25f5337e7c258b0b560da00d47993;hp=7bcaca1247eea7b0950d98542eed119bef18e6ac;hpb=1bdc658b910e7dcc76f606b2c7c9c64012b6ee11;p=sbcl.git

diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index 7bcaca1..382d02d 100644
--- a/src/code/cold-init.lisp
+++ b/src/code/cold-init.lisp
@@ -31,7 +31,7 @@
 		    (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?
@@ -42,7 +42,7 @@
 ;;; 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)
@@ -51,7 +51,7 @@
   (%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
@@ -76,7 +76,7 @@
   ;; 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
@@ -90,7 +90,6 @@
   ;; !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)
@@ -111,6 +110,8 @@
   ;; 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)
@@ -134,7 +135,7 @@
   ;; 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")
 
@@ -143,15 +144,14 @@
   ;; -- WHN 19991204
   (/show0 "doing cold toplevel forms and fixups")
   (/show0 "(LISTP *!REVERSED-COLD-TOPLEVELS*)=..")
-  #!+sb-show (%primitive print
-			 (if (listp *!reversed-cold-toplevels*) "true" "NIL"))
+  (/hexstr (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)))
+	       (let ((hexstr (hexstr r-c-tl-length)))
 		 (/show0 "(hexstr calculated..)")
-		 (%primitive print hexstr)))
+		 (/primitive-print hexstr)))
   (let (#!+sb-show (index-in-cold-toplevels 0))
     #!+sb-show (declare (type fixnum index-in-cold-toplevels))
     (dolist (toplevel-thing (prog1
@@ -163,7 +163,7 @@
       #!+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)))
@@ -181,15 +181,15 @@
 		  (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*")))))
@@ -212,6 +212,11 @@
 
   ;; 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