Changeset 13435


Ignore:
Timestamp:
Feb 6, 2010, 4:52:33 PM (10 years ago)
Author:
gz
Message:

heap-utilization: add threshold arg; tweak how slot vectors are described

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lib/misc.lisp

    r13208 r13435  
    896896                              (sort :size)
    897897                              (classes nil)
    898                               (start nil))
     898                              (start nil)
     899                              (threshold (and classes 0.00005)))
    899900  "Show statistic about types of objects in the heap.
    900901   If :GC-FIRST is true (the default), do a full gc before scanning the heap.
     
    908909   If :CLASSES is true, classifies by class rather than just typecode"
    909910  (let ((data (collect-heap-utilization :gc-first gc-first :start start :area area :classes classes)))
    910     (report-heap-utilization data :stream stream :unit unit :sort sort)))
     911    (report-heap-utilization data :stream stream :unit unit :sort sort :threshold threshold)))
    911912
    912913(defun collect-heap-utilization (&key (gc-first t) start area classes)
     
    10351036                                 icount (aref inst-sizes index) (aref inst-psizes index)) data))
    10361037                   (when (plusp scount)
    1037                      (push (list (format nil "(SLOT-VECTOR ~s)" name)
     1038                     (push (list (format nil "~s slot vector" name)
    10381039                                 scount (aref slotv-sizes index) (aref slotv-psizes index)) data))))
    10391040               map)
     
    10831084
    10841085 
    1085 (defun report-heap-utilization (data &key stream unit sort)
     1086(defun report-heap-utilization (data &key stream unit sort threshold)
     1087  (check-type threshold (or null (real 0 1)))
    10861088  (let* ((div (ecase unit
    10871089                ((nil) 1)
     
    10971099         (total-lsize 0)
    10981100         (total-psize 0)
    1099          (max-name 0))
    1100     (loop for (name count lsize psize) in data
    1101       do (incf total-count count)
    1102       do (incf total-lsize lsize)
    1103       do (incf total-psize psize)
    1104       do (setq max-name (max max-name
    1105                              (length (if (stringp name)
    1106                                        name
    1107                                        (if (symbolp name)
    1108                                          (symbol-name name)
    1109                                          (princ-to-string name)))))))
    1110     (setq data
    1111           (if sort-key
    1112             (sort data #'> :key sort-key)
    1113             (sort data #'string-lessp :key #'(lambda (name)
    1114                                                (if (stringp name)
    1115                                                  name
    1116                                                  (if (symbolp name)
    1117                                                    (symbol-name name)
    1118                                                    (princ-to-string name)))))))
    1119                                                    
    1120     (format stream "~&Object type~vtCount     Logical size   Physical size   % of Heap~%~vt ~a~vt ~2:*~a"
    1121             (+ max-name 7)
    1122             (+ max-name 15)
    1123             (ecase unit
    1124               ((nil) "  (in bytes)")
    1125               (:kb   "(in kilobytes)")
    1126               (:mb   "(in megabytes)")
    1127               (:gb   "(in gigabytes)"))
    1128             (+ max-name 31))
    1129     (loop for (type count logsize physsize) in data
    1130       do (if unit
    1131            (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
    1132                    type
    1133                    (1+ max-name)
    1134                    count
    1135                    (/ logsize div)
    1136                    (/ physsize div)
    1137                    (* 100.0 (/ physsize total-psize)))
    1138            (format stream "~&~a~vt~11d~16d~16d~11,2f%"
    1139                    type
    1140                    (1+ max-name)
    1141                    count
    1142                    logsize
    1143                    physsize
    1144                    (* 100.0 (/ physsize total-psize)))))
    1145     (if unit
    1146       (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
    1147               "Total"
    1148               (1+ max-name)
    1149               total-count
    1150               (/ total-lsize div)
    1151               (/ total-psize div)
    1152               100.0d0)
    1153       (format stream "~&~a~vt~11d~16d~16d~11,2f%"
    1154               "Total"
    1155               (1+ max-name)
    1156               total-count
    1157               total-lsize
    1158               total-psize
    1159               100.0d0)))
     1101         (max-name 0)
     1102         (others (list "All others" 0 0 0)))
     1103
     1104    (when (hash-table-p data)
     1105      (setq data
     1106            (let ((alist nil))
     1107              (maphash (lambda (type measures) (push (cons type measures) alist)) data)
     1108              alist)))
     1109
     1110    (flet ((type-string (name)
     1111             (if (stringp name)
     1112               name
     1113               (if (symbolp name)
     1114                 (symbol-name name)
     1115                 (princ-to-string name)))))
     1116      (loop for (nil count lsize psize) in data
     1117            do (incf total-count count)
     1118            do (incf total-lsize lsize)
     1119            do (incf total-psize psize))
     1120
     1121      (when threshold
     1122        (setq data (sort data #'< :key #'cadddr))
     1123        (loop while (< (/ (cadddr (car data)) total-psize) threshold)
     1124              do (destructuring-bind (type count lsize psize) (pop data)
     1125                   (declare (ignore type))
     1126                   (incf (cadr others) count)
     1127                   (incf (caddr others) lsize)
     1128                   (incf (cadddr others) psize))))
     1129
     1130      (setq data
     1131            (if sort-key
     1132              (sort data #'> :key sort-key)
     1133              (sort data #'string-lessp :key #'(lambda (s) (type-string (car s))))))
     1134
     1135      (when (> (cadr others) 0)
     1136        (setq data (nconc data (list others))))
     1137
     1138      (setq max-name (loop for (name) in data maximize (length (type-string name))))
     1139
     1140      (format stream "~&Object type~vtCount     Logical size   Physical size   % of Heap~%~vt ~a~vt ~2:*~a"
     1141              (+ max-name 7)
     1142              (+ max-name 15)
     1143              (ecase unit
     1144                ((nil) "  (in bytes)")
     1145                (:kb   "(in kilobytes)")
     1146                (:mb   "(in megabytes)")
     1147                (:gb   "(in gigabytes)"))
     1148              (+ max-name 31))
     1149      (loop for (type count logsize physsize) in data
     1150            do (if unit
     1151                 (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
     1152                         (type-string type)
     1153                         (1+ max-name)
     1154                         count
     1155                         (/ logsize div)
     1156                         (/ physsize div)
     1157                         (* 100.0 (/ physsize total-psize)))
     1158                 (format stream "~&~a~vt~11d~16d~16d~11,2f%"
     1159                         (type-string type)
     1160                         (1+ max-name)
     1161                         count
     1162                         logsize
     1163                         physsize
     1164                         (* 100.0 (/ physsize total-psize)))))
     1165      (if unit
     1166        (format stream "~&~a~vt~11d~16,2f~16,2f~11,2f%"
     1167                "Total"
     1168                (1+ max-name)
     1169                total-count
     1170                (/ total-lsize div)
     1171                (/ total-psize div)
     1172                100.0d0)
     1173        (format stream "~&~a~vt~11d~16d~16d~11,2f%"
     1174                "Total"
     1175                (1+ max-name)
     1176                total-count
     1177                total-lsize
     1178                total-psize
     1179                100.0d0))))
    11601180  (values))
    11611181
Note: See TracChangeset for help on using the changeset viewer.