1.0.6.11: PRINT-OBJECT method adjusted for new caches

 * "Oops" -- missed from the original cache commit.

diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp
index 196b57a..635799d 100644 (file)
--- 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 c1cde7e..82966e3 100644 (file)
--- 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 f8114a5..2ccde91 100644 (file)
--- 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"