[Openmcl-cvs-notifications] r13486 - in /trunk/source: ./ lib/misc.lisp
gz at clozure.com
gz at clozure.com
Fri Mar 5 17:37:59 UTC 2010
Author: gz
Date: Fri Mar 5 11:37:59 2010
New Revision: 13486
Log:
Merge r13435,r13440,r13467 into trunk: heap-utilization tweaks
Modified:
trunk/source/ (props changed)
trunk/source/lib/misc.lisp
Propchange: trunk/source/
---------------------------------------------------------------------------=
---
--- svn:mergeinfo (original)
+++ svn:mergeinfo Fri Mar 5 11:37:59 2010
@@ -1,2 +1,2 @@
/branches/new-random:13310-13326
-/branches/working-0711/ccl:7620-13192,13197-13198,13202,13208,13214,13235-=
13236,13239,13263,13277-13278,13290,13293-13294,13302-13306,13436
+/branches/working-0711/ccl:7620-13192,13197-13198,13202,13208,13214,13235-=
13236,13239,13263,13277-13278,13290,13293-13294,13302-13306,13435-13436,134=
40,13467
Modified: trunk/source/lib/misc.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/misc.lisp (original)
+++ trunk/source/lib/misc.lisp Fri Mar 5 11:37:59 2010
@@ -895,7 +895,8 @@
(unit nil)
(sort :size)
(classes nil)
- (start nil))
+ (start nil)
+ (threshold (and classes 0.00005)))
"Show statistics about types of objects in the heap.
If :GC-FIRST is true (the default), do a full gc before scanning the he=
ap.
If :START is non-nil, it should be an object returned by GET-ALLOCATION=
-SENTINEL, only
@@ -907,7 +908,7 @@
(including stacks) are examined.
If :CLASSES is true, classifies by class rather than just typecode"
(let ((data (collect-heap-utilization :gc-first gc-first :start start :a=
rea area :classes classes)))
- (report-heap-utilization data :stream stream :unit unit :sort sort)))
+ (report-heap-utilization data :stream stream :unit unit :sort sort :th=
reshold threshold)))
=
(defun collect-heap-utilization (&key (gc-first t) start area classes)
;; returns list of (type-name count logical-sizes-total physical-sizes-t=
otal)
@@ -999,7 +1000,9 @@
#+32-bit-target 7))
(class (class-of (if (eql typecode target::subta=
g-slot-vector)
(uvref thing slot-vector.inst=
ance)
- thing)))
+ (if (eql typecode target::sub=
tag-function)
+ (function-vector-to-functio=
n thing)
+ thing))))
(index (or (gethash class map)
(let ((count (hash-table-count map)))
(if (eql count max-classes)
@@ -1034,7 +1037,7 @@
(push (list (prin1-to-string name)
icount (aref inst-sizes index) (aref inst=
-psizes index)) data))
(when (plusp scount)
- (push (list (format nil "(SLOT-VECTOR ~s)" name)
+ (push (list (format nil "~s slot vector" name)
scount (aref slotv-sizes index) (aref slo=
tv-psizes index)) data))))
map)
data)))
@@ -1082,7 +1085,8 @@
a))
=
=
-(defun report-heap-utilization (data &key stream unit sort)
+(defun report-heap-utilization (data &key stream unit sort threshold)
+ (check-type threshold (or null (real 0 1)))
(let* ((div (ecase unit
((nil) 1)
(:kb 1024.0d0)
@@ -1096,67 +1100,85 @@
(total-count 0)
(total-lsize 0)
(total-psize 0)
- (max-name 0))
- (loop for (name count lsize psize) in data
- do (incf total-count count)
- do (incf total-lsize lsize)
- do (incf total-psize psize)
- do (setq max-name (max max-name
- (length (if (stringp name)
- name
- (if (symbolp name)
- (symbol-name name)
- (princ-to-string name)))))))
- (setq data
- (if sort-key
- (sort data #'> :key sort-key)
- (sort data #'string-lessp :key #'(lambda (name)
- (if (stringp name)
- name
- (if (symbolp name)
- (symbol-name name)
- (princ-to-string name))=
)))))
- =
- (format stream "~&Object type~vtCount Logical size Physical size=
% of Heap~%~vt ~a~vt ~2:*~a"
- (+ max-name 7)
- (+ max-name 15)
- (ecase unit
- ((nil) " (in bytes)")
- (:kb "(in kilobytes)")
- (:mb "(in megabytes)")
- (:gb "(in gigabytes)"))
- (+ max-name 31))
- (loop for (type count logsize physsize) in data
- do (if unit
- (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
- type
- (1+ max-name)
- count
- (/ logsize div)
- (/ physsize div)
- (* 100.0 (/ physsize total-psize)))
- (format stream "~&~a~vt~11d~16d~16d~11,2f%"
- type
- (1+ max-name)
- count
- logsize
- physsize
- (* 100.0 (/ physsize total-psize)))))
- (if unit
- (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
- "Total"
- (1+ max-name)
- total-count
- (/ total-lsize div)
- (/ total-psize div)
- 100.0d0)
- (format stream "~&~a~vt~11d~16d~16d~11,2f%"
- "Total"
- (1+ max-name)
- total-count
- total-lsize
- total-psize
- 100.0d0)))
+ (max-name 0)
+ (others (list "All others" 0 0 0)))
+
+ (when (hash-table-p data)
+ (setq data
+ (let ((alist nil))
+ (maphash (lambda (type measures) (push (cons type measures) =
alist)) data)
+ alist)))
+
+ (flet ((type-string (name)
+ (if (stringp name)
+ name
+ (if (symbolp name)
+ (symbol-name name)
+ (princ-to-string name)))))
+ (loop for (nil count lsize psize) in data
+ do (incf total-count count)
+ do (incf total-lsize lsize)
+ do (incf total-psize psize))
+
+ (when (and data threshold)
+ (setq data (sort data #'< :key #'cadddr))
+ (loop while (< (/ (cadddr (car data)) total-psize) threshold)
+ do (destructuring-bind (type count lsize psize) (pop data)
+ (declare (ignore type))
+ (incf (cadr others) count)
+ (incf (caddr others) lsize)
+ (incf (cadddr others) psize))))
+
+ (setq data
+ (if sort-key
+ (sort data #'> :key sort-key)
+ (sort data #'string-lessp :key #'(lambda (s) (type-string (c=
ar s))))))
+
+ (when (> (cadr others) 0)
+ (setq data (nconc data (list others))))
+
+ (setq max-name (loop for (name) in data maximize (length (type-strin=
g name))))
+
+ (format stream "~&Object type~vtCount Logical size Physical si=
ze % of Heap~%~vt ~a~vt ~2:*~a"
+ (+ max-name 7)
+ (+ max-name 15)
+ (ecase unit
+ ((nil) " (in bytes)")
+ (:kb "(in kilobytes)")
+ (:mb "(in megabytes)")
+ (:gb "(in gigabytes)"))
+ (+ max-name 31))
+ (loop for (type count logsize physsize) in data
+ do (if unit
+ (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
+ (type-string type)
+ (1+ max-name)
+ count
+ (/ logsize div)
+ (/ physsize div)
+ (* 100.0 (/ physsize total-psize)))
+ (format stream "~&~a~vt~11d~16d~16d~11,2f%"
+ (type-string type)
+ (1+ max-name)
+ count
+ logsize
+ physsize
+ (* 100.0 (/ physsize total-psize)))))
+ (if unit
+ (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
+ "Total"
+ (1+ max-name)
+ total-count
+ (/ total-lsize div)
+ (/ total-psize div)
+ 100.0d0)
+ (format stream "~&~a~vt~11d~16d~16d~11,2f%"
+ "Total"
+ (1+ max-name)
+ total-count
+ total-lsize
+ total-psize
+ 100.0d0))))
(values))
=
=
More information about the Openmcl-cvs-notifications
mailing list