1.0.21.10: DEFINE-COMPILER-MACRO and destructuring lambda-lists
[sbcl.git] / src / code / cold-init.lisp
index f0c780a..ef011a2 100644 (file)
         sb!kernel::*gc-epoch* (cons nil nil))
 
   ;; I'm not sure where eval is first called, so I put this first.
-  #!+sb-eval
-  (show-and-call sb!eval::!full-eval-cold-init)
+  (show-and-call !eval-cold-init)
 
   (show-and-call thread-init-or-reinit)
   (show-and-call !typecheckfuns-cold-init)
@@ -291,6 +290,8 @@ systems, UNIX-STATUS is used as the status code."
   (sb!thread::get-foreground))
 
 (defun reinit ()
+  #!+win32
+  (setf sb!win32::*ansi-codepage* nil)
   (setf *default-external-format* nil)
   (setf sb!alien::*default-c-string-external-format* nil)
   ;; WITHOUT-GCING implies WITHOUT-INTERRUPTS.
@@ -338,14 +339,20 @@ systems, UNIX-STATUS is used as the status code."
 
 #!+sb-show
 (defun cold-print (x)
-  (typecase x
-    (simple-string (sb!sys:%primitive print x))
-    (symbol (sb!sys:%primitive print (symbol-name x)))
-    (list (let ((count 0))
-            (sb!sys:%primitive print "list:")
-            (dolist (i x)
-              (when (>= (incf count) 4)
-                (sb!sys:%primitive print "...")
-                (return))
-              (cold-print i))))
-    (t (sb!sys:%primitive print (hexstr x)))))
+  (labels ((%cold-print (obj depthoid)
+             (if (> depthoid 4)
+                 (sb!sys:%primitive print "...")
+                 (typecase obj
+                   (simple-string
+                    (sb!sys:%primitive print obj))
+                   (symbol
+                    (sb!sys:%primitive print (symbol-name obj)))
+                   (cons
+                    (sb!sys:%primitive print "cons:")
+                    (let ((d (1+ depthoid)))
+                      (%cold-print (car obj) d)
+                      (%cold-print (cdr obj) d)))
+                   (t
+                    (sb!sys:%primitive print (hexstr x)))))))
+    (%cold-print x 0))
+  (values))
\ No newline at end of file