Changeset 13533

Timestamp:

Mar 15, 2010, 4:58:47 PM (9 years ago)

Author:

rme

Message:

New function HEAP-VECTOR-UTILIZATION.

File:

• trunk/source/lib/misc.lisp (modified) (1 diff)

trunk/source/lib/misc.lisp

@@ -1043 +1043 @@
       data)))
 
+(defun collect-heap-ivector-utilization-by-typecode ()
+  (let* ((counts (make-array 256 :initial-element 0))
+         (sizes (make-array 256 :initial-element 0))
+         (physical-sizes (make-array 256 :initial-element 0))
+         (array-size-function (arch::target-array-data-size-function
+                               (backend-target-arch *host-backend*)))
+         (result ()))
+    (declare (dynamic-extent counts sizes))
+    (with-lock-grabbed (*heap-ivector-lock*)
+      (dolist (vector *heap-ivectors*)
+        (let* ((typecode (typecode vector))
+               (logsize (funcall array-size-function typecode (uvsize vector)))
+               (physsize (+ logsize
+                            ;; header, delta, round up
+                            #+32-bit-target (+ 4 2 7)
+                            #+64-bit-target (+ 8 2 15))))
+          (incf (aref counts typecode))
+          (incf (aref sizes typecode) logsize)
+          (incf (aref physical-sizes typecode) physsize))))
+    (dotimes (i 256 result)
+      (when (plusp (aref counts i))
+        (push (list (aref *heap-utilization-vector-type-names* i)
+                    (aref counts i)
+                    (aref sizes i)
+                    (aref physical-sizes i))
+              result)))))
+
+(defun heap-ivector-utilization (&key (stream *debug-io*)
+                                      (unit nil)
+                                      (sort :size))
+  (let* ((data (collect-heap-ivector-utilization-by-typecode)))
+    (report-heap-utilization data :stream stream :unit unit :sort sort)))
+  
 (defvar *heap-utilization-vector-type-names*
   (let* ((a (make-array 256)))