From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Wed, 30 Jul 2008 16:35:25 +0000 (+0000)
Subject: 1.0.19.6: fix SB-SHOW build
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=451d6e4af62dc8bbad57219c403d4395db84a4d6;p=sbcl.git

1.0.19.6: fix SB-SHOW build

 * Patch by Josh Elsasser for STYLE-WARN.

 * Make COLD-PRINT able to print improper lists -- early source
   locations are conses with the TLF number in the CDR.
---

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
diff --git a/src/code/error.lisp b/src/code/error.lisp
index f989aef..e886972 100644
--- a/src/code/error.lisp
+++ b/src/code/error.lisp
@@ -16,7 +16,7 @@
 ;;; not sure this is the right place, but where else?
 (defun style-warn (datum &rest arguments)
   (/show0 "entering STYLE-WARN")
-  (/show format-control format-arguments)
+  (/show datum arguments)
   (if (stringp datum)
       (with-sane-io-syntax
         (warn 'simple-style-warning
diff --git a/version.lisp-expr b/version.lisp-expr
index fb3d67f..e2f68b1 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.19.5"
+"1.0.19.6"