From 4f7c5ad9f9ef93c149ed4e45d4dce696863d324f Mon Sep 17 00:00:00 2001
From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 1 Jun 2007 17:51:53 +0000
Subject: [PATCH] 1.0.6.11: PRINT-OBJECT method adjusted for new caches

 * "Oops" -- missed from the original cache commit.
---
 src/pcl/cache.lisp        | 11 +++++++++++
 src/pcl/print-object.lisp | 16 +++++++++++-----
 version.lisp-expr         |  2 +-
 3 files changed, 23 insertions(+), 6 deletions(-)

diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp
index 196b57ad2..635799d1c 100644
--- a/src/pcl/cache.lisp
+++ b/src/pcl/cache.lisp
@@ -93,6 +93,17 @@
 (defun power-of-two-ceiling (x)
   (ash 1 (integer-length (1- x))))
 
+(defun cache-statistics (cache)
+  (let* ((vector (cache-vector cache))
+         (size (length vector))
+         (line-size (cache-line-size cache))
+         (total-lines (/ size line-size))
+         (free-lines (loop for i from 0 by line-size below size
+                           unless (eq (svref vector i) '..empty..)
+                           count t)))
+    (values (- total-lines free-lines) total-lines
+            (cache-depth cache) (cache-limit cache))))
+
 ;;; Don't allocate insanely huge caches.
 (defconstant +cache-vector-max-length+ (expt 2 14))
 
diff --git a/src/pcl/print-object.lisp b/src/pcl/print-object.lisp
index c1cde7e2b..82966e3e8 100644
--- a/src/pcl/print-object.lisp
+++ b/src/pcl/print-object.lisp
@@ -124,11 +124,17 @@
 
 (defmethod print-object ((cache cache) stream)
   (print-unreadable-object (cache stream :type t :identity t)
-    (format stream
-            "~W ~S ~W"
-            (cache-nkeys cache)
-            (cache-valuep cache)
-            (cache-nlines cache))))
+    (multiple-value-bind (lines-used lines-total max-depth depth-limit)
+        (cache-statistics cache)
+      (format stream
+              "~D key, ~P~:[no value~;value~], ~D/~D lines, depth ~D/~D"
+              (cache-key-count cache)
+              (cache-key-count cache)
+              (cache-value cache)
+              lines-used
+              lines-total
+              max-depth
+              depth-limit))))
 
 (defmethod print-object ((wrapper wrapper) stream)
   (print-unreadable-object (wrapper stream :type t :identity t)
diff --git a/version.lisp-expr b/version.lisp-expr
index f8114a5b5..2ccde91d7 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.6.10"
+"1.0.6.11"
-- 
2.11.4.GIT