X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fcold-init.lisp;h=ef011a2cb3ab855c645bd3a1a8fd1f4da1974f5a;hb=aab81dccfb1a311eac523a855004a3669340aca6;hp=2d07ef106139947661e49af504197c4336af311a;hpb=9b1fade83db8453b75b8c7380eb12ce41b5b889c;p=sbcl.git

diff --git a/src/code/cold-init.lisp b/src/code/cold-init.lisp
index 2d07ef1..ef011a2 100644
--- a/src/code/cold-init.lisp
+++ b/src/code/cold-init.lisp
@@ -339,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